Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年03月12日] [更新 2020年11月30日] Delphi サンプルプログラム集
   
366_コントロール類をビットマップ画像として取得
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
366_CaptureControls.zip [5.8 MB] 2020年11月30日版 (EXE 同梱)







コントロール類をビットマップ画像として取得


自アプリ内のコントロールをキャプチャして,ビットマップ画像にするサンプルです.

テスト結果の画像を確認できないと不便です.そこで,下図のようなキャプチャした画像を確認表示するためのフォームを使用しています.このフォームはルートフォルダ直下にあります.このキャプチャ画像表示用フォームをプロジェクトに追加しています.


[備考]
Windows API の PrintWindow 関数を使用すると,ウィンドウハンドルが取得できれば,他のアプリのコントロールもキャプチャできます.



図1
キャプチャ画像確認用フォーム
  • フォーム上の Image1 の AutoSize プロパティの値を Ttue にしている (デフォルトは False)

リスト1
サンプルプログラムのプロジェクトソース
キャプチャ画像確認用フォームをプロジェクトに追加している
program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  FormCaptureImageUnit in '..\FormCaptureImageUnit.pas' {FormCaptureImage};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TFormCaptureImage, FormCaptureImage);
  Application.Run;
end.




01_フォームのクライアント領域を GetFormImage でキャプチャ


TCustomForm クラスには GetFormImage メソッドがあり,これを使用するとフォームのクライアント領域の内容をビットマップ画像として取得てきます.
本サンプルのフォームが別のアプリのウィンドウに隠れていてもキャプチャできます.



[備考]
GetFormImage メソッドは,全てのコントロールを TBitmap.Canas に描画するわけではありません.例えば TRichEdit が表示している内容は取得できません.

フォームのクライアント領域を TPrinter.Canvas に出力,つまり印刷するための TForm.Print メソッドがあります.この Print メソッドは,GetFormImage でビットマップを作成して印刷しています.したがって,TRichEdit が表示している内容は印刷できません.



図2
設計時画面
  • TPageControl コンポーネントを配置
  • そこに TTabSheet を追加
  • 動作確認用にいろいろなコントロールを配置
  • この後のサンプルでもこのフォームを使用している
図3
フォームのクライアント領域をキャプチャ

リスト2
GetFormImage メソッドを使用して,フォームのクライアント領域をビットマップ画像で取得
uses
  FormCaptureImageUnit;

{$R *.dfm}

//=============================================================================
//  TForm.GetFormImageメソッドでフォームのクライアント領域をキャプチャ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBmpOrigin : TBitmap;
begin
  //キャプチャーした画像を格納するビットマップを作成
  LBmpOrigin := TBitmap.Create;

  LBmpOrigin.Canvas.Lock;
  try
    LBmpOrigin := Form1.GetFormImage;
    //キャプチャした画像をプレビュー表示
    PreviewCaptureImage(LBmpOrigin);
  finally
    LBmpOrigin.Canvas.Unlock;
    //解放処理
    FreeAndNil(LBmpOrigin);
  end;
end;

//----------------------------------------------------------------------------
//  キャプチャしたビットマップをプレビュー表示するメソッド
//  Imaage1のサイズを設定して描画する場合は,Image1.AutoSizeの値をFalseにする
//----------------------------------------------------------------------------
procedure TForm1.PreviewCaptureImage(Bmp: TBitmap);
begin
  //追加描画可能なように代入とする.Assignだと追加描画は不可
  FormCaptureImage.Image1.Picture.Bitmap := nil;
  FormCaptureImage.Image1.Picture.Bitmap := Bmp;
  FormCaptureImage.Image1.Update;

  FormCaptureImage.Show;
end;




02_PaintTo メソッドによるコントロールのキャプチャ


TForm 以外のコントロールにはビットマップを取得するメソッドはありませんが,TWinControl には,コントロールのイメージをビットマップに描画する PaintTo メソッドがあります.この PaintTo メソッドを使用したサンプルです.
PaintTo メソッドは,対象のコントロールのクライアント領域を描画します.
親コントロールで PaintTo メソッドを実行すると,その上に配置されている子コントロールも描画してくれます.本サンプルのフォームが別のアプリのウィンドウに隠れていても描画してくれます.

