Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年12月02日] [更新 2017年07月02日]　GDI+ 関係サンプル
GDI+ 関係サンプル　
G042_GDI+ を使用しない画像形式の変換
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
G042_GDIPlus_ChangeImageTypes.zip　[1,891 KB]　2017年07月02日版 (EXE 同梱)






01_GDI+ を使用しない画像形式の変換


GDI+ を使用しない画像形式の変換テストです．
原理は単純です．画像をディスクから読み込み，保存する時に目的の画像形式で保存します．必要であれば，圧縮レベルの設定や透明処理を行ってから保存します．本サンプルでは，画像を TImage に表示していますが，画像を表示する必要がなければ，TImage を使用する必要はありません．

JPEG 画像は Delphi 3 から，GIF 画像は Delphi 2007 から，PNG 画素は Delphi 2009 からサポートされています．TPngImage はアルファチャンネルもサポートしています．

ビットマップを他の画像形式に変換するこれらのコードは，GDI+ を使用する場合にも必要となることがあります．例えば，表示サイズで画像を保存したい場合にも利用できます．


図1
設計時画面
図2
24 bit ビットマップの変換
  • 24 ビットのビットマップ画像を読み込んで，変換して保存
図3
32 ビットの α チャンネル付きビットマップの変換
  • 32 ビットのビットマップ画像を読み込んで，変換して保存
  • 元の画像が 24 ビットの時の違いは，保存した画像を表示した時の目の部分と背景色に注目

リスト1
GDI+ を使用しない画像形式の変換．変換元の画像がビットマップの例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GDIPAPI, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    RadioGroup1: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  Jpeg, 
  GifImg, 
  PNGImage;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := '画像形式の変換テスト';
  RadioGroup1.ItemIndex := 0;
end;

//=============================================================================
//  BMP画像をJPEG画像形式に変換して保存
//  添付の32ビットビットマップはアルファチャンネル付
//
//  usesにJpegが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName : string;
  LFilePath : string;
  LSavePath : string;
  LBitmap   : TBitmap;
  LJpegImg  : TJPEGImage;
begin
  if RadioGroup1.ItemIndex = 0 then begin
    LFileName := '503_24bit.bmp';
  end else begin
    //アルファチャンネル付32bitビットマップ
    LFileName := '502_32bit.bmp';
  end;
  LFilePath := ExtractFilePath(Application.ExeName) + LFileName;
  LSavePath := ExtractFilePath(Application.ExeName) + 'Changed_' + LFileName;

  LBitmap := TBitmap.Create;
  try
    if RadioGroup1.ItemIndex = 1 then begin
      LBitmap.PixelFormat := pf32bit;
      LBitmap.AlphaFormat := afDefined;
    end;
    //変換元のビットマップ画像を読み込んでTImageに表示
    //TImageへの表示は確認用．表示しなくてもよい
    LBitmap.LoadFromFile(LFilePath);
    Image1.Picture.Bitmap.Assign(LBitmap);


    LJpegImg := TJPEGImage.Create;
    try
      LJpegImg.Assign(LBitmap);

      //JPEG画像品質の設定(デフォルト値は90)
      LJpegImg.CompressionQuality := 75;

      //拡張子を変更してJPEG画像保存
      LSavePath := ChangeFileExt(LSavePath, '.jpg');
      LJpegImg.SaveToFile(LSavePath);
    finally
      FreeAndNil(LJpegImg);
    end;
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  BMP画像をGIF画像形式に変換して保存
//  添付の32ビットビットマップはアルファチャンネル付
//
//  usesにGifimgが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFileName  : string;
  LFilePath  : string;
  LSavePath  : string;
  LBitmap    : TBitmap;
  LGifImage  : TGIFImage;
  LGifExtent : TGIFGraphicControlExtension;
  LColor     : TColor;
