スクリーンのキャプチャ

参照元１ 参照元２


redball.gif目次へ戻る

クリップボードを経由しないで、独自のコードでディスプレイ画像をキャプチャする方法は割合と簡単である。Windows では、ディスプレイ上の画像は、DesktopWindow の上に描かれているので、GetDesktopWindow() でデスクトップウィンドウのハンドルを取得し、それを使って GetDC() によりデバイストンテキストが得られる。あとはそれを使って、Bitmap の DC にコピーするとよい。ここでは、ディスプレイのデバイスドライバからディスプレイのデバイスコンテキストを取得する方法を試してみよう。

function CreateDC(lpszDriver, 
                  lpszDevice, 
                  lpszOutput: PChar;
                   lpdvmInit: PDeviceMode): HDC; stdcall;

これは、特定の名前のデバイスコンテキストを取得するのに使う。現在のディスプレイのデバイスコンテキストを取得するときは、lpszDriver　に 'DISPLAY' を PChar で設定する。リテラルならそのまま設定する。（文字列リテラルは PChar と互換性がある）その他のパラメータには nil を設定する。この API の返値としてディスプレイのデバイスコンテキストが得られる。使用後は、

function DeleteDC(DC: HDC): BOOL; stdcall;

で削除する。

ディスプレイのデバイスコンテキストが得られたら、その任意の部分を BitBlt で他のデバイスコンテキストにコピーする事ができる。

function BitBlt(DestDC: HDC; 
 　X, Y, Width, Height: Integer; 
 　              SrcDC: HDC;
            XSrc, YSrc: Integer; 
                   Rop: DWORD): BOOL; stdcall;

この API は、GDI 関数のなかでもっとも有名なものであり、SrcDC の XSrc, YSrc で左上を指定される矩形部分の内容を DestDC の X, Y, Width, Height で指定される矩形部分に Rop で指定されたやりかたでコピーするものである。Rop には以下のような定数を指定できる。

const
  SRCCOPY     = $00CC0020;     { dest = source                    }
  SRCPAINT    = $00EE0086;     { dest = source OR dest            }
  SRCAND      = $008800C6;     { dest = source AND dest           }
  SRCINVERT   = $00660046;     { dest = source XOR dest           }
  SRCERASE    = $00440328;     { dest = source AND (NOT dest )    }
  NOTSRCCOPY  = $00330008;     { dest = (NOT source)              }
  NOTSRCERASE = $001100A6;     { dest = (NOT src) AND (NOT dest)  }
  MERGECOPY   = $00C000CA;     { dest = (source AND pattern)      }
  MERGEPAINT  = $00BB0226;     { dest = (NOT source) OR dest      }
  PATCOPY     = $00F00021;     { dest = pattern                   }
  PATPAINT    = $00FB0A09;     { dest = DPSnoo                    }
  PATINVERT   = $005A0049;     { dest = pattern XOR dest          }
  DSTINVERT   = $00550009;     { dest = (NOT dest)                }
  BLACKNESS   = $00000042;     { dest = BLACK                     }
  WHITENESS   = $00FF0062;     { dest = WHITE                     }

このように source と destination の間のピクセルごとのビット演算の方法を指定するのである。普通にコピーするだけなら、SRCCOPY を設定する。いろいろ試してみるとおもしろいだろう。特に、 XOR である SRCINVERT は、二回するとコピー前に戻るのでいろいろな応用ができるだろう。

以上の３つの API を使えば、キャプチャのプログラミングはおしまいである。あとは応用問題だけだ。それでは、具体的にやってみよう。最初は、スクリーン全体を TImage の中のビットマップにコピーすることから始めよう。TScrollBox とその中に TImage を一つ置いて、TButton をその外に置いて、OnClick イベントでキャプチャしてみよう。

List 1

unit Main;

interface

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

type
  TForm1 = class(TForm)


    ScrollBox1: TScrollBox;
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure CaptureRect(r:TRect;BM:TBitmap);
var
  DispDC: HDC;
  width, height: integer;
begin
  width := r.Right-r.Left;
  height := r.Bottom-r.Top;
  DispDC := CreateDC('DISPLAY',nil,nil,nil);
  BM.Width := width;
  BM.Height := height;
  BitBlt(BM.Canvas.Handle,0,0,width,height,DispDC,
                                r.Left,r.Top,SRCCOPY);
  DeleteDC(DispDC);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  r:TRect;