本サンプルは,最初のサンプルのフォームに TCheckBox を追加しています.



[備考 1]
全ての TWinControl が PaintTo で正常に描画できるわけではありません.例えば TRichEdit は自分自身をビットマップに描画できません.利用する際は確認が必要です.
GetFormImage や PaintTo でビットマップに描画できないコントロールも,後述の PrintWindow であれば描画できます.


[備考 2]
PaintTo メソッドを実行する前に,TBitmap.Canvas.Lock を実行しておかないと描画の一部が欠落する場合があります.



図4
TabSheet1 をキャプチャした結果
図5
TabSheet1 上の Panel1 をキャプチャ

リスト3
PaintTo メソッドによるコントロールのキャプチャ
uses
  FormCaptureImageUnit;

{$R *.dfm}

//=============================================================================
//  TWinControl.PaintToメソッドによるコントロールのキャプチャ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LTargetControl : TWinControl;
  LBmpOrigin     : TBitmap;
begin
  //キャプチャー対象のコントロール(TWinControl)
  if CheckBox2.Checked then begin
    LTargetControl := Panel1;
  end else begin
    LTargetControl := TabSheet1;
  end;


  //キャプチャーした画像を格納するビットマップを作成
  LBmpOrigin             := TBitmap.Create;
  LBmpOrigin.PixelFormat := pf32bit;
  LBmpOrigin.Width       := LTargetControl.Width;
  LBmpOrigin.Height      := LTargetControl.Height;

  LBmpOrigin.Canvas.Lock;
  try
    //描画開始の位置を指定してキャプチャ
    //対象コントロールをキャプチャ(PaintToでビットマップに描画)
    LTargetControl.PaintTo(LBmpOrigin.Canvas, 0, 0);

    //キャプチャした画像をプレビュー表示
    PreviewCaptureImage(LBmpOrigin);
  finally
    LBmpOrigin.Canvas.Unlock;
    //解放処理
    FreeAndNil(LBmpOrigin);
  end;
end;

//----------------------------------------------------------------------------
//  キャプチャしたビットマップをプレビュー表示するメソッド
//  Imaage1のサイズを設定して描画する場合は,Image1.AutoSizeの値をFalseにする
//----------------------------------------------------------------------------
procedure TForm1.PreviewCaptureImage(Bmp: TBitmap);
begin
  //追加描画可能なように代入とする.Assignだと追加描画は不可
  FormCaptureImage.Image1.Picture.Bitmap := nil;
  FormCaptureImage.Image1.Picture.Bitmap := Bmp;
  FormCaptureImage.Image1.Update;

  FormCaptureImage.Show;
end;




03_非アクティブな状態のコントロールをキャプチャ


PaintTo メソッドはコントロールを描画するわけですから,非アクティブな状態,非可視状態のコントロールも描画できます.
下図は TabSheet2 をアクティブにした状態で TabSheet1を描画した結果です.この結果を見るとボタン類がキャプチャできていません.PaintTo メソッドは,非可視状態の TButtonControl は描画してくれないようです.

本サンプルは,最初のサンプルのフォームに TCheckBox を追加しています.



図6
隠れて見えない TabSheet1 をキャプチャ
  • TButtonControl の派生コンポーネントが描画されていない
  • TButtonControl 類をキャプチャする必要がなければ問題ない

キャプチャする TTabSheet をアクティブにして,キャプチャ後に元の TTabSheet をアクティブにする手もありますが,切り換え時に少しチラつきます.
下に示すコードは,TButtonControl の派生コントロールの描画を別ルーチンにして,WM_PRINT メッセージで描画しています.非可視状態になっている TButtonControl の派生コントロールは,WM_PAINT では描画しません.



[備考]
このサンプルの非アクティブなコントロールのキャプチャは,コントロールの Z オーダを考慮していません.したがって,重なったコントロールが正しく描画されない場合があります.




図7
隠れて見えない TabSheet1 をキャプチャ
図8
TabSheet1 上の Panel1 をキャプチャ

リスト4
PaintTo メソッドを使用して,非アクティブなコントロールもキャプチャ
uses
  FormCaptureImageUnit,
  TypInfo;

{$R *.dfm}