begin
  if RadioGroup1.ItemIndex = 0 then begin
    LFileName := '503_24bit.bmp';
  end else begin
    //アルファチャンネル付32bitビットマップ
    LFileName := '502_32bit.bmp';
  end;
  LFilePath := ExtractFilePath(Application.ExeName) + LFileName;
  LSavePath := ExtractFilePath(Application.ExeName) + 'Changed_' + LFileName;

  LBitmap := TBitmap.Create;
  try
    if RadioGroup1.ItemIndex = 1 then begin
      LBitmap.PixelFormat := pf32bit;
      LBitmap.AlphaFormat := afDefined;
    end;
    //変換元のビットマップ画像を読み込んでTImageに表示
    //TImageへの表示は確認用．表示しなくてもよい
    LBitmap.LoadFromFile(LFilePath);
    Image1.Picture.Bitmap.Assign(LBitmap);


    LGifImage := TGIFImage.Create;
    try
      LGifImage.Assign(LBitmap);

      //カラーマップの最適化
      LGifImage.OptimizeColorMap;
      //GIFイメージの透明化処理
      LColor :=  LGifImage.Bitmap.Canvas.Pixels[0, LGifImage.Bitmap.Height - 1];
      LGifExtent := TGIFGraphicControlExtension.Create(LGifImage.Images[0]);
      LGifExtent.Transparent := True;
      LGifExtent.TransparentColor := LColor;

      //拡張子を変更してGIF画像保存
      LSavePath := ChangeFileExt(LSavePath, '.gif');
      LGifImage.SaveToFile(LSavePath);
    finally
      FreeAndNil(LGifImage);
    end;
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  BMP画像をPNG画像形式に変換して保存
//  添付の32ビットビットマップはアルファチャンネル付
//
//  usesにPNGImageが必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFileName : string;
  LFilePath : string;
  LSavePath : string;
  LBitmap   : TBitmap;
  LPNGImag  : TPngImage;
  LColor    : TColor;
begin
  if RadioGroup1.ItemIndex = 0 then begin
    LFileName := '503_24bit.bmp';
  end else begin
    //アルファチャンネル付32bitビットマップ
    LFileName := '502_32bit.bmp';
  end;
  LFilePath := ExtractFilePath(Application.ExeName) + LFileName;
  LSavePath := ExtractFilePath(Application.ExeName) + 'Changed_' + LFileName;

  LBitmap := TBitmap.Create;
  try
    if RadioGroup1.ItemIndex = 1 then begin
      LBitmap.PixelFormat := pf32bit;
      LBitmap.AlphaFormat := afDefined;
    end;
    //変換元のビットマップ画像を読み込んでTImageに表示
    //TImageへの表示は確認用．表示しなくてもよい
    LBitmap.LoadFromFile(LFilePath);
    Image1.Picture.Bitmap.Assign(LBitmap);


    LPNGImag := TPngImage.Create;
    try
      //元のビットマップがアルファ値をもっていてもアルファ値はコピーされない
      LPNGImag.Assign(LBitmap);

      //圧縮レベルの設定(デフォルト値は7)
      LPNGImag.CompressionLevel := 7;

      //PNGイメージの透明化処理
      LColor :=  LPNGImag.Canvas.Pixels[0, LPNGImag.Height - 1];
      LPNGImag.Transparent := True;
      LPNGImag.TransparentColor := LColor;

      //拡張子を変更してPNG画像保存
      LSavePath := ChangeFileExt(LSavePath, '.png');
      LPNGImag.SaveToFile(LSavePath);
    finally
      FreeAndNil(LPNGImag);
    end;
  finally
    FreeAndNil(LBitmap);
  end;
end;

end.



02_半透明のビットマップ画像を TPngImage 形式の画像に変換


上のコードでもアルファチャンネル付きのビットマップ画像を TPngImage 形式の画像に変換はできますが，半透明のビットマップを変換すると正常な色になりません．
ピクセルの操作が必要です．参考リンクの記事にもありますが，こちらにも掲載しておきます．


リスト2
半透明のビットマップ画像も TPngImage 形式の画像に変換するコード例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GDIPAPI, StdCtrls, ExtCtrls, ExtDlgs, pngimage;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FLoadInitDir   : string;
    FImageFilePath : string;
  function ChangeBitmapToPngimage(SrcBitmap: TBitmap;
    DstPngImage: TPngImage): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FLoadInitDir := ExpandFileName('.\');
end;

//=============================================================================
//  BMP画像をPNG画像形式に変換して保存
//  半透明のビットマップもPNG形式の画像に変換
//
//  usesにPNGImageが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap   : TBitmap;
  LPngImage : TPngImage;
  LSavePath : string;
begin
  Image1.Picture.Assign(nil);

  OpenPictureDialog1.Filter     := '画像ファイル|*.bmp';
  OpenPictureDialog1.InitialDir := FLoadInitDir;
  if not OpenPictureDialog1.Execute then exit;

  FImageFilePath := OpenPictureDialog1.FileName;
  FLoadInitDir   :=  ExtractFileDir(FImageFilePath);

  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImageFilePath);
    if LBitmap.PixelFormat = pf32bit then begin
      //ここで以下にしないこと
      //afDefinedにしてしまうとPNG画像の色がおかしくなる
      //LBitmap.AlphaFormat := afDefined;
      Image1.Picture.Bitmap.Assign(LBitmap);

      //TPngImage生成
      LPngImage := TPngImage.CreateBlank(COLOR_RGBALPHA,
                                         8,
                                         LBitmap.Width,
                                         LBitmap.Height);
      try
        //TBitmapをTPngImageに変換
        ChangeBitmapToPngimage(LBitmap, LPngImage);

        //保存
        LSavePath := ChangeFileExt(FImageFilePath, '.png');
        LPngImage.SaveToFile(LSavePath);

        //ビットマップをアルファチャンネル付で表示したい場合
        //TPngImageに変換してからafDefinedにして描画する
        LBitmap.AlphaFormat := afDefined;
        Image1.Picture.Bitmap.Assign(LBitmap);
      finally
        FreeAndNil(LPngImage);
      end;
    end;
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  TBitmapをアルファチャンネルの情報を保持してTPngImageに変換
//-----------------------------------------------------------------------------
function TForm1.ChangeBitmapToPngimage(SrcBitmap: TBitmap;
  DstPngImage: TPngImage): Boolean;
