一个抓屏的小函数

最新推荐文章于 2024-04-20 15:58:38 发布

jinzhili

最新推荐文章于 2024-04-20 15:58:38 发布

阅读量869

点赞数

分类专栏： Delphi 文章标签： integer image system c

本文链接：https://blog.csdn.net/jinzhili/article/details/1426841

版权

Delphi 专栏收录该内容

55 篇文章 0 订阅

订阅专栏

procedure ScreenShot(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;
ScreenShot(0,0,Screen.Width,Screen.height,tBM);
tBM.SaveToFile('c:/ScreenShot.BMP');
tBm.FreeImage;
FreeAndNil(tBM);
image1.Picture.LoadFromFile('c:/screenshot.bmp');
end;