//=============================================================================
//  TWinControl.PaintToメソッドによるコントロールのキャプチャ
//
//  隠れて見えないコントロールをキャプチャする例
//  隠れたコントロールでPaintToメソッドで描画できないのはTButonControl
//
//  GetPropInfoの使用にはusesにTypInfoが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LTargetControl : TWinControl;
  LBmpOrigin     : TBitmap;
  LOffsetX       : Integer;
  LOffsetY       : Integer;
begin
  //キャプチャー対象のコントロール(TWinControlのみ)
  if CheckBox2.Checked then begin
    LTargetControl := Panel1;
  end else begin
    LTargetControl := TabSheet1;
  end;

  //PaintToで描画するのはクライアント領域なのでフレーム分を追加
  //他にいい方法があるかも知れない
  if GetPropInfo(LTargetControl, 'Ctl3D') <> nil then begin
    LOffsetX := 0;
    LOffsetY := 0;
  end else begin
    LOffsetX := GetSystemMetrics(SM_CXDLGFRAME);
    LOffsetY := GetSystemMetrics(SM_CYDLGFRAME);
  end;


  //キャプチャーした画像を格納するビットマップを作成
  LBmpOrigin             := TBitmap.Create;
  LBmpOrigin.PixelFormat := pf32bit;
  LBmpOrigin.Width       := LTargetControl.Width + LOffsetX * 2;
  LBmpOrigin.Height      := LTargetControl.Height + LOffsetY * 2;

  LBmpOrigin.Canvas.Lock;
  try
    //描画開始の位置を指定してキャプチャ
    //対象コントロールをキャプチャ(PaintToでビットマップに描画)
    LTargetControl.PaintTo(LBmpOrigin.Canvas, LOffsetX, LOffsetY);

    //描画できなかったTButtonControl等の描画を実行
    //TabSheet1の上に配置しているコントロールが対象とする
    if TabSheet1.Visible = False then begin
      CaputureTButtonControl(LTargetControl, LTargetControl, LBmpOrigin,
                             LOffsetX, LOffsetY);
    end;

    //キャプチャした画像をプレビュー表示
    PreviewCaptureImage(LBmpOrigin);
  finally
    LBmpOrigin.Canvas.Unlock;
    //解放処理
    FreeAndNil(LBmpOrigin);
  end;
end;

//----------------------------------------------------------------------------
//  非アクティブ状態のTButtonControl等をこのルーチンで描画
//  TButton,TBitBtn,TCheckBox等
//  WM_PRINTメッセージで描画する 
//----------------------------------------------------------------------------
procedure TForm1.CaputureTButtonControl(ATarget, AControl: TWinControl;
  ABitmap: TBitmap; AOffsetX, AOffsetY: Integer);
var
  LLParam  : Integer;
  LControl : TControl;
  LLeft    : Integer;
  LTop     : Integer;
  i        : Integer;
begin
  //描画フラグ
  LLParam := PRF_CHILDREN or PRF_CLIENT or PRF_NONCLIENT;

  for i := 0 to AControl.ControlCount - 1 do begin
    LControl := AControl.Controls[i];

    //TButtonControlだったら描画位置を計算
    if (LControl is TButtonControl) or (LControl is TCustomMemo) then begin
      if LControl.Parent = ATarget then begin
        LLeft := LControl.Left + AOffsetX;
        LTop  := LControl.Top + AOffsetY;
      end else begin
        LLeft := LControl.Parent.Left + LControl.Left + AOffsetX;
        LTop  := LControl.Parent.Top + LControl.Top + AOffsetY;
      end;


      //描画位置の実際の設定
      SetWindowOrgEx(ABitmap.Canvas.Handle, -LLeft, -LTop, nil);
      //目的のビットマップのTCanvasに描画
      //TButtonControlはWM_PAINTでは描画できない
      LControl.Perform(WM_PRINT, ABitmap.Canvas.Handle, LLParam);
    end else begin
      //再帰処理
      if LControl is TWinControl then begin
        CaputureTButtonControl(ATarget, TWinControl(LControl), ABitmap,
                               AOffsetX, AOffsetY);
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------
//  キャプチャしたビットマップをプレビュー表示するメソッド
//  Imaage1のサイズを設定して描画する場合は,Image1.AutoSizeの値をFalseにする
//----------------------------------------------------------------------------
procedure TForm1.PreviewCaptureImage(Bmp: TBitmap);
begin
  //追加描画可能なように代入とする.Assignだと追加描画は不可
  FormCaptureImage.Image1.Picture.Bitmap := nil;
  FormCaptureImage.Image1.Picture.Bitmap := Bmp;
  FormCaptureImage.Image1.Update;

  FormCaptureImage.Show;
