Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年09月20日] [更新 2025年04月16日]　画像・図形の移動リサイズ関係サンプル
画像・図形の移動リサイズ関係サンプル
R030_画像を描画するクラスの例
動作確認等 Windows 10 ビルド 19045 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
掲載画像は Windows 7 U64(SP1) + Delphi XE(UP1) Pro
R030_ResizeImage.zip　[5.4 MB]　2025年04月16日版 (EXE 同梱)
描画用クラスのソースコードは [概要] ページからダウンロードする






画像描画用のクラスの例


画像描画用の描画コントロールの実装例です．画像ファイルから画像を読み込んで GDI+ の TGPBitmap オブジェクトとして描画します．

GDI+ では，TGPBitma.Save メソッドでビットマップ画像として保存する場合は，ビットマップのアルファチャンネルの情報も保存してくれますが，ビットマップ画像を読み込んで描画する時はアルファチャンネルの処理をしてくれません．そこでこの画像描画クラスでは，ビットマップ画像ファイルを読み込んだ時はアルファチャンネルの処理をしてから描画するようにしています．

以下のプロパティとメソッドしか実装していません．



プロパティ 型 説明
GPBitmap TGPbitmap 描画する TGPBitmap のインスタンス
取得時は，描画元の TGPBitmap オブジェクト


追加のメソッドは以下だけです．
LoadFromFile メソッドは画像ファイルを読み込んでコントロールに画像を描画します．		 

LoadFromFile(AFilePath)

引数 型 説明
AFilePath string 描画対象の画像ファイルのフルパス




01_画像ファイルを読み込んで表示


画像を LoadFromFile メソッドで読み込んで，専用のコンテナ用のコントロールに表示します．

専用のコンテナコントロールを使用すれば，管理用の配列に Add メソッド等で格納する必要はありません．自動で追加します．また，解放，破棄も自動で実行するようになっています



図1
設計時の画面
  • 背景のコントロールは実行時に生成するようにしている
図2
複数の画像を読み込んで表示

リスト1
画像を読み込んでコンテナコントロール上に表示		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin, ExtDlgs, GDIPAPI, GDIPOBJ, GDIPUTIL,
  plGPResizeImage,
  plBaseDragResize,
  plContainerPanel;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl      : TplContainerPanel;
    FResizeImage   : TplGPResizeImage;
    FLoadInitDir   : string;
    FImageFilePath : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  // コンテナコントロール生成
  FBackCtrl := TplContainerPanel.Create(Self);
  FBackCtrl.Parent := Self;
  FBackCtrl.Align  := alClient;
end;

//=============================================================================
//  [読み込み] ボタン
//  画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenPictureDialog1.Filter     := '画像ファイル|*.bmp;*.png;*.jpg;*.gif';
  OpenPictureDialog1.InitialDir := FLoadInitDir;
  if not OpenPictureDialog1.Execute then exit;

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


  // 新規に描画コントロールを生成
  // 管理用の配列に自動で追加される
  FResizeImage := TplGPResizeImage.Create(Self);
  FResizeImage.Parent      := FBackCtrl;
  FResizeImage.InverseDisp := True;
  FResizeImage.LoadFromFile(FImageFilePath);
end;

//=============================================================================
//  [削除] ボタン
//  選択中の描画コントロールを削除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  FBackCtrl.DeleteCtrl();
end;

end.



02_表示中の画像をビットマップ画像として保存


画像をビットマップ画像して保存する例です．
保存するのは現在描画コントローに表示しているサイズと反転状態の画像です．表示元の TGPBitmap 画像ではあません．

描画用の基本クラスに実装されている GetGPBitmap メソッドが使用できます．GetGPBitmap メソッドの戻り値の TGPBitmap は生成も解放も必要ありませんが，解放処理をしても問題ありません．それをビットマップ画像ファイルとして保存します．保存には TGPBitmap.Save メソッドを使用します．
このサンプルでは，保存したビットマップ画像ファイルを TImage に読み込んで表示します．


図3
操作結果
  • 左は描画中の画像
  • 右は保存したファイルを読み込んで TImage に表示した画像

