Screenshot machen (zum 125.000sten Mal *gg*)

[Codehunter]

So, das sollte sie nun sein, die Screenshotfunktion die unter allen erdenklichen Multimonitor-Geometrien funktioniert. Man sollte aber bedenken, dass CreateDC('DISPLAY' laut MSDN erst ab Windows 2000 funktioniert.

Delphi-Quellcode:

procedure CaptureScreen(ABitmap: Graphics.TBitmap);
const
   CAPTUREBLT = $40000000;
var
   hdcScreen: HDC;
   hdcCompatible: HDC;
   hbmScreen: HBITMAP;
   DeskHeight, DeskWidth, LeftOffset, TopOffset: Integer;
begin
  hdcScreen:= CreateDC('DISPLAY', NIL, NIL, NIL);
  hdcCompatible:= CreateCompatibleDC(hdcScreen);
  DeskHeight:= Screen.DesktopHeight;
  DeskWidth:= Screen.DesktopWidth;
  LeftOffset:= Screen.DesktopLeft;
  TopOffset:= Screen.DesktopTop;

  hbmScreen:= CreateCompatibleBitmap(hdcScreen,
                                     DeskWidth,
                                     DeskHeight);

  SelectObject(hdcCompatible, hbmScreen);
  ABitmap.Handle:= hbmScreen;
  BitBlt(hdcCompatible, 0, 0, ABitmap.Width, ABitmap.Height, hdcScreen,
         LeftOffset, TopOffset, SRCCOPY or CAPTUREBLT);

  DeleteDC(hdcScreen);
  DeleteDC(hdcCompatible);
end;

procedure GrabScreenshotFromWindow(AHandle: HWND;
  ATargetBitmap: Graphics.TBitmap);
var
  R: TRect;
  DeskBMP: Graphics.TBitmap;
  WinHeight, WinWidth, LeftOffset, TopOffset: Integer;
begin
  DeskBMP:= Graphics.TBitmap.Create;
  R:= Screen.DesktopRect;
  LeftOffset:= Abs(R.Left);
  TopOffset:= Abs(R.Top);
  try
    CaptureScreen(DeskBMP);
    GetWindowRect(AHandle, R);
    Inc(R.Left, LeftOffset);
    Inc(R.Top, TopOffset);
    Inc(R.Right, LeftOffset);
    Inc(R.Bottom, TopOffset);
    WinHeight:= R.Bottom - R.Top;
    WinWidth:= R.Right - R.Left;
    ATargetBitmap.Width:= WinWidth;
    ATargetBitmap.Height:= WinHeight;
    ATargetBitmap.Canvas.CopyRect(Rect(0, 0, WinWidth, WinHeight), DeskBMP.Canvas, R);
  finally
    DeskBMP.Free;
  end;
end;