end;




04_PrintWindow 関数でコントロールのビットマップ画像を取得


Windows API の PrintWindow 関数を使用したサンプルです.
PrintWindow 関数も,対象のウィンドウが他のウィンドウに隠れていても,隠れた部分の再描画を自動で実行してキャプチャできます.PaintTo メソッドとは違い,ウインドウハンドルを指定して実行するので,他のアプリのウインドウもキャプチャできます.たたし,非可視状態になっている非アクティブなウィンドウは正常にキャプチャできません.

本サンプルは,最初のサンプルのフォームに TRadioGroup を追加しています.



図9
隠れたウィンドウのキャプチャ
  • ボタンをクリックしたら,他のウィンドウを前面に表示する
  • キャプチャするのは 3 秒後
図10
TabSheet1 をキャプチャ
  • TabSheet1 がアクティブでないと正常にキャプチャできない
図11
Panel1 をキャプチャ
図12
自フォームをキャプチャ
  • DWM による描画は行われない
図13
TabSheet2 をアクティブにして TabSheet1 をキャプチャした場合
  • データが取得できないので何も描画されない.つまり黒となる

Windows 10 (バージョン 1607 ビルド 14393.10) でも EXE を実行して動作確認してみました.
フォームの非クライアント領域以外は正常にキャプチャできます.
PrintWindow 関数でクライアント領域だけをキャプチャするには,最後の引数を PW_CLIENTONLY (= 1) にします.



図14
サンプルの EXE 実行画面
  • これをキャプチャした結果が下の画像
図15
フォームのキャプチャ結果
  • フォームの非クライアント領域が Windows 10 のスタイルになっていない

下図は,本サンプルプログラムの EXE を Windows XP(SP3) で実行した結果です.
別のアプリのウィンドウに隠れて見えない状態でキャプチャしています.正常にキャプチャできているのが確認できます.

Windows Vista 以降では,フォームのキャプション,フォームのフレーム等の非クライアント領域の描画は DWM が行っています.DWM の描画はオフラインビットマップに描画され,デスクトップ上で見えない領域は描画しません.したがって,Windows 7, 10 では上の結果の図のようになります.

本サンプルで使用した PrintWindow 関数は,DWM による描画を全く実行しません.ウィンドウのデバイスコンテキストを GetWindowDC 関数で取得して,そのデバイスコンテキストの情報をビットマップに描画すると,見えている部分だけは DWM で描画してくれます.



図16
Windows XP での実行結果

リスト5
PrintWindow 関数を使用すると,他のアプリのウィドウに隠れている場合もキャプチャできる
ただし,フォームの非クライアント領域の DWM による描画は行われない
uses
  FormCaptureImageUnit,
  MMSystem,
  WinSpool;

{$R *.dfm}

//=============================================================================
//  PrintWindow関数によるコントロールのキャプチャ
//
//  PrintWindow関数はアクティブなコントロールウィンドウをキャプチャする
//  このフォームが他のアプリに隠れていてもキャプチャできる
//
//  PrintWindowの使用にはusesにWinSpoolが必要
//  timeGetTime等の使用にはusesにMMSystemが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStarttime     : DWORD;
  LTargetControl : TWinControl;
  LBmpOrigin     : TBitmap;
