Delphi如何进行屏幕截取

Question

如何用Delphi实现Microsoft HTML Help Image Editor的图片抓取功能？

Answer 1

procedure CatchScreen()
var
  dcDesktop: HDC;
  cvsScreen: TCanvas;
  btpScreen: TBitmap;
begin  cvsScreen := TCanvas.Create;
  dcDesktop := GetDC(GetDesktopWindow());
  cvsScreen.Handle := dcDesktop;
  btpScreen := TBitmap.Create;
  btpScreen.Width := 400;
  btpScreen.Height := 400;
  btpScreen.Canvas.CopyRect(Rect(0,0,400,400),cvsScreen,Rect(0,0,400,400));
  btpScreen.SaveToFile('c:\tmp.bmp');
  ReleaseDC(GetDesktopWindow(),dcDesktop);
  cvsScreen.Free;
  btpScreen.Free;

Answer 2

uses Graphics;procedure Tform1.GetScreen(var bmp: TBitmap); //截屏
var
  dc: integer;
  c: TCanvas;
  R: TRect;
begin
  bmp := TBitmap.Create;  dc := GetWindowDC(0);
  try
    c := TCanvas.Create;
    c.Handle := dc;
    R := Rect(0, 0, Screen.Width, Screen.Height);
    bmp.Width := R.Right;
    bmp.Height := R.Bottom;
    bmp.Canvas.CopyRect(R, c, R);
    c.Handle := 0;
    c.Free;
  finally
    ReleaseDC(0, dc);
  end;
end;
procedure Tform1.FullGetScreen(var bmp: TBitmap); //截屏
var
  FullscreenCanvas:TCanvas;
  dc:HDC;
begin
  bmp:=TBitmap.Create;//创建一个BITMAP来存放图象
  bmp.Width:=screen.width;
  bmp.Height:=screen.Height;
  DC:=GetDC(0);//取得屏幕的DC，参数0指的是屏幕
  FullscreenCanvas:=TCanvas.Create;//创建一个CANVAS对象
  FullscreenCanvas.Handle:=DC;
  bmp.Canvas.CopyRect(Rect(0,0,screen.Width,screen.Height),fullscreenCanvas,Rect(0,0,Screen.Width,Screen.Height));
  //把整个屏幕复制到BITMAP中
  FullscreenCanvas.Free;//释放CANVAS对象
  ReleaseDC(0,DC);//释放DC
end;

Answer 3

我给出一个可以画上鼠标的，截屏代码很少几行就可以了,大多用在画鼠标上{--------------------------------------------------
  传入参数：  Mybmp  :TBitmap   截屏后存入该对象
              DrawCur:Boolean   是否绘制鼠标
---------------------------------------------------}
procedure GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var
   Cursorx, Cursory: integer;
   dc: hdc;
   Mycan: Tcanvas;
   R: TRect;
   DrawPos: TPoint;
   MyCursor: TIcon;
   hld: hwnd;
   Threadld: DWORD;
   mp: TPoint;
   pIconInfo: TIconInfo;
begin
   Mybmp := TBitmap.Create; {建立BMPMAP }
   Mycan := TCanvas.Create; {屏幕截取}
   dc := GetWindowDC(0);
   Ty
      Mycan.Handle := dc;
      R := Rect(0, 0, screen.Width, screen.Height);
      Mybmp.Width := R.Right;
      Mybmp.Height := R.Bottom;
      Mybmp.Canvas.CopyRect(R, Mycan, R);
   Fnally
      releaseDC(0, DC);
   Ed;
   Mycan.Handle := 0;
   Mycan.Free;
   {---------截屏代码完------------}
   if DrawCur then {如果要画鼠标...}
   begin
      GetCursorPos(DrawPos);    //首先取鼠标位置
      MyCursor := TIcon.Create;
      GetCursorPos(mp);      hld := WindowFromPoint(mp);
      Threadld := GetWindowThreadProcessId(hld, nil);
      AttachThreadInput(GetCurrentThreadId, Threadld, True);      MyCursor.Handle := Getcursor();
      AttachThreadInput(GetCurrentThreadId, threadld, False);      GetIconInfo(Mycursor.Handle, pIconInfo);        {鼠标形状}
      cursorx := DrawPos.x - round(pIconInfo.xHotspot);
      cursory := DrawPos.y - round(pIconInfo.yHotspot);      Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {画鼠标到指定位置}      DeleteObject(pIconInfo.hbmColor);{GetIconInfo创建了两个Bitmap对象，这里释放他们}
      DeleteObject(pIconInfo.hbmMask
      Mycursor.ReleaseHandle; {释放数组}
      MyCursor.Free;          {释放鼠标指针}
   end;
end;

Answer 4

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
  dc:hdc;
  mycanvas:TCanVas;
  mybitmap:TBitmap;
begin
application.Minimize;
mycanvas:=TCanvas.Create;
mybitmap:=tbitmap.Create;
dc:=getdc(0);
try
myCanvas.Handle := DC;
with Screen do
begin
  MyBitmap.Width := Width;
  MyBitmap.Height := Height;
  MyBitmap.Canvas.CopyRect(Rect(0,0,Width,Height),myCanvas,Rect(0,0,Width,Height));
  image1.Picture.Bitmap.Assign(mybitmap);
end;
finally
 releasedc(0,dc);
 mycanvas.Free;
 mybitmap.Free;
end;
application.Restore;
end;end.