begin
  r := Rect(0,0,Screen.Width,Screen.Height);
  CaptureRect(r,Image1.Picture.Bitmap);
  Image1.Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Left := 0;
  Image1.Top := 0;
  Image1.AutoSize := true;
end;

end.
n00901.gif

実行して Button1 を押すと右図のようになる。ScrollBox1 の中の Image1 にスクリーン全体の画像が表示される。右図では、スクロールしていないので、スクリーン左上部分が見えている。見えている部分の右下部分は自分自身が写っていて、まだ画像がない時の様子が見えている。
n00902.gif

もう一度 Button1 を押すと右図のようになる。自分自身のなかにも、直前の画像が入ったことが分かるだろう。

コードを見てみよう。

procedure CaptureRect(r:TRect;BM:TBitmap);
var
  DispDC: HDC;
  width, height: integer;
begin
  width := r.Right-r.Left;
  height := r.Bottom-r.Top;
  DispDC := CreateDC('DISPLAY',nil,nil,nil);
  BM.Width := width;
  BM.Height := height;
  BitBlt(BM.Canvas.Handle,0,0,width,height,DispDC,
                                r.Left,r.Top,SRCCOPY);
  DeleteDC(DispDC);
end;

この手続きがキャプチャ操作の本体である。第一パラメータは、TRect 型の変数でキャプチャする矩形部分をスクリーン座標で指定する。今回は、スクリーン全体をキャプチャするために、Screen オブジェクトの Width と Height を使った。第二パラメータは、コピー先となる TBitmap オブジェクトを指定する。今回は、Image1.Picture.Bitmap を設定した。

上のプログラムの改善点は、自分自身がキャプチャ画像に写ってしまうことである。プログラムのウィンドウを最小化した状態で同様の動作を実現してみよう。

List 2

unit Main;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure CaptureRect(r:TRect;BM:TBitmap);
var
  DispDC: HDC;
  width, height: integer;
begin
  width := r.Right-r.Left;
  height := r.Bottom-r.Top;
  DispDC := CreateDC('DISPLAY',nil,nil,nil);
  BM.Width := width;
  BM.Height := height;
  BitBlt(BM.Canvas.Handle,0,0,width,height,DispDC,
                                r.Left,r.Top,SRCCOPY);
  DeleteDC(DispDC);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetAsyncKeyState(VK_F11);// 履歴のクリア　
  Timer1.Enabled := true;
  Application.Minimize;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Left := 0;
  Image1.Top := 0;
  Image1.AutoSize := true;

  Timer1.Enabled := false;
  Timer1.Interval := 50;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  r:TRect;
begin
  if (GetAsyncKeyState(VK_F11) and $0001) <> 0 then begin
    Timer1.Enabled := false;
    r := Rect(0,0,Screen.Width,Screen.Height);
    CaptureRect(r,Image1.Picture.Bitmap);
    Image1.Refresh;

    Application.Restore;
  end;
end;

end.
n00903.gif

実行して、Button1 を押すと最小化する。その状態で、F11 キーを押すと、右図のように復帰して Image1 にキャプチャ画像が取り込まれる。

上記のプログラムでは、Button1 を押すと F11 キーの押し下げ履歴をクリアしてからタイマを有効にし、最小化する。この状態で F11 キーを押すと、OnTimer イベントハンドラで前のプログラムと同じようにしてキャプチャしたあとウィンドウを復帰している。

つぎに、スクリーン全体ではなく、特定のウィンドウやコントロールをキャプチャすることを考えよう。いずれにしても、キャプチャする瞬間にスクリーンに描かれていることが最低の前提条件である。

以下のプログラムでは、フォアグランドウィンドウ、カーソルの下のウィンドウ、カーソルの下のコントロールをキャプチャすることを試してみよう。

List 3

unit Main;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Panel1: TPanel;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
  public
    hTarget:HWND;
    function CalcRect:TRect;
    procedure CaptureRect(r:TRect;BM:TBitmap);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  Jpeg;