begin
  //テスト用のタイムラグ
  //指定時間が経過したらキャプチャ開始
  //その間に別のアプリのウィンドウを前面にしてテスト
  LStarttime := timeGetTime;
  while (timeGetTime - LStartTime) < 3000 do begin
    Sleep(10);
    Application.ProcessMessages;
  end;

  //キャプチャー対象のコントロール(TWinControl)
  if RadioGroup1.ItemIndex = 0 then begin
    LTargetControl := TabSheet1;
  end else
  if RadioGroup1.ItemIndex = 1 then begin
    LTargetControl := Panel1;
  end else begin
    LTargetControl := Form1;
  end;


  //キャプチャーした画像を格納するビットマップを作成
  LBmpOrigin             := TBitmap.Create;
  LBmpOrigin.PixelFormat := pf32bit;
  LBmpOrigin.Width       := LTargetControl.Width;
  LBmpOrigin.Height      := LTargetControl.Height;

  LBmpOrigin.Canvas.Lock;
  try
    //PrintWinowによるキャプチャ
    PrintWindow(LTargetControl.Handle, LBmpOrigin.Canvas.Handle, 0);

    //キャプチャした画像をプレビュー表示
    PreviewCaptureImage(LBmpOrigin);
  finally
    LBmpOrigin.Canvas.Unlock;
    //解放処理
    FreeAndNil(LBmpOrigin);
  end;
end;

//----------------------------------------------------------------------------
//  キャプチャしたビットマップをプレビュー表示するメソッド
//  Imaage1のサイズを設定して描画する場合は,Image1.AutoSizeの値をFalseにする
//----------------------------------------------------------------------------
procedure TForm1.PreviewCaptureImage(Bmp: TBitmap);
begin
  //追加描画可能なように代入とする.Assignだと追加描画は不可
  FormCaptureImage.Image1.Picture.Bitmap := nil;
  FormCaptureImage.Image1.Picture.Bitmap := Bmp;
  FormCaptureImage.Image1.Update;

  FormCaptureImage.Show;
end;


上のコードはは,自分自身をキャプチャしています.他のアプリのウィンドウをキャプチャする場合は,対象のウィンドウのウィンドウハンドルを取得する必要があります.
例えばメモ帳は,以下のコードでキャプチャできます.



リスト6
PrintWindow 関数を使用して,起動中のメモ帳のウィンドウをキャプチャする例
メモ帳が他のウィンドウに隠れていてもキャプチャできる
uses
  FormCaptureImageUnit,
  WinSpool;

{$R *.dfm}

//=============================================================================
//  メモ帳が起動していたらキャプチャするサンプル
//  メモ帳が他のウィンドウに隠れていてもキャプチャできる
//
//  PrintWindowの使用にはusesにWinSpoolが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LHandle    : HWND;
  LWndRect   : TRect;
  LBmpOrigin : TBitmap;
begin
  //メモ帳のウィンドウハンドルを取得してサイズを取得
  LHandle := FindWindow('Notepad', nil);
  if LHandle = 0 then exit;

  GetWindowRect(LHandle, LWndRect);

  //キャプチャーした画像を格納するビットマップを作成
  LBmpOrigin             := TBitmap.Create;
  LBmpOrigin.PixelFormat := pf32bit;
  LBmpOrigin.Width       := LWndRect.Right - LWndRect.Left;
  LBmpOrigin.Height      := LWndRect.Bottom - LWndRect.Top;

  LBmpOrigin.Canvas.Lock;
  try
    //PrintWinowによるキャプチャ
    PrintWindow(LHandle, LBmpOrigin.Canvas.Handle, 0);

    //キャプチャした画像をプレビュー表示
    PreviewCaptureImage(LBmpOrigin);
  finally
    LBmpOrigin.Canvas.Unlock;
    //解放処理
    FreeAndNil(LBmpOrigin);
  end;
end;

//----------------------------------------------------------------------------
//  キャプチャしたビットマップをプレビュー表示するメソッド
//  Imaage1のサイズを設定して描画する場合は,Image1.AutoSizeの値をFalseにする
//----------------------------------------------------------------------------
procedure TForm1.PreviewCaptureImage(Bmp: TBitmap);
begin
  //追加描画可能なように代入とする.Assignだと追加描画は不可
  FormCaptureImage.Image1.Picture.Bitmap := nil;
  FormCaptureImage.Image1.Picture.Bitmap := Bmp;
  FormCaptureImage.Image1.Update;

  FormCaptureImage.Show;
end;




05_スクロールボックス内のコントロール類をキャプチャ