リスト2
表示状態の画像をビットマップ画像として保存する例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin, ExtDlgs, GDIPAPI, GDIPOBJ, GDIPUTIL,
  plGPResizeImage,
  plBaseDragResize,
  plContainerPanel;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Panel2: TPanel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl      : TplContainerPanel;
    FResizeImage   : TplGPResizeImage;
    FLoadInitDir   : string;
    FImageFilePath : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  // コンテナコントロール生成
  FBackCtrl := TplContainerPanel.Create(Self);
  FBackCtrl.Parent    := Self;
  FBackCtrl.Align     := alClient;
  FBackCtrl.BackImage := True;
end;

//=============================================================================
//  [読み込み] ボタン
//  画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenPictureDialog1.Filter     := '画像ファイル|*.bmp;*.png;*.jpg;*.gif';
  OpenPictureDialog1.InitialDir := FLoadInitDir;
  if not OpenPictureDialog1.Execute then exit;

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


  // 表示中の描画コントロールは全て削除
  FBackCtrl.DeleteAllCtrls;

  // 新規に描画コントロールを生成
  FResizeImage := TplGPResizeImage.Create(Self);
  FResizeImage.Parent      := FBackCtrl;
  FResizeImage.InverseDisp := True;
  FResizeImage.LoadFromFile(FImageFilePath);
end;

//=============================================================================
//  [保存] ボタン
//  描画コントロールに表示中の画像をビットマップとして保存する例
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap : TGPBitmap;
  LBitmap   : TBitmap;
  LImgGUID  : TGUID;
  LSaveFilePath : string;
begin
  if not Assigned(FResizeImage) then Exit;

  LSaveFilePath := ExpandFileName('02_TBitmap.bmp');
  Image1.Picture.Assign(nil);

  // GetGPBitmap メソッドを使用
  LGPBitmap := FResizeImage.GetGPBitmap;
  if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;

  LGPBitmap.Save('01_TGPBitmap.bmp', LImgGUID);

  // TGPBitmap を TBitmap に変換して保存
  LBitmap := TBitmap.Create;
  try
    FResizeImage.GPBitmapToBitmap(LGPBitmap, LBitmap);
    LBitmap.SaveToFile(LSaveFilePath);


      // 保存したビットマップ画像を TImage に表示
      Image1.Width  := LGPBitmap.GetHeight;
      Image1.Height := LGPBitmap.GetHeight;

      Image1.Picture.Bitmap.AlphaFormat := afDefined;
      Image1.Picture.Bitmap.LoadFromFile(LSaveFilePath);
  finally
    FreeAndNil(LBitmap);
  end;
end;

end.


TGPBitmap を TImage に描画するという目的だけであれば，TGPBitmap を TImage.Canvas に，以下のようにして描画すれば TImage に表示できます．


リスト3
TImage.Canvas に画像を描画		 
//=============================================================================
//  TImage への描画
//  画像を読み込んでコントロールに描画中の画像を TImage に表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Assigned(FResizeImage) then Exit;

  FResizeImage.DrawRoutine(Image1.Canvas, nil);
end;


TGPBitmap の画像は，以下のようにしてメモリストリームに格納できます．メモリストリームに格納すれば，いろいろな操作が可能です．


リスト4
TGPBitmap 画像をビットマップとしてメモリストリームに格納する例		 
//=============================================================================
//  TGPBitmap をメモリストリームに格納
//  メモリストリームに格納した画像を TImage に表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap  : TGPBitmap;
  LMemStream : TMemoryStream;
  LImgGUID   : TGUID;
begin
  if not Assigned(FResizeImage) then Exit;

  // 表示中の画像を GetGPBitmap メソッドで取得
  LGPBitmap := FResizeImage.GetGPBitmap;
　if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;

  LMemStream := TMemoryStream.Create;
  try
    // それをメモリストリームに格納
    LGPBitmap.Save(TStreamAdapter.Create(LMemStream), LImgGUID);

    // メモリストリームを TImage に読み込む
    Image1.Width  := LGPBitmap.GetHeight;
    Image1.Height := LGPBitmap.GetHeight;

    Image1.Picture.Bitmap.AlphaFormat := afDefined;
    LMemStream.Position := 0;
    Image1.Picture.Bitmap.LoadFromStream(LMemStream);
  finally
    FreeAndNil(LGPBitmap);
    FreeAndNil(LMemStream);
  end;