procedure TForm1.CaptureRect(r:TRect;BM:TBitmap);
var
  DispDC: HDC;
  width, height: integer;
begin
  width := r.Right-r.Left;
  height := r.Bottom-r.Top;
  DispDC := CreateDC('DISPLAY',nil,nil,nil);
  BM.Width := width;
  BM.Height := height;
  BitBlt(BM.Canvas.Handle,0,0,width,height,DispDC,
                                r.Left,r.Top,SRCCOPY);

  DeleteDC(DispDC);
end;

function GetTopLevelWindow(hWindow:HWND):HWND;
var
  hAncestor,hPrev:HWND;
begin
  hPrev := hWindow;
  hAncestor := GetParent(hPrev);
  while hAncestor <> 0  do begin
    hPrev := hAncestor;
    hAncestor := GetParent(hPrev)
  end;
  result := hPrev;
end;

function TForm1.CalcRect: TRect;
begin
  case RadioGroup1.ItemIndex of
    0:result := Rect(0,0,Screen.Width,Screen.Height);
    1:begin
      hTarget := GetForegroundWindow;
      GetWindowRect(hTarget,result);
    end;
    2:begin
      hTarget := WindowFromPoint(Mouse.CursorPos);

      hTarget := GetTopLevelWindow(hTarget);
      GetWindowRect(hTarget,result);
    end;
    3:begin
      hTarget := WindowFromPoint(Mouse.CursorPos);
      GetWindowRect(hTarget,result);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetAsyncKeyState(VK_F11);// 履歴のクリア　
  Timer1.Enabled := true;
  Application.Minimize;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Left := 0;
  Image1.Top := 0;
  Image1.AutoSize := true;

  Timer1.Enabled := false;
  Timer1.Interval := 50;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  r:TRect;
begin
  if (GetAsyncKeyState(VK_F11) and $0001) <> 0 then begin
    Timer1.Enabled := false;
    r := CalcRect;
    Image1.Picture.Bitmap.PixelFormat := pf24bit;
    CaptureRect(r,Image1.Picture.Bitmap);
    Image1.Refresh;

    Application.Restore;
  end;
end;

end.
n00904.gif

実行して、RadioGroup1 から ForegroundWnd を選択してキャプチャすると、キャプチャ時点でアクティブなウィンドウ全体をキャプチャする。右図では、Paint を小さくしたものをキャプチャした。

n00905.gif

WndUnderCorsor を選ぶと、アクティブじゃなくてもカーソルのしたのウィンドウをキャプチャできる。右図は、やはり Paint のウィンドウであるが、タイトルバーの色がアクティブではないことを示している。このように、任意のウィンドウにカーソルを持っていって、キャプチャすることができる。

n00906.gif

これは同様にして、Delphi5 のメインウィンドウをキャプチャしたものだ。

n00907.gif

こんどは、CtrlUnderCursor を選んで、Paint のパレット部分のコントロールをキャプチャしたのが右図である。

n00908.gif

これは、Paint のツールボックス部分である。

n00909.gif

これは、Delphi5 IDE のコンポーネントパレットのタブのところにカーソルを持っていったときのものだ。

コードを見てみよう。RadioGroup1 の選択によって、キャプチャするスクリーン上の矩形部分の計算を場合分けしている。

function TForm1.CalcRect: TRect;
begin
  case RadioGroup1.ItemIndex of
    0:result := Rect(0,0,Screen.Width,Screen.Height);
    1:begin
      hTarget := GetForegroundWindow;
      GetWindowRect(hTarget,result);
    end;
    2:begin
      hTarget := WindowFromPoint(Mouse.CursorPos);
      hTarget := GetTopLevelWindow(hTarget);
      GetWindowRect(hTarget,result);
    end;
    3:begin
      hTarget := WindowFromPoint(Mouse.CursorPos);
      GetWindowRect(hTarget,result);
    end;
  end;
end;

カーソルの現在位置を Mouse.CursorPos で取得し、それを使って

function WindowFromPoint(Point: TPoint): HWND; stdcall;

により、カーソル位置の下のウィンドウハンドルを取得する。そして、

function GetWindowRect(hWnd: HWND; 
                 var lpRect: TRect): BOOL; stdcall;

をつかって、そのウィンドウのスクリーン上の矩形領域を取得している。

