Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年09月20日] [更新 2017年09月20日]　画像・図形の移動リサイズ関係サンプル
画像・図形の移動リサイズ関係サンプル
R030_画像を描画するクラスの例
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
R030_ResizeImage.zip　[3,511 KB]　2017年09月20日版 (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, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs, plContainerPanel, ExtCtrls, plGPResizeImage;

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 画像ではあません．

まず，表示サイズと同じ TGPbitmap を新規に作成します．DrawRoutine メソッドの第 1 引数の値を nil にして，作成した TGPBitmap に描画します．すると表示と同じ TGPBitmap 画像ができます．それを保存します．保存には TGPBitmap.Save メソッドを使用します．
TBitmap.Canvas に描画することもできますが，GDI+ はアルファチャンネル付きの画像をビットマップとしては正常に処理してくれないことがあります． 


TplGPResizeImage.DrawRoutine (nil, AGPBitmap)


[備考]
TGPBitmap からビットマップを取得するメソッドとして TGPBitamp.GetHBITMAP メソッドがありますが，これもビットマップのアルファチャンネルを正常に処理しないことがあります．
TGPBitmap から TBitmap を取得するには，TGPBitmap.Save メソッドで一度ビットマップ画像としてメモリストリーム，あるいはディスクに保存して，その画像ファイルを TBitmap に読み込む方法が確実のようです．



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

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

interface

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

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;

//=============================================================================
//  描画コントロールに表示中の画像をビットマップとして保存する例
//
//  TGPBPBitmapに描画してTGPBitmap.Saveメソッドで保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSaveFilePath : string;
  LCtrl         : TplGPResizeImage;
  LGPBitmap     : TGPBitmap;
  LImgGUID      : TGUID;
begin
  LSaveFilePath := ExpandFileName('000.bmp');
  Image1.Picture.Assign(nil);

  try
    //描画オブジェクトのインスタンスを取得
    //1つしか作成しないのでインデックスは常に0
    LCtrl := TplGPResizeImage(FBackCtrl.CtrlList[0]);

    //TGPBitmapを作成．サイズは現在の描画コントロールのサイズ
    LGPBitmap := TGPBitmap.Create(LCtrl.Width, LCtrl.Height);

    //そのTGPBitmapに画像を描画
    LCtrl.DrawRoutine(nil, LGPBitmap);

    //TGPBitmapをビットマップ画像として保存
    if GetEncoderClsid('image/bmp', LImgGUID) >= 0 then begin
      LGPBitmap.Save(LSaveFilePath, LImgGUID);

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

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

end.


TGPBitmap を TImage に描画するという目的だけであれば，TGPBitmap を TImage.Canvas に描画すれば TImage に表示できます．
また，以下のように，TGPBitmap 画像を TBitmap の画像としてメモリストリームに保存して利用することも考えられます．



リスト3
TGPBitmap 画像をビットマップとしてメモリストリームに保存する例		 
procedure TForm1.Button2Click(Sender: TObject);
var
  LCtrl      : TplGPResizeImage;
  LGPBitmap  : TGPBitmap;
  LMemStream : TMemoryStream;
  LImgGUID   : TGUID;
begin
  Image1.Picture.Assign(nil);

  LMemStream := TMemoryStream.Create;
  try
    //描画オブジェクトのインスタンスを取得
    //1つしか作成しないのでインデックスは常に0
    LCtrl := TplGPResizeImage(FBackCtrl.CtrlList[0]);

    //TGPBitmapを作成．サイズは現在の描画コントロールのサイズ
    LGPBitmap := TGPBitmap.Create(LCtrl.Width, LCtrl.Height);

    //そのTGPBitmapに画像を描画
    LCtrl.DrawRoutine(nil, LGPBitmap);

    //TGPBitmapをビットマップ画像として保存
    if GetEncoderClsid('image/bmp', LImgGUID) >= 0 then begin
      LGPBitmap.Save(TStreamAdapter.Create(LMemStream), LImgGUID);
      LMemStream.Position := 0;

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

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



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


表示状態の画像を複製 (コピー) して，別の画像描画用コントロールで表示します．
前項のサンプルと同じく，表示サイズの TGPBitmap を新規に作成して DrawRoutine で描画します．すると表示と同じ TGPBitmap 画像ができます．そして，新規に画像描画用のコントロールを生成し，その GPBitmap プロパティに代入します．   


TplGPResizeImage.DrawRoutine (nil, AGPBitmap)
TplGPResizeImage.GPBitmap


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

リスト4
表示中の画像を複製して別の描画コントロールで表示		 
//=============================================================================
//  描画コントロールに表示中の画像の複製を作成
//
//  新しいTGPBitmapを作成してそこに描画する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSaveFilePath : string;
  LCtrl         : TplGPResizeImage;
  LGPBitmap     : TGPBitmap;
begin
  LSaveFilePath := ExpandFileName('000.bmp');

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

    //TGPBitmapを作成．サイズは現在の描画コントロールのサイズ
    LGPBitmap := TGPBitmap.Create(LCtrl.Width, LCtrl.Height);

    //そのTGPBitmapに画像を描画
    LCtrl.DrawRoutine(nil, LGPBitmap);

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



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


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



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

リスト5
画像の一部 (矩形領域) をコピーして別の画像にする例		 
//=============================================================================
//  表示中の画像の一部を取得して別の描画コントロールで表示
//=============================================================================
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
  try
  //描画中の描画コントロールを取得
  //最初の画像を操作対象とする
    LCtrl := TplGPResizeImage(FBackCtrl.CtrlList[0]);

    //表示中(反転状態も含めて)の画像サイズで新規にTGPBitmapを作成
    LCtrlWidth   := LCtrl.Width;
    LCtrlHeight  := LCtrl.Height;
    LSrcGPBitmap := TGPBitmap.Create(LCtrlWidth, LCtrlHeight);

    //コピー範囲を設定
    LCopyRect := Bounds(20, 20, LCtrlWidth div 2, LCtrlHeight div 2);

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

    //LSrcGPBitmapに表示中の画像を描画
    LCtrl.DrawRoutine(nil, LSrcGPBitmap);


    //コピー先のTGPBitmapに元の画像の指定範囲を描画
    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;



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


今度は画像のピクセルの色を変更する例です．表示サイズの画像の左下のピクセルと同じ色を別の色に変更してみます．
方法と手順はこれまでのサンプルと同じです．表示サイズと同じサイズの TGPBitmap を新規に作成して DrawRoutine で描画します．すると表示と同じ TGPBitmap 画像ができます．
その TGPBitmap のピクセルの色を変更して，自分自身の GPBitmap プロパティ代入します．



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

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




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

リスト6
画像のピクセルの色を変更する例		 
//=============================================================================
//  描画コントロールに描画中の画像のピクセルの色を変更する例
//
//  現在表示中のサイズ(反転時状態も含めて)の画像に対して操作
//=============================================================================
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 プロパティを実装しているのもそのような用途に使えるようにするためです．



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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  plBaseDragResize, GDIPOBJ, GDIPAPI, GDIPUTIL;

type
  TplGPResizeImage = class(TplBaseDragResize)
  private
    FImageFilePath : string;
    FGPBitmap      : TGPBitmap;
    FMemStream     : TBytesStream;
    procedure SetFGPBitmap(const Value: TGPBitmap);
    function GetFGPBitmap: TGPBitmap;
  protected
    procedure CheckIsBitmap_AndAlphaValueSet;
    function SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
      PixelFmt: TPixelFormat; SrcBitmap: TBitmap): Boolean;
  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;