end;



03_表示画像を複製して別の描画コントロールで表示


表示状態の画像を複製 (コピー) して，別の画像描画用コントロールで表示します．
前項のサンプルと同じ方法で，描画中の画像の TGPBitmap を取得します．そして，新規に画像描画用のコントロールを生成し，その GPBitmap プロパティに，取得した TGPBitmap を代入します．  




図4
操作結果
  • 左が複製した画像
  • 右は元の表示画像

リスト5
表示中の画像を複製して別の描画コントロールで表示		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin, ExtDlgs, GDIPAPI, GDIPOBJ, GDIPUTIL,
  plGPResizeImage,
  plBaseDragResize,
  plContainerPanel;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl      : TplContainerPanel;
    FResizeImage   : TplGPResizeImage;
    FLoadInitDir   : string;
    FImageFilePath : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  // コンテナコントロール生成
  FBackCtrl := TplContainerPanel.Create(Self); 
  FBackCtrl.Parent    := Self;
  FBackCtrl.Align     := alClient;
  FBackCtrl.BackImage := True;
end;

//=============================================================================
//  [読み込み] ボタン
//  画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenPictureDialog1.Filter     := '画像ファイル|*.bmp;*.png;*.jpg;*.gif';
  OpenPictureDialog1.InitialDir := FLoadInitDir;
  if not OpenPictureDialog1.Execute then exit;

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


  // 表示中の描画コントロールは全て削除
  FBackCtrl.DeleteAllCtrls;

  // 新規に描画コントロールを生成
  FResizeImage := TplGPResizeImage.Create(Self);
  FResizeImage.Parent      := FBackCtrl;
  FResizeImage.InverseDisp := True;
  FResizeImage.LoadFromFile(FImageFilePath);
end;

//=============================================================================
//  [TGPBitmap 取得・作成] ボタン
//  描画コントロールに表示中の画像の複製を作成
//  新しいTGPBitmapを作成してそこに描画する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LCtrl     : TplGPResizeImage;
  LGPBitmap : TGPBitmap;
begin
  if FBackCtrl.CtrlList.Count = 0 then Exit;

  try
    // 描画オブジェクトのインスタンスを取得
    //最初に作成した画像が対象
    LCtrl := TplGPResizeImage(FBackCtrl.CtrlList[0]);

    // TGPBitmapを作成．サイズは現在の描画コントロールのサイズ
    LGPBitmap := TGPBitmap.Create(LCtrl.Width, LCtrl.Height); 
    // 表示中の画像 (現在の表示状態) を画像として LGPBitmap に取得
    LCtrl.DrawRoutine(nil, LGPBitmap);

    // 新規に画像描画用のコントロールを作成して取得した画像を表示
    FResizeImage := TplGPResizeImage.Create(Self);
    FResizeImage.Parent      := FBackCtrl;
    FResizeImage.InverseDisp := True;
    FResizeImage.GPBitmap := LGPBitmap;
  finally
    FreeAndNil(LGPBitmap);
  end;
end;

end.



04_画像の指定矩形領域をコピーして別の画像にする


画像の一部だけをコピーして，別の画像描画用コントロールに表示する例です．
方法と手順は前項のサンプルと同じですが，新規に作成する TGPBitmap のサイズは，コピーする矩形領域と同じにします．



図5
画像の一部 (矩形領域) をコピーして別の画像にする例

リスト6
画像の一部 (矩形領域) をコピーして別の画像にする例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin, ExtDlgs, GDIPAPI, GDIPOBJ, GDIPUTIL,
  plGPResizeImage,
  plBaseDragResize,
  plContainerPanel;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl      : TplContainerPanel;
    FResizeImage   : TplGPResizeImage;
    FLoadInitDir   : string;
    FImageFilePath : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  //背景用のコントロール生成
  FBackCtrl := TplContainerPanel.Create(Self);
  FBackCtrl.Parent    := Self;
  FBackCtrl.Align     := alClient;
  FBackCtrl.BackImage := True;
