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.

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;

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;

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;

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;

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;

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.

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.

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.

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.

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.