最後に、仕上げとして、カーソル描画の有無とキャプチャ画像をファイルにセーブするコードを書いておこう。

List 4

unit Main;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Panel1: TPanel;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Timer1: TTimer;
    RadioGroup2: TRadioGroup;
    Button2: TButton;
    RadioGroup3: TRadioGroup;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    hTarget:HWND;
    function CalcRect:TRect;
    procedure CaptureRect(r:TRect;BM:TBitmap);
    procedure CalcCursorPoint(var CI: TCursorInfo);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  Jpeg;

procedure TForm1.CaptureRect(r:TRect;BM:TBitmap);
var
  DispDC: HDC;
  width, height: integer;
  CI: TCursorInfo;
begin
  width := r.Right-r.Left;
  height := r.Bottom-r.Top;
  DispDC := CreateDC('DISPLAY',nil,nil,nil);
  BM.Width := width;
  BM.Height := height;
  BitBlt(BM.Canvas.Handle,0,0,width,height,DispDC,
                                r.Left,r.Top,SRCCOPY);

  if RadioGroup2.ItemIndex = 0 then begin
    CI.cbSize := SizeOf(TCursorInfo);
    CI.flags := CURSOR_SHOWING;
    GetCursorInfo(CI);
    CalcCursorPoint(CI);
    DrawIconEx(BM.Canvas.Handle,CI.ptScreenPos.x,CI.ptScreenPos.y,
       CI.hCursor,0,0,0,0,DI_DEFAULTSIZE or DI_NORMAL);
  end;

  DeleteDC(DispDC);
end;

function GetTopLevelWindow(hWindow:HWND):HWND;
var
  hAncestor,hPrev:HWND;
begin
  hPrev := hWindow;
  hAncestor := GetParent(hPrev);
  while hAncestor <> 0  do begin
    hPrev := hAncestor;
    hAncestor := GetParent(hPrev)
  end;
  result := hPrev;
end;

function TForm1.CalcRect: TRect;
begin
  case RadioGroup1.ItemIndex of
    0:result := Rect(0,0,Screen.Width,Screen.Height);
    1:begin
      hTarget := GetForegroundWindow;
      GetWindowRect(hTarget,result);
    end;
    2:begin
      hTarget := WindowFromPoint(Mouse.CursorPos);
      hTarget := GetTopLevelWindow(hTarget);
      GetWindowRect(hTarget,result);
    end;
    3:begin
      hTarget := WindowFromPoint(Mouse.CursorPos);
      GetWindowRect(hTarget,result);
    end;
  end;
end;

procedure TForm1.CalcCursorPoint(var CI: TCursorInfo);
var
  II:TIconInfo;
  r:TRect;
begin
  II.fIcon := false;
  GetIconInfo(CI.hCursor,II);
  DeleteObject(II.hbmColor);
  DeleteObject(II.hbmMask);
  CI.ptScreenPos := Point(CI.ptScreenPos.x-integer(II.xHotspot),
                                   CI.ptScreenPos.y-integer(II.yHotspot));
  case RadioGroup1.ItemIndex of
    0:exit;
    1,2,3:begin
      GetWindowRect(hTarget,r);
      CI.ptScreenPos := Point(CI.ptScreenPos.x-r.Left,CI.ptScreenPos.y-r.Top);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetAsyncKeyState(VK_F11);// 履歴のクリア　
  Timer1.Enabled := true;
  Application.Minimize;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Left := 0;
  Image1.Top := 0;
  Image1.AutoSize := true;

  Timer1.Enabled := false;
  Timer1.Interval := 50;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  r:TRect;
begin
  if (GetAsyncKeyState(VK_F11) and $0001) <> 0 then begin
    Timer1.Enabled := false;
    r := CalcRect;
    Image1.Picture.Bitmap.PixelFormat := pf24bit;
    CaptureRect(r,Image1.Picture.Bitmap);
    Image1.Refresh;

    Application.Restore;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  JPEG:TJpegImage;