end;

//=============================================================================
//  [読み込み] ボタン
//  画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenPictureDialog1.Filter     := '画像ファイル|*.bmp;*.png;*.jpg;*.gif';
  OpenPictureDialog1.InitialDir := FLoadInitDir;
  if not OpenPictureDialog1.Execute then exit;

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


  //表示中の描画コントロールは全て削除
  FBackCtrl.DeleteAllCtrls;

  //新規に描画コントロールを生成
  FResizeImage := TplGPResizeImage.Create(Self);
  FResizeImage.Parent      := FBackCtrl;
  FResizeImage.InverseDisp := True;
  FResizeImage.LoadFromFile(FImageFilePath);
end;

//=============================================================================
//  [指定範囲コピー] ボタン
//  表示中の画像の一部を取得して別の描画コントロールで表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LCtrl        : TplGPResizeImage;
  LCtrlWidth   : Integer;
  LCtrlHeight  : Integer;
  LCopyRect    : TRect;
  LDstWidth    : Integer;
  LDstHeight   : Integer;
  LSrcGPBitmap : TGPBitmap;
  LDstGPBitmap : TGPBitmap;
  LGPGraphics  : TGPGraphics;
  LGPImageAttr : TGPImageAttributes;
begin
  if FBackCtrl.CtrlList.Count = 0 then Exit;

  try
  // 描画中の描画コントロールを取得
  // 最初の画像を操作対象とする
    LCtrl := TplGPResizeImage(FBackCtrl.CtrlList[0]);

    LCtrlWidth  := LCtrl.Width;
    LCtrlHeight := LCtrl.Height;
    LSrcGPBitmap := TGPBitmap.Create(LCtrlWidth, LCtrlHeight);
    // 表示中の画像 (表示状態) を LSrcGPBitmap に取得
    LCtrl.DrawRoutine(nil, LSrcGPBitmap);

    // コピー範囲を設定
    LCopyRect := Bounds(20, 20, LCtrl.Width div 2, LCtrl.Height div 2);

    // コピーした画像を格納する TGPBitmap を作成
    LDstWidth    := LCopyRect.Right - LCopyRect.Left;
    LDstHeight   := LCopyRect.Bottom - LCopyRect.Top;
    LDstGPBitmap := TGPBitmap.Create(LDstWidth, LDstHeight);


    // 貼り付け先の TGPBitmap を描画先とした TGPGraphics を生成
    LGPGraphics := TGPGraphics.Create(LDstGPBitmap);

    // アンチエイリアス処理の設定
    LGPImageAttr := TGPImageAttributes.Create;
    LGPImageAttr.SetWrapMode(WrapModeTileFlipXY);
    LGPGraphics.SetPixelOffsetMode(PixelOffsetModeHalf);

    // コピー実行
    LGPGraphics.DrawImage(LSrcGPBitmap,
                          MakeRect(0, 0, LDstWidth, LDstHeight),
                          LCopyRect.Left,
                          LCopyRect.Top,
                          LCopyRect.Right  - LCopyRect.Left,
                          LCopyRect.Bottom - LCopyRect.Top,
                          UnitPixel,
                          LGPImageAttr);


    // コピーした画像を描画コントロールを新規に作成してそこに描画
    FResizeImage := TplGPResizeImage.Create(Self);
    FResizeImage.Parent      := FBackCtrl;
    FResizeImage.InverseDisp := True;
    FResizeImage.GPBitmap := LDstGPBitmap;
  finally
    FreeAndNil(LSrcGPBitmap);
    FreeAndNil(LDstGPBitmap);
    FreeAndNil(LGPGraphics);
    FreeAndNil(LGPImageAttr);
  end;
end;

end.



05_画像のピクセルの操作例 - ピクセルの色を変更


今度は画像のピクセルの色を変更する例です．表示サイズの画像の左下のピクセルと同じ色を別の色に変更してみます．ピクセルの操作には，TBitmap の ScanLine と同じような手法を利用して処理を光速化しています．
これまでのサンプルと同じ方法で，描画中の画像の TGPBitmap を取得します．取得した TGPbitmap に対しい処理を行います．処理した　TGPBitmap を GPBitmap プロパティ代入します．