TScrollBox (スクロールボックス) 内に描画した内容と配置しているコントロール類をキャプチャするサンプルです.
次のコードは,まず,スクロールボックスと同じサイズのビットマップを作成し,WM_PAINT メッセージでスクロールボックス内に描画している内容をビットマップの Canvas に描画します.
TButton 等の TWinControl は WM_PAINT では描画できません.位置を指定して,PaintTo メソッドでビットマップの Canvas に描画しています.

PaintTo は,対象のコントロール上に配置しているコントロールもビットマップに描画してくれますが,本サンプルの場合は,見えていない部分も描画する必要があるのでループで処理しています.



[備考 1]
WM_PAINT も WM_PRINT もプロセスを超えた操作はできませんが,同じプロセス内では有効です.
WM_PAINT も WM_PRINT も必ずしもテーマに対応した描画を行うわけではありません.したがって,コントロールによっては,期待通りの結果とならない場合があります.


[備考 2]
TStringGrid や TDBGrid もスクロールバーが表示されますが,本サンプルのような方法では見えない部分をキャプチャすることはできません.
TSrcollBox 上に配置したオブジェクト (コントロール) は,実際には描画コードが実行されています.しかし,見えない部分は描画しません.一方,TStringGrid 等では,データの表示が必要なった時に実際の描画が実行されます.




図17
設計時画面
  • TImage を配置し画像を読み込んでおく
  • TButton も 1 つ配置
  • 実行時もこの状態またはスクロールした状態でキャプチャ
図18
キャプチャ結果 (プレビュー)
  • TScrollBox 自身のキャプチャではないので,TScrollBox の背景色等は反映していない
  • TScrollBox に配置した TButton はそのまま反映される


リスト7
スクロールボックスに配置したコントロール類を含めたキャプチャ
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure PreviewCaptureImage(Bmp: TBitmap);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FormCaptureImageUnit;

{$R *.dfm}

//=============================================================================
//  TScrollBoxとそこに配置したコントロール類を含めたキャプチャ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBmpOrigin : TBitmap;
  LControl   : TControl;
  LOffsetX   : Integer;
  LOffsetY   : Integer;
  i          : Integer;
begin
  //キャプチャーした画像を格納するビットマップを作成
  LBmpOrigin             := TBitmap.Create;
  LBmpOrigin.PixelFormat := pf32bit;
  LBmpOrigin.Width       := ScrollBox1.HorzScrollBar.Range;
  LBmpOrigin.Height      := ScrollBox1.VertScrollBar.Range;

  LBmpOrigin.Canvas.Lock;
  try
    //スクロール分のオフセット
    LOffsetX := ScrollBox1.HorzScrollBar.Position;
    LOffsetY := ScrollBox1.VertScrollBar.Position;

    //位置を指定して描画
    SetWindowOrgEx(LBmpOrigin.Canvas.Handle, -LOffsetX, -LOffsetY, nil);
    ScrollBox1.Perform(WM_PAINT, LBmpOrigin.Canvas.Handle, 0);

    //WM_PAINTで描画できないコントロールを描画
    for i := 0 to ScrollBox1.ControlCount - 1 do begin
      LControl := ScrollBox1.Controls[i];
      if LControl is TWincontrol then begin
        TWinControl(LControl).PaintTo(LBmpOrigin.Canvas.Handle,
                                      LControl.Left,
                                      LControl.Top);
      end;
    end;

    //キャプチャした画像をプレビュー表示
    PreviewCaptureImage(LBmpOrigin);
  finally
    LBmpOrigin.Canvas.Unlock;
    //解放処理
    FreeAndNil(LBmpOrigin);
  end;
end;

//=============================================================================
//  キャプチャしたビットマップをプレビュー表示するメソッド
//  Imaage1のサイズを設定して描画する場合は,Image1.AutoSizeの値をFalseにする
//=============================================================================
procedure TForm1.PreviewCaptureImage(Bmp: TBitmap);
begin
  //追加描画可能なように代入とする.Assignだと追加描画は不可
  FormCaptureImage.Image1.Picture.Bitmap := nil;
  FormCaptureImage.Image1.Picture.Bitmap := Bmp;
  FormCaptureImage.Image1.Update;

  FormCaptureImage.Show;
end;

end.




06_TImage の描画内容をビットマップや他のコントロールに描画