//-----------------------------------------------------------------------------
//  LoadFromFileメソッド
//  画像をファイルから読み込む
//  ストリームに保存してそのストリームからTGPBitmapを生成する
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.LoadFromFile(AFilePath: string);
begin
  FImageFilePath := AFilePath;
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);

  FMemStream.Clear;
  FMemStream.LoadFromFile(FImageFilePath);

  FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
  CheckIsBitmap_AndAlphaValueSet;
  SetBounds(0, 0, 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プロパティの設定用メソッド
//  現在表示中の画像と入れ換え
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.SetFGPBitmap(const Value: TGPBitmap);
var
  LFlag : Boolean;
begin
  LFlag := (FGPBitmap.GetWidth = 0) and (FGPBitmap.GetHeight = 0);
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);

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

  ResetInverseDisp;
  if LFlag then begin
    Self.SetBounds(Left, Top, FGPBitmap.GetWidth, FGPBitmap.GetHeight);
  end else begin
    SetBounds(Left, Top, Width, Height);
  end;
  Invalidate;
end;

//-----------------------------------------------------------------------------
//  読み込んだ画像ファイルがビットマップ画像かの判定
//  アルファチャンネル付きのビットマップの時はピクセルの操作を実行
//  GDI+はアルファチャンネル付きのビットマップをサポートしていないのでその対策
//-----------------------------------------------------------------------------
procedure TplGPResizeImage.CheckIsBitmap_AndAlphaValueSet;
var
  LText   : string;
  LBitmap : TBitmap;
  i       : Integer;
