利用Delphi的Tbitmap控制項抓取螢幕圖像
http://grace7450.xiloo.com/Document/Source/016.htm    整理編輯：China ASP      相信絕大部分電腦愛好者都使用過不同種類的抓圖軟體抓取螢幕圖形。
在本文中，作者要向大家介紹的是利用Delphi的TBitmap控制項進行螢幕上任意
視窗圖形的抓取。同時文章中還有如何利用Delphi的擴展消息處理功能為Delphi
的視窗添加熱鍵和在任務欄上添加圖示的技巧。      程式的主要思路是：當按下為視窗建立的熱鍵後，首先獲得游標所在的視窗
的矩形區域，然後建立一個TBitmap物件，將矩形區域複製到TBitmap物件中；最
後利用TBitmap的圖像保存Method將複製到TBitmap中的點陣圖保存到磁片中。    程式1是完整的源代碼清單：    在運行程式前，首先要執行以下的步驟：    在Form1中加入一個TsavePictureDialog控制項，將其Name設置為SavePic。    改變Form1的如下屬性:
BorderStyle 改變為 bsNone；
FormStyle 改變為 fsStayOnTop；
Visable 改變為 False。       同時在Project1中的Application.Run語句前加入： Application.ShowMainForm := False；為了直觀顯示，還可以將Form1的Cursor屬性設置為crHandPoint。    unit Unit1;      interface    uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
 StdCtrls, ExtCtrls, Menus, ExtDlgs, ClipBrd, ShellApi;    const
 WM_ICWM_USER 100;    type
 TForm1 = class(TForm)
 SavePic: TSavePictureDialog;
 procedure FormCreate(Sender: TObject);
 procedure FormClose(Sender: TObject; var Action: TCloseAction);
 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
 Private
  //熱鍵消息處理函數
  procedure WMHOTKEY(var Message:TMessage);message WM_HOTKEY;
  //任務欄消息處理函數
  procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE;
 public
  procedure CaptureControl; 
end;    var
 Form1: TForm1;
 tmpBitmap:TBitmap;
 iBitmapValide:Boolean;    implementation    {$R *.DFM}    procedure TForm1.CaptureControl;
var
 iTempWnd, iMeHwnd, iDC:LongWord;
 tyRect :TRect;
 tpRect : TPoint;
 iWidth, iHeight:integer;
begin
 //獲得游標位置
 GetCursorPos(tpRect);
 //獲得游標所在位置的窗口控制碼
 iMeHwnd:=WindowFromPoint(tpRect);
 //獲得視窗的矩形區域
 etWindowRect(iMeHwnd, tyRect);
 //獲得桌面窗口的控制碼
 iTempWnd:=GetDesktopWindow;
 iDC:=GetDC(iTempWnd);
 iWidth:=tyRect.Right-tyRect.Left;
 iHeight:=tyRect.Bottom-tyRect.Top;
 //建立點陣圖
 tmpBitmap:=TBitmap.Create;
 iBitmapValide:=True;
 tmpBitmap.Width := iWidth;
 tmpBitmap.Height := iHeight;
 //複製視窗矩形區域到點陣圖中
 Bitblt(tmpBitmap.Canvas.Handle, 0, 0, iWidth, iHeight, iDC, tyRect.Left, tyRect.Top, SRCCOPY);
 ReleaseDC(iTempWnd, iDC);
 Form1.Visible := True;
 //使Form1覆蓋游標所在的窗口矩形
 Form1.Left := tyRect.Left;
 Form1.Top := tyRect.Top;
 Form1.Width := iWidth;
 Form1.Height := iHeight;
 tyRect.Left:=0;
 tyRect.Right := iWidth;
 tyRect.Top:=0;
 tyRect.Bottom:=iHeight;
 //將點陣圖繪製到Form1的Canvas中
 Form1.Canvas.Draw(0, 0, tmpBitmap);
 //圍繞Form1畫出3個相素的紅色邊框
 Frame3D(Form1.Canvas, tyRect, clRed, clRed, 3);
end;     //回應熱鍵，進行抓圖
procedure TForm1.WMHOTKEY(var Message:TMessage);
begin
 if iBitmapValide then
 begin
  tmpBitmap.FreeImage;
  tmpBitmap.Free;
  iBitmapValide:=False;
 end;
 CaptureControl;
end;    procedure TForm1.WMBarIcon (var Message:TMessage);
begin
 if ((Message.LParam = WM_RBUTTONDOWN)or (Message.LParam = WM_LBUTTONDOWN))  then
 //在任務欄圖示上按下滑鼠鍵退出
  close;
end;    procedure TForm1.FormCreate(Sender: TObject);
var
 lpData:PNotifyIconData;
begin
 //註冊熱鍵為Ctrl Shift A
 RegisterHotKey(Form1.handle, 0, MOD_SHIFT OR MOD_CONTROL, 65);
 //在任務欄上建立圖示
 lpData := new(PNotifyIconDataA);
 lpData.cbSize := 88;
 lpData.Wnd := Form1.Handle;
 lpData.hIcon := Form1.Icon.Handle;
 lpData.uCallbackMessage := WM_ICONMESSAGE;
 lpData.uID :=0;
 lpData.szTip := '螢幕捕捉';
 lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
 Shell_NotifyIcon(NIM_ADD, lpData);
 dispose(lpData);
end;    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
 lpData:PNotifyIconData;
begin
 //退出時刪除任務欄圖示
 lpData := new(PNotifyIconDataA);
 lpData.cbSize := 88;
 lpData.Wnd := Form1.Handle;
 lpData.hIcon := Form1.Icon.Handle;
 lpData.uCallbackMessage := WM_ICONMESSAGE;
 lpData.uID :=0;
 lpData.szTip := '螢幕捕捉';
 lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
 Shell_NotifyIcon(NIM_DELETE, lpData);
 dispose(lpData);
 //退出時登出窗口熱鍵
 UnRegisterHotKey(Form1.Handle, 0);
 if iBitmapValide then
 begin
  tmpBitmap.FreeImage;
  tmpBitmap.Free;
  iBitmapValide:=False;
 end;
end;     procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
 //按下滑鼠左鍵保存視窗圖像
 if (Button=mbLeft)then
  with SavePic do
  begin
   DefaultExt := 'Bmp';
   Execute;
   if FileName<>'' then
    tmpBitmap.SaveToFile(FileName);
  end;
 //保存完圖像後刪除點陣圖
 tmpBitmap.FreeImage;
 tmpBitmap.Free;
 iBitmapValide:=False;
 Form1.Visible := False;
end;    end.       按F9鍵運行程式，將游標移動到任意視窗上按下熱鍵Ctrl Shift A，
則游標所在視窗被捕捉下來（同時被捕捉區域被紅色邊框框住作為標識）。
在框內按下滑鼠左鍵就可以保存點陣圖圖像。這個程式也可以用來捕捉功能表。      同時程式也可以將圖像發送到剪貼板中，只要將上面程式中Form1的
OnMouseUp事件置換為下面的程式段就可以了（程式2）：    procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 MyFormat : Word;
 AData : THandle;
 APalette : HPALETTE;
begin
 if (Button=mbLeft)then
 //按下滑鼠左鍵將tmpBitmap中的內容發送的剪貼板
 begin
  tmpBitmap.SaveToClipBoardFormat(MyFormat, AData, APalette);
  ClipBoard.SetAsHandle(MyFormat, AData);
 end;
 tmpBitmap.FreeImage;
 tmpBitmap.Free;
 iBitmapValide:=False;
 Form1.Visible := False;
end;    以上的程式在Windows95，Delphi4.0下運行通過