type
  TRGBQArray = array [0..High(Integer) div 4 - 1] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
  TRGBTArray = array [0..High(Integer) div 3 - 1] of RGBTRIPLE;
  PRGBTArray = ^TRGBTArray;
var
  LBmpScanLine   : PRGBQArray;
  LPngScanLine   : PRGBTArray;
  LpPngARGBQuad  : RGBQUAD;
  LpBmpRGBTriple : RGBTRIPLE;
  LYPos          : Integer;
  LXPos          : Integer;
begin
  Result := True;

  for LYPos := 0 to SrcBitmap.Height - 1 do begin

    LBmpScanLine := SrcBitmap.ScanLine[LYPos];
    LPngScanLine := DstPngImage.ScanLine[LYPos];

    for LXPos := 0 to SrcBitmap.Width - 1 do begin
      LpPngARGBQuad := LBmpScanLine[LXPos];

      LpBmpRGBTriple.rgbtBlue  := LpPngARGBQuad.rgbBlue;
      LpBmpRGBTriple.rgbtGreen := LpPngARGBQuad.rgbGreen;
      LpBmpRGBTriple.rgbtRed   := LpPngARGBQuad.rgbRed;

      LPngScanLine[LXPos] := LpBmpRGBTriple;
      DstPngImage.AlphaScanline[LYPos]^[LXPos] := LpPngARGBQuad.rgbReserved;
    end;
  end;
end;

end.


TPngImage を TBitmap 画像に変換するにはは，単純に Assign メソッドで可能です． 

  TBitmap.Assign(TPngImage);



03_TImage に描画している画像の形式と保存


TImage に描画している画像の形式の確認方法と，その画像を TBitmap 形式の画像に変換する例です．
本サンプルでは TImage に TJPEGImage 形式の画像を描画してテストしています．


リスト3
TImage に描画している画像の形式の確認の方法と，ビットマップ画像への変換
TBitmap に変換できれば，前項の方法で他の形式にも変換できる		 
implementation

uses
  Jpeg,
  GifImg,
  PNGImage;

{$R *.dfm}

//=============================================================================
//  TImageに描画している画像形式が何であるかを確認する方法
//  TImageに描画している画像を同じ画像形式で別の名前で保存する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.LoadFromFile('503.jpg');

  //TImageに描画されているのがTJPegImaageの画像形式の場合
  if (Image1.Picture.Graphic is TJPEGImage) then begin
    //別名で保存
    //拡張子を変更しても別の画像形式にはならない
    Image1.Picture.SaveToFile('000.jpg');
  end;
end;

//=============================================================================
//  TImageに描画している画像形式が何であるかを確認する方法
//  TImageに描画している画像を別の画像形式で保存する例
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.LoadFromFile('503.jpg');

  //TImageに描画されているのがTJPegImaageの画像形式の場合
  if (Image1.Picture.Graphic is TJPEGImage) then begin
    LBitmap := TBitmap.Create;
    try
      //ビットマップにして保存
      //ビットマップを他の画像形式に変換すれば他の画像形式での保存が可能
      LBitmap.Assign(Image1.Picture.Graphic);
      LBitmap.SaveToFile('000.bmp');
    finally
      FreeAndNil(LBitmap);
    end;
  end;
end;



04_JPEG 形式等の画像を TBitmap 形式の画像に変換