begin
  for i := 0 to 2 do begin
    LText := LText + Char(FMemStream.Bytes[i]);
  end;

  if LeftStr(LText, 2) = 'BM' then begin
    LBitmap  := TBitmap.Create;
    try
      LBitmap.PixelFormat := pf32bit;
      FMemStream.Position := 0;
      LBitmap.LoadFromStream(FMemStream);
      if (LBitmap.PixelFormat = pf32bit) then begin
        SetAlphaValueFromTBitmap(FGPBitmap, PixelFormat32bppARGB, LBitmap);
      end;
    finally
      FreeAndNil(LBitmap);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  アルファ値の処理
//  TGPBitmapはTBitmapのアルファチャンネルを処理しない
//  TBitmapのアルファ値をTGPBitmapのアルファ値に代入する
//  この処理でアルファチャンネル付きTBitmapを表示可能にする
//  元のビット深さが32bit以上用
//-----------------------------------------------------------------------------
function TplGPResizeImage.SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
  PixelFmt: TPixelFormat; SrcBitmap: TBitmap): Boolean;
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LWidth      : Integer;
  LHeight     : Integer;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LScanArray  : PRGBQArray;
  LAValue     : Byte;
  LRValue     : Byte;
  LGValue     : Byte;
  LBValue     : Byte;
begin
  Result := False;

  LWidth  := DstGPBitmap.GetWidth;
  LHeight := DstGPBitmap.GetHeight;

  if DstGPBitmap.LockBits(MakeRect(0, 0, LWidth, LHeight), ImageLockModeWrite,
                                   PixelFmt, LBmpData) <> Ok then exit;

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

  for LYPos := 0 to LHeight - 1 do begin
    LpRGBQuad  := PRGBQuad(LScanLine);
    LScanArray := SrcBitmap.ScanLine[LYPos];

    for LXPos := 0 to LWidth - 1 do begin

      LAValue := LScanArray[LXPos].rgbReserved;
      LRValue := LScanArray[LXPos].rgbRed;
      LGValue := LScanArray[LXPos].rgbGreen;
      LBValue := LScanArray[LXPos].rgbBlue;

      if (RGB(LRValue, LGValue, LBValue) = 0) and (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved :=  0;
      end else
      if (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved := $FF;
      end else begin
        LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      end;
      //色の塗り潰しの色指定が全てARGBで指定可能であればこの1行だけでよい
      //LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

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

//=============================================================================
//  実際の描画処理を実行するDrawRoutineメソッドの継承メソッド
//=============================================================================
procedure TplGPResizeImage.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LGPGraphic   : TGPGraphics;
  LGPImageAttr : TGPImageAttributes;
begin
  inherited;
  if not Assigned(FGPBitmap) then exit;

  if ACanvas = nil then begin
    if not Assigned(AGPBitmap) then exit;
    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.