[備考]
本サンプルは表示画像の編集です．表示画像の編集は，DrawRoutine メソッドで現在の TGPBitmap を取得して，それに対して操作します．操作を終了した TGPBitmap を現在の画像とします．
一方，同じ画像の編集でも，アイコン画像の等の編集の場合，表示している画像は，通常は元の画像を拡大表示しています．拡大表示している画像が直接の編集対象ではありません．そのような場合は，元の TGPBitmap に対して操作 (描画) して，その結果としての拡大表示を更新します．

本ページのサンプルは「表示サイズと反転状態の画像」を操作対象としています．




図6
画像を読み込んで移動リサイズ
図7
ピクセルの色を変更した結果
図8
透明色にしてみる

リスト7
画像のピクセルの色を変更する例		 
//=============================================================================
//  描画コントロールに描画中の画像のピクセルの色を変更する例
//
//  現在表示中のサイズ(反転時状態も含めて)の画像に対して操作
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LCtrl       : TplGPResizeImage;
  LCtrlWidth  : Integer;
  LCtrlHeight : Integer;
  LGPBitmap   : TGPBitmap;
  LGPColor    : TGPColor;
  LGPNewColor : TGPColor;
begin
  if FBackCtrl.CtrlList.Count = 0 then exit;

  if Sender = nil then begin
    LGPNewColor :=0;
  end else begin
    if not ColorDialog1.Execute then exit;
    LGPNewColor := ColorRefToARGB(ColorDialog1.Color);
  end;

  try
    //描画コントロールのインスタンスを取得
    LCtrl := TplGPResizeImage(FBackCtrl.CtrlList[0]);
    //そのコントロールに描画中のサイズで新規にTGPBitmapを生成
    LCtrlWidth  := LCtrl.Width;
    LCtrlHeight := LCtrl.Height;
    LGPBitmap   := TGPBitmap.Create(LCtrlWidth, LCtrlHeight);

    //作成したTGPBitmapに現在表示中の画像を描画
    LCtrl.DrawRoutine(nil, LGPBitmap);

    //画像の左下のピクセルの色を取得
    LGPBitmap.GetPixel(0, LGPBitmap.GetHeight - 1, LGPColor);
    //その色と同じ色のピクセルを別の色に変更
    ChangeColor(LGPBitmap, LGPColor, LGPNewColor);

    //編集したTGPBitmapを描画コントロールの新しい画像とする
    LCtrl.GPBitmap := LGPBitmap;
  finally
    FreeAndNil(LGPBitmap);
  end;
end;

//=============================================================================
//  Image1のOnClickイベント処理
//  透明色に変更する
//=============================================================================
procedure TForm1.Image1Click(Sender: TObject);
begin
  Button2Click(nil);
end;

//-----------------------------------------------------------------------------
//  指定した色のピクセルを別の色に変更する関数
//
//  GDI+にはTColorMapで色を変更できるがTColorMapはカラーマップの変更なので
//  画面上では指定した色でないピクセルの色が変更される場合がある
//-----------------------------------------------------------------------------
function TForm1.ChangeColor(TarGPBitmap: TGPBitmap; OldColor,
  NewColor: TGPColor): Boolean;
var
  LImgWidth   : Integer;
  LImgHeight  : Integer;
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LAValue     : Byte;
  LRValue     : Byte;
  LGValue     : Byte;
  LBValue     : Byte;
  LOldColor   : TGPColor;
