Delphi - 在桌面画布上绘制并制作屏幕截图

时间:2016-01-26 00:54:39

标签: delphi canvas drawing

嗨,我有这部分代码:

var
dc: HDC;
oCanvas: TCanvas;
r: TRect;

r - 左,右,上,下 - 来自参数..

DC := GetWindowDC(0);
oCanvas:=TCanvas.Create;  
ocanvas.Handle:=dc;

ocanvas.Pen.Color:=clblue;
ocanvas.brush.Color:=clblue;
ocanvas.Pen.Width:=9;
ocanvas.ellipse(r);
一些绘画代码...... ....

oCanvas.free;
releaseDC (handle,dc);

我的目标是:在桌面上画一些内容,然后用程序对其进行一次扫描(截图10,10,p.witdth,p.height,bmp){p是Trectangle}并保存到文件..它的工作原理90%的情况都很好,但有时候我的椭圆会在捕获屏幕之前消失,并保存到位图......

我使用的截图程序:

procedure Tform1.ScreenShot(X, Y, W, H: integer;
  var AShot: TBitMap);
var
   dc: HDC;
   lpPal : PLOGPALETTE;

  function TestRegion:boolean;
  begin
    Result:= (W<>0);
    if Result then
      Result:= (H<>0);
    if Result then
      Result:= (X>-1);
    if Result then
      Result:= (Y>-1);

    AShot:= TBitmap.Create;
    //AShot.PixelFormat:= pf24Bit;
    AShot.Width:= W;
    AShot.Height:= H;
  end;
begin
{test width and height}
  if not TestRegion then
    raise Exception.Create('Invalid region to capture. Check input values.');

  {get the screen dc}
  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}
         AShot.Palette := CreatePalette(lpPal^);
     end;
     FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
  end;
  {copy from the screen to the bitmap}
  BitBlt(AShot.Canvas.Handle, 0, 0, W ,H, Dc, x, y, SRCCOPY);
  {release the screen dc}
  ReleaseDc(0, dc);
end;

0 个答案:

没有答案