[Lazarus] Copying form client area to clipboard and to file

Graeme Geldenhuys graemeg.lists at gmail.com
Sat May 29 23:54:25 CEST 2010


On 29 May 2010 23:20, Felipe Monteiro de Carvalho wrote:
> http://stackoverflow.com/questions/1774222/taking-screenshot-of-a-specific-window-c-qt
>
> You could see the Qt source code to check what this does for the
> Windows part of the solution.

Here is another way of doing it under Windows - as coded in tiOPF.
I've never used this myself, so don't really know the code at all,
just know it is there.

---------------------------------------------------------
procedure TtiBruteForceNoFlicker.ScreenShot(ABitmap: TBitmap; ALeft,
ATop, AWidth, AHeight: Integer; AWindow: HWND);
var
  WinDC: HDC;
  Pal: TMaxLogPalette;
begin
  ABitmap.Width := AWidth;
  ABitmap.Height := AHeight;

  // Get the HDC of the window...
  WinDC := GetDC(AWindow);
  try
    if WinDC = 0 then
      raise Exception.Create('No DeviceContext For Window');

    // Palette-device?
    if (GetDeviceCaps(WinDC, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then
    begin
      FillChar(Pal, SizeOf(TMaxLogPalette), #0);  // fill the
structure with zeros
      Pal.palVersion := $300;                     // fill in the palette version

      // grab the system palette entries...
      Pal.palNumEntries := GetSystemPaletteEntries(WinDC, 0, 256,
Pal.palPalEntry);
      if Pal.PalNumEntries <> 0 then
        {$IFDEF FPC}
        ABitmap.Palette := CreatePalette(LPLOGPALETTE(@Pal)^);
        {$else}
        ABitmap.Palette := CreatePalette(PLogPalette(@Pal)^);
        {$endif}
    end;

    // copy from the screen to our bitmap...
    BitBlt(ABitmap.Canvas.Handle, 0, 0, AWidth, AHeight, WinDC, ALeft,
ATop, SRCCOPY);
  finally
    ReleaseDC(AWindow, WinDC);        // finally, relase the DC of the window
  end;
end;

---------------------------------------------------------


I had some code for X11, but couldn't find it now - it might be on my
work PC. If I find it, I'll post it here.


-- 
Regards,
  - Graeme -


_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://opensoft.homeip.net/fpgui/




More information about the Lazarus mailing list