begin
  Result := False;

  LImgWidth  := TarGPBitmap.GetWidth;
  LImgHeight := TarGPBitmap.GetHeight;

  //TGPBitmapのビットマップデータ取得
  if TarGPBitmap.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight), ImageLockModeWrite,
                                 PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  LScanLine   := LBmpData.Scan0;
  LDataStride := LBmpData.Stride;

  for LYPos := 0 to LImgHeight - 1 do begin
    LpRGBQuad  := PRGBQuad(LScanLine);

    for LXPos := 0 to LImgWidth - 1 do begin

      LAValue   := LpRGBQuad^.rgbReserved;
      LRValue   := LpRGBQuad^.rgbRed;
      LGValue   := LpRGBQuad^.rgbGreen;
      LBValue   := LpRGBQuad^.rgbBlue;
      LOldColor := MakeColor(LAValue, LRValue, LGValue, LBValue);

      if LOldColor = OldColor then begin
        LpRGBQuad^.rgbReserved := GetAlpha(NewColor);
        LpRGBQuad^.rgbRed      := GetRed(NewColor);
        LpRGBQuad^.rgbGreen    := GetGreen(NewColor);
        LpRGBQuad^.rgbBlue     := GetBlue(NewColor);
      end;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

  TarGPBitmap.UnlockBits(LBmpData);
  Result := True;
end;



06_画像描画用クラスのソースコード


画像描画用クラスのコントロールのソースコードです．

TImage に描画している画像を操作する時は，TImage が内部でオフスクリーンビットマップを生成して自動で処理してくれます．GDI+ 描画する時は本ページのサンプルのように，TImage が内部で処理することを自前で行わなければなりません．
DrawRoutine メソッドに TGPBitmap 型の引数を追加したのも，GPBitmap プロパティを実装しているのもそのような用途に使えるようにするためです．



リスト8
画像描画クラスのコントロールのソースコード
このユニットファイルをライブラリのパスが通った場所に置いて使用する		 
unit plGPResizeImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  plBaseDragResize, GDIPOBJ, GDIPAPI, GDIPUTIL, Dialogs;
type
  TplGPResizeImage = class(TplBaseDragResize)
  private
    FImageFilePath : string;
    FGPBitmap      : TGPBitmap;
    FMemStream     : TBytesStream;
    procedure SetFGPBitmap(const Value: TGPBitmap);
    function GetFGPBitmap: TGPBitmap;
    procedure WriteGPBitmap(AWriter: TStream);
    procedure ReadGPBitmap(AReader: TStream);
  protected
  procedure DefineProperties(Filer: TFiler); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadFromFile(AFilePath: string);
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
    property GPBitmap : TGPBitmap read GetFGPBitmap write SetFGPBitmap;
  end;

implementation

uses
  GifImg,
  StrUtils;

{ TplGPResizeImage }

//=============================================================================
//  コンストラクタ
//=============================================================================
constructor TplGPResizeImage.Create(AOwner: TComponent);
begin
  inherited;

  FGPBitmap  := TGPBitmap.Create;
  FMemStream := TBytesStream.Create;
end;

//=============================================================================
//  デコンストラクタ
//=============================================================================
destructor TplGPResizeImage.Destroy;
begin
  if Assigned(FGPBitmap)  then FreeAndNil(FGPBitmap);
  if Assigned(FMemStream) then FreeAndNil(FMemStream);

  inherited;
end;

//=============================================================================
//  Loaded メソッド
//  保存の時には表示状態のままを画像として保存している
//  それが元の画像となるので反転フラグは False にする
//=============================================================================
procedure TplGPResizeImage.Loaded;
begin
  inherited;

  InverseHolz := False;
  InverseVert := False;
end;

//=============================================================================
//  DefineProperties メソッド
//  publshed ではない，あねいは published では保存できないプロはデイの操作用メソッド
//  このクラスでは GPBitmap プロパティ用
//=============================================================================
procedure TplGPResizeImage.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('Value GPbitmap', ReadGPBitmap, WriteGPBitmap, True);
end;

//-----------------------------------------------------------------------------
//  GPBitmap プロパティの書き込み用メソッド
//  GetGPBitmap で現在の描画状態の画像を取得してから書き込む
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.WriteGPBitmap(AWriter: TStream);
var
  LBitmap : TBitmap;
  LGPBmp  : TGPBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LGPBmp := GetGPBitmap;
    GPBitmapToBitmap(LGPBmp, LBitmap);
    LBitmap.SaveToStream(Awriter);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  GPBitmap プロパティの読み込み用メソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.ReadGPBitmap(AReader: TStream);
