Search code examples
delphiscreenshotactive-window

Delphi Active Window Screenshot


I am trying to add capture screenshot of active window using this code

procedure ScreenShot(activeWindow: bool; destBitmap : TBitmap) ;
 var
    w,h : integer;
    DC : HDC;
    hWin : Cardinal;
    r : TRect;
 begin
    if activeWindow then
    begin
      hWin :=  GetForegroundWindow;
      dc := GetWindowDC(hWin) ;
      GetWindowRect(hWin,r) ;
      w := r.Right - r.Left;
      h := r.Bottom - r.Top;
    end
    else
    begin
      hWin := GetForegroundWindow;
      dc := GetDC(hWin) ;
      w := GetDeviceCaps (DC, HORZRES) ;
      h := GetDeviceCaps (DC, VERTRES) ;
    end;

    try
     destBitmap.Width := w;
     destBitmap.Height := h;
     BitBlt(destBitmap.Canvas.Handle,
            0,
            0,
            destBitmap.Width,
            destBitmap.Height,
            DC,
            0,
            0,
            SRCCOPY) ;
    finally
     ReleaseDC(hWin, DC) ;
    end;
 end;

And in Button1 i use :

var
  path:string;
  b:TBitmap;
begin
   path:= ExtractFilePath(Application.ExeName) + '/Screenshot/';
   b := TBitmap.Create;
   try
     ScreenShot(TRUE, b) ;
     b.SaveToFile(path + 'Screenshot_1.png');
   finally
     b.FreeImage;
     FreeAndNil(b) ;
   end;
end;

it works good only problem is it not capture title bar :(

Here is Full Active window view :

enter image description here

And Here is what i get from that code

enter image description here

Where am i doing wrong ??


Solution

  • I have tested and got the same result.

    enter image description here

    original with border

    enter image description here

    But if you set

    sSkinProvider1.AllowExtBorders:=False;
    

    you get a screenshot without the transparent roundet border.

    enter image description here

    then set back

    sSkinProvider1.AllowExtBorders:=True;
    

    No need to do after that a second

    Form1.Repaint;
    

    You will see only a short switch.

    procedure TForm1.BitBtn1Click(Sender: TObject);
    var
      path:string;
      b:TBitmap;
    begin
       sSkinProvider1.AllowExtBorders:=False;
       Form1.Repaint;
       path:= ExtractFilePath(Application.ExeName) + 'Screenshot\';
       b := TBitmap.Create;
       try
         ScreenShot(TRUE, b) ;
         b.SaveToFile(path + 'Screenshot_1.png');
       finally
         b.FreeImage;
         FreeAndNil(b) ;
         sSkinProvider1.AllowExtBorders:=True;
    [...]
    

    btw. do not set the path like

    path:= ExtractFilePath(Application.ExeName) + '/Screenshot/';
    

    use windows style backslash and only one

    path:= ExtractFilePath(Application.ExeName) + 'Screenshot\'; 
    

    Tested with Delphi5