TImage には表示していない TJPEGImage 形式の画像を TBitmap 形式の画像に変換する例です．この方法は，JPEG 画像以外でも利用できます．
最初の方法は TBitamap.Assign メソッドを使用しています．次のコードは，TBitmap.Canvas に描画する方法です．



リスト4
JPEG 形式の画像をビットマップ画像に変換する例
同じ方法で，他の画像形式もビットマップ画像に変換できる		 
implementation

uses
  Jpeg,
  GifImg,
  PNGImage;

{$R *.dfm}

//=============================================================================
//  JPEG形式の画像をTBitmap形式の画像に変換
//  Assignメソッドを使用する方法
//  他の加増形式も同じ方法でTBitmapに変換できる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LJpegImage : TJPEGImage;
  LBitmap    : TBitmap;
begin
  LJpegImage := TJPEGImage.Create;
  LBitmap    := TBitmap.Create;
  try
    //JPEG画像を読み込む
    LJpegImage.LoadFromFile('503.jpg');

    //ビットマップに代入
    LBitmap.Assign(LJpegImage);

    //ビットマップを保存
    LBitmap.SaveToFile('000.bmp');
  finally
    FreeAndNil(LJpegImage);
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  JPEG形式の画像をTBitmap形式の画像に変換
//  TBitmap.Canvasに描画する方法
//  他の加増形式も同じ方法でTBitmapに変換できる
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LJpegImage : TJPEGImage;
  LBitmap    : TBitmap;
begin
  LJpegImage := TJPEGImage.Create;
  LBitmap    := TBitmap.Create;
  try
    //JPEG画像を読み込む
    LJpegImage.LoadFromFile('503.jpg');

    //ビットマップのサイズを設定してCanvaaに描画
    LBitmap.Width  := LJpegImage.Width;
    LBitmap.Height := LJpegImage.Height;
    LBitmap.Canvas.Draw(0, 0, LJpegImage);

    //ビットマップを保存
    LBitmap.SaveToFile('000.bmp');
  finally
    FreeAndNil(LJpegImage);
    FreeAndNil(LBitmap);
  end;
end;



05_TWICImage を使用した TIFF 画像への変換


シングルの TIFF 画像であれば，Delphi 2010 で実装された TWICImage クラスを使用して以下のように表示できます．

画像形式の確認または，画像形式の変換は，TWICImage.ImageFormat プロパティを使用します．このプロパティの値を使用すれば，TWICImage がサポートしている画像形式に変換して保存できます．たとえ TWICImage を使用しても，画像の読み込みの時とは違い，拡張子を変えるだけでは画像の形式は変わりません．拡張子を変えただけだと，中身は元の画像形式のままです．
各種画像形式の詳細な設定はできません．

TWICImage は，Windows Vista 以降，.NET Framework 3.0 以降の環境で使用可能です．



リスト5
TWICImage クラスを使用した TIFF 画像の表示と変換
TWICImage.ImageFormat プロパティを変更すれば，他の画像形式に変換できる		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenPictureDialog1.InitialDir := ExpandFileName('..\');
end;

//=============================================================================
//  TWICImageを使用して，画像をTImageに表示
//  Image1.Repaint;  あるいはUpdate等を表示確認のために入れておいた方が良い
//
//  アルファチャンネル付の画像の場合
//  TImage.Picture.Bitmap.AlphaFormat := afDefined;
//  でアルファチャンネルの描画が有効となるのだが，以下のコードでは無効
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath : string;
  LWICImage : TWICImage;
begin
  if not OpenPictureDialog1.Execute then exit;

  LFilePath := OpenPictureDialog1.FileName;
  OpenPictureDialog1.InitialDir := ExtractFileDir(LFilePath);

  LWICImage := TWICImage.Create;
  try
    LWICImage.LoadFromFile(LFilePath);
    Image1.Picture.Assign(LWICImage);
    Image1.Repaint;
  finally
    FreeAndNil(LWICImage);
  end;
end;

//=============================================================================
//  TWICImageを使用して，ビットマップ画像をTIFF画像に変換して保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap   : TBitmap;
  LWICImage : TWICImage;
begin
  LBitmap   := TBitmap.Create;
  LWICImage := TWICImage.Create;
  try
    LBitmap.LoadFromFile('503.bmp');

    LWICImage.Assign(LBitmap);
    LWICImage.ImageFormat := wifTiff;
    LWICImage.SaveToFile('503.tif');
  finally
    FreeAndNil(LWICImage);
    FreeAndNil(LBitmap);
  end;
end;

end.