var
  LBitmap : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromStream(AReader);
    BitmapToGPBitmap(LBitmap, FGPBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  LoadFromFile メソッド
//  画像をファイルから読み込む
//  ストリームに保存してそのストリームからTGPBitmapを生成する
//
//  BitmapToGPBitmap は TBitmap を TGPBitmap に変換するメソッド
//  これは TplBaseDragResize のメソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.LoadFromFile(AFilePath: string);
var
  LCharAry : Array [0..1] of AnsiChar;
  LBitmap  : TBitmap;
begin
  FImageFilePath := AFilePath;
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);

  FMemStream.Clear;
  FMemStream.LoadFromFile(FImageFilePath);

  // 読み込んだのがビットマップ画像かを確認
  FillChar(LCharAry, SizeOf(LCharAry), #0);
  FMemStream.Position := 0;
  FMemStream.Read(LCharAry, 2);

  // ビットマップ画像の場合はアルファ値を処理した TGPBitmap に変換
  // ビットマップ画像を TGPBitmap で読み込むとアルファ値を処理してくれない
  if LCharAry = 'BM' then begin
    LBitmap  := TBitmap.Create;
    try
      FGPBitmap := TGPBitmap.Create;
      LBitmap.PixelFormat := pf32bit;
      FMemStream.Position := 0;
      LBitmap.LoadFromStream(FMemStream);
      BitmapToGPBitmap(LBitmap, FGPBitmap);
    finally
      FreeAndNil(LBitmap);
    end;
  end else begin
    FMemStream.Position := 0;
    FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
  end;

  SetBounds(Left, Top, FGPBitmap.GetWidth, FGPBitmap.GetHeight);
end;

//-----------------------------------------------------------------------------
//  GPBitmapプロパティの取得用メソッド
//  このプロパティで取得する画像は元のTGPBitmap．サイズも元のサイズ
//-----------------------------------------------------------------------------
function TplGPResizeImage.GetFGPBitmap: TGPBitmap;
begin
  if not Assigned(FGPBitmap) then begin
    Result := nil;
  end else begin
    Result := TGPBitmap(FGPBitmap.Clone);
  end;
end;

//-----------------------------------------------------------------------------
//  GPBitmapプロパティの設定用メソッド
//  FGPBitmap プロパティの値は現在表示中の画像と入れ換え
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.SetFGPBitmap(const Value: TGPBitmap);
begin
//if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);

  FMemStream.Clear;
  FGPBitmap := TGPBitmap(Value.Clone);
  Invalidate;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  描画する画像は FGPBitmap プロパティの画像
//
//  描画開始位置は(DrawLeft, DrawTop)
//  幅と高さは DrawWidth, DrawHeight
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LGPGraphic   : TGPGraphics;
  LGPImageAttr : TGPImageAttributes;
begin
  inherited;

  if (ACanvas = nil) and (AGPBitmap = nil) then Exit;
  if not Assigned(FGPBitmap) then Exit;


    // TGPGraphicsオブジェクトを生成
    if ACanvas = nil then begin
      LGPGraphic := TGPGraphics.Create(AGPBitmap);
    end else begin
      LGPGraphic := TGPGraphics.Create(ACanvas.Handle);
    end;

  if AntiAliasing and (ZoomValue = 100) then begin
    LGPImageAttr := TGPImageAttributes.Create;
    LGPImageAttr.SetWrapMode(WrapModeTileFlipXY);
    LGPGraphic.SetPixelOffsetMode(PixelOffsetModeHalf);
  end else begin
    LGPGraphic.SetInterpolationMode(InterpolationModeNearestNeighbor);
    LGPGraphic.SetPixelOffsetMode(PixelOffsetModeHalf);
    LGPImageAttr := nil;
  end;

  LGPGraphic.DrawImage(FGPBitmap,
                       MakeRect(DrawLeft, DrawTop, DrawWidth, DrawHeight),
                       0,
                       0,
                       FGPBitmap.GetWidth,
                       FGPBitmap.GetHeight,
                       UnitPixel,
                       LGPImageAttr);

  FreeAndNil(LGPGraphic);
  FreeAndNil(LGPImageAttr);
end;

end.