上のサンプルでは,TScrollBox の描画内容をビットマップに描画しています.
同じ様に,コントロールの描画内容をビットマップとして取得したり,他のデバイスコンテキストに描画することができます.

次のサンプルでは,TImage の描画内容を,他のコントロールに WM_PAINT メッセージを送り,ビットマップに描画します.そして,そのビットマップを他の TImage に描画します.
また,TPanel には,その Canvas.Handle に対して WM_PAINT メッセードを送ります.TPanel の Canvas プロパティは Protected 部です.そこで,継承クラスを定義してアクセスしています.



図19
設計時画面
図20
実行結果
  • 左上の Image1 の描画内容を
    その下の Imagae2 と 右下の Panel1 に描画した結果

リスト8
TImage の描画内容を他のコントロールに描画
他のコントロールの場合にも応用できる
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyPanel = Class(TPanel);

//=============================================================================
//  TImageの描画内容を他のコントロールに描画
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LOriginBMP : TBitmap;
  LTempBMP   : TBitMap;
  LBmpWidth  : Integer;
  LBmpHeight : Integer;
begin
  Image1.Transparent :=True;

  LOriginBMP := TBitmap.Create;
  LTempBMP   := TBitmap.Create;
  try
    //ディスクからOriginBMPに画像を読み込む
    LOriginBMP.Transparent := True;
    LOriginBMP.LoadFromFile('bmp-32A.bmp');

    //後で利用するために画像の幅と高さを取得して...
    LBmpWidth  := LOriginBMP.Width;
    LBmpHeight := LOriginBMP.Height;

    //Image1に描画
    Image1.Picture.Assign(LOriginBMP);

    //TempBMPにImage1の描画内容を描画
    LTempBMP.SetSize(LBmpWidth, LBmpHeight);
    Image1.Perform(WM_PAINT, LTempBMP.Canvas.Handle, 0);
    //TempBMPをImage2に描画
    Image2.Picture.Assign(LTempBMP);

    //ついでにPanel1にも描画
    Image1.Perform(WM_PAINT, TMyPanel(Panel1).Canvas.Handle, 0);
  finally
    FreeAndNil(LOriginBMP);
    FreeAndNil(LTempBMP);
  end;
end;

end.




07_TPaintBox の描画をビットマップ画像として取得


TPaintBox コンポーネントは TGraphicControl の派生コントロールです.TGraphicControl の派生コントロールには PaintTo メソッドはありません.

図の下のコードは,Button1 をクリックすると,TPaintBox の TCanvas にビットマップ画像と直線を描画するサンプルです.このサンプルを実行して,フォームをリサイズ,つまり TPaintBox をリサイズすると,再描画が行われて,描画した内容は消えます.
TImage コントロールは,描画内容をビットマップとして保持しています.再描画の時はそのビットマップを描画します.TPaintBox は描画内容を保持していません.



図21
Button1 クリック
図22
 Form1 (PaintBox1) をリサイズ
  • 描画した内容は消去される

リスト9
TPaintBox への描画が持続的ではないことを確認するテスト
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  フォームのリサイズで TPaintBox のサイズも変更するようにしておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  PaintBox1.Align   := alBottom;
  PaintBox1.Height  := Self.ClientHeight - 35;
  PaintBox1.Anchors := [akTop, akLeft, akRight, akBottom];
end;

//=============================================================================
//  TPaintBox への描画
//  リサイズすると TPaintBox は再描画するので描画内容は消去される
//
//  TImage は描画内容をビットマップとして保持している
//  TPaintBox にはそのような機能はない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBmp : TBitmap;
begin
  PaintBox1.Refresh;

  LSrcBmp := TBitmap.Create;
  try
    // ディスクから画像を読み込む
    LSrcBmp.Transparent := True;
    LSrcBmp.LoadFromFile('bmp-32A.bmp');

    // 画像を IPaintBox に描画
    PaintBox1.Canvas.Draw(50, 30, LSrcBmp);

    // 直線を TPaintBox に描画
    PaintBox1.Canvas.Pen.Color := clBlack;
    PaintBox1.Canvas.Pen.Width := 5;
    PaintBox1.Canvas.MoveTo(0, 0);
    PaintBox1.Canvas.LineTo(PaintBox1.Width, PaintBox1.Height);
  finally
    FreeAndNil(LSrcBmp);
  end;
