Delphi写的一个屏幕截取函数

 procedure CopyScreen(x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap); var dc: HDC; lpPal : PLOGPALETTE; begin // 检测所需抓屏的区域 if ((Width = 0) or (Height = 0)) then exit; bm.Width := Width; bm.Height := Height; //获取设备上下文 dc := GetDc(0); if (dc = 0) then exit; {do we have a palette device?} if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin {allocate memory for a logical palette} GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY))); {zero it out to be neat} FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0); {fill in the palette version} lpPal^.palVersion := $300; {grab the system palette entries} lpPal^.palNumEntries := GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry); if (lpPal^.PalNumEntries <> 0) then begin {create the palette} bm.Palette := CreatePalette(lpPal^); end; FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY))); end; {copy from the screen to the bitmap} BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY); {release the screen dc} ReleaseDc(0, dc); end; 调用示例： procedure TForm1.Button1Click(Sender: TObject); var tBM : TBitmap; begin tBM := TBitmap.Create; CopyScreen(0,0,Screen.Width,Screen.height,tBM); tBM.SaveToFile('c:/ScreenShot.BMP'); tBm.FreeImage; FreeAndNil(tBM); image1.Picture.LoadFromFile('c:/screenshot.bmp'); end;