begin

  case RadioGroup3.ItemIndex of
    0:begin
      SaveDialog1.FileName := 'Caputured.bmp';
      SaveDialog1.DefaultExt := 'bmp';
      if SaveDialog1.Execute then
        Image1.Picture.Bitmap.SaveToFile(SaveDialog1.FileName);
    end;
    1:begin
      SaveDialog1.FileName := 'Caputured.jpg';
      SaveDialog1.DefaultExt := 'jpg';
      JPEG := TJpegImage.Create;
      try
        JPEG.Assign(Image1.Picture.Bitmap);
        if SaveDialog1.Execute then
          JPEG.SaveToFile(SaveDialog1.FileName);
      finally
        JPEG.Free;
      end;
    end;
  end;
end;

end.
n00910.gif

右図のような設定では、カーソルも描かれる。Save ボタンを押すと bmp か jpg で画像をファイルにセーブできる。

  if RadioGroup2.ItemIndex = 0 then begin
    CI.cbSize := SizeOf(TCursorInfo);
    CI.flags := CURSOR_SHOWING;
    GetCursorInfo(CI);
    CalcCursorPoint(CI);
    DrawIconEx(BM.Canvas.Handle,CI.ptScreenPos.x,CI.ptScreenPos.y,
       CI.hCursor,0,0,0,0,DI_DEFAULTSIZE or DI_NORMAL);
  end;

現在のカーソルのハンドルとその位置を取得するには、GetCursorInfo() を使う。

function GetCursorInfo(var pci: TCursorInfo): BOOL; stdcall;

この引数は、以下のようなレコード型である。

type
  { Information about the global cursor. }
  PCursorInfo = ^TCursorInfo;
  tagCURSORINFO = packed record
    cbSize: DWORD;               // このレコード型のサイズ
    flags: DWORD;                // フラグ、以下を参照のこと
    hCursor: HCURSOR;
    ptScreenPos: TPoint;
  end;
  TCursorInfo = tagCURSORINFO;

flags には、

                 0               // The cursor is hidden. 設定時
CURSOR_SHOWING = $00000001;      // 現在のカーソル

を設定できるが、ここでは CURSOR_SHOWING を設定する。hCursor にハンドルが、ptScreenPos にスクリーン座標が設定されて戻ってくる。これをそのまま使うと、OS によっては、少し実際の位置とずれるようである。ハンドルの値（カーソルの種類）によってもずれの大きさが違うようだ。いろいろ調べた結果、これは図形としてのカーソルの矩形領域の左上の座標に相当しており、したがって、カーソル毎にホットスポットの座標で補正してやらなければならないことが分かった。カーソルハンドルからホットスポットの座標を取得するには、

function GetIconInfo(hIcon: HICON; 
             var piconinfo: TIconInfo): BOOL; stdcall;

を使う。この第二パラメータは、

type
  PIconInfo = ^TIconInfo;
  _ICONINFO = packed record
    fIcon: BOOL;
    xHotspot: DWORD;
    yHotspot: DWORD;
    hbmMask: HBITMAP;
    hbmColor: HBITMAP;
  end;
  TIconInfo = _ICONINFO;
  ICONINFO = _ICONINFO;

のレコード型であり、カーソルハンドルを与えると ホットスポットの座標が得られる。これを使って上のコードでは、各場合についてスクリーン座標からビットマップの DC への座標に変換している。

procedure TForm1.CalcCursorPoint(var CI: TCursorInfo);
var
  II:TIconInfo;
  r:TRect;
begin
  II.fIcon := false;  
  GetIconInfo(CI.hCursor,II);
  DeleteObject(II.hbmColor);
  DeleteObject(II.hbmMask);
  CI.ptScreenPos := Point(CI.ptScreenPos.x-integer(II.xHotspot),
                                   CI.ptScreenPos.y-integer(II.yHotspot));
  case RadioGroup1.ItemIndex of
    0:exit;
    1,2,3:begin
      GetWindowRect(hTarget,r);
      CI.ptScreenPos := Point(CI.ptScreenPos.x-r.Left,CI.ptScreenPos.y-r.Top);
    end;
  end;
end;

このようにして、実際に描くカーソル座標を計算できた。

さて、現在のカーソルのハンドルと位置を取得できたので、ターゲットＤＣに DrawIconEx() を使って上書きするとできあがりである。

以上のように、キャプチャ画像をコードで取得するのは簡単であることが分かった。

redball.gif目次へ戻る