end;

end.


再描画によって描画した内容が消去されないようにするには,TPaintBox の OnPaint イベント内に描画コードを記述します.
TPaintBox に WM_PAINT メッセージを送信すると再描画が行われます.TPaintBox の OnPaint イベント内で描画を実行すれば,そのイベントのコードが実行されますから,他のコントロールの Canvas に描画することができます.



図23
設計時の画面
  • Button1 の下は TPaintBox.その下は TImage
図24
EXE の実行直後
図25
Button1 クリック
  • TPaintBox の描画を TBitmap として取得
  • その TBitmap を TImage に描画

リスト10
TPaintBox の描画をビットマップ画像として取得
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  TPaintBox への描画をビットマップ画像として取得
//  WM_PAINT メッセージを使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);

  LBitmap := TBitmap.Create;
  try
    LBitmap.Canvas.Lock;
    LBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
    PaintBox1.Perform(WM_PAINT, LBitmap.Canvas.Handle, 0);

    Image1.Canvas.Draw(0, 0, LBitmap);
  finally
    LBitmap.Canvas.Unlock;
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  PaintBox1 の OnPaint イベント処理
//=============================================================================
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  LSrcBmp : TBitmap;
begin
  LSrcBmp := TBitmap.Create;
  try
    // ディスクから画像を読み込む
    LSrcBmp.Transparent := True;
    LSrcBmp.LoadFromFile('bmp-32A.bmp');

    // 画像を IPaintBox に描画
    PaintBox1.Canvas.Draw(50, 30, LSrcBmp);

    // 直線を TPaintBox に描画
    PaintBox1.Canvas.Pen.Color := clBlack;
    PaintBox1.Canvas.Pen.Width := 5;
    PaintBox1.Canvas.MoveTo(0, 0);
    PaintBox1.Canvas.LineTo(PaintBox1.Width, PaintBox1.Height);
  finally
    FreeAndNil(LSrcBmp);
  end;
end;

end.


次のように,実際の描画コードを手続きや関数にしておく方法もあります.この描画コードを別のコントロールの Canvas に対して実行すれば,TPaintBox への描画と同じになります.TButmap.Canvas に描画すれば,事実上,TPaintBox の描画をビットマップ画像にしたのと同じ結果になります.
もちろん,この方法でも,WM_PAINT メッセージを使用して他の Canvasに描画できます.



リスト11
TPaintBox の描画をビットマップ画像として取得.描画を別ルーチンにする例
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure DoDrawToPaintBox(ACanvas: TCanvas);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  TPaintBox への描画をビットマップ画像として取得
//  TPaintBox.Canvas への描画コードを TBitmap.Canvas に対して実行する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);

  LBitmap := TBitmap.Create;
  try
    LBitmap.Canvas.Lock;
    LBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
    DoDrawToPaintBox(LBitmap.Canvas);

    Image1.Canvas.Draw(0, 0, LBitmap);
  finally
    LBitmap.Canvas.Unlock;
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  PaintBox1 の OnPaint イベント処理
//  実際の描画は手続きか関数として実装しておく
//=============================================================================
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  DoDrawToPaintBox(PaintBox1.Canvas);
end;

//----------------------------------------------------------------------------
//  実際の描画処理のコード
//----------------------------------------------------------------------------
procedure TForm1.DoDrawToPaintBox(ACanvas: TCanvas);
var
  LSrcBmp : TBitmap;
begin
  LSrcBmp := TBitmap.Create;
  try
    // ディスクから画像を読み込む
    LSrcBmp.Transparent := True;
    LSrcBmp.LoadFromFile('bmp-32A.bmp');

    // 画像を ACanvas に描画
    ACanvas.Draw(50, 30, LSrcBmp);

    // 直線を ACanvas に描画
    ACanvas.Pen.Color := clBlack;
    ACanvas.Pen.Width := 5;
    ACanvas.MoveTo(0, 0);
    ACanvas.LineTo(PaintBox1.Width, PaintBox1.Height);
  finally
    FreeAndNil(LSrcBmp);
  end;
end;

end.