Delphi Active Window Screenshot - delphi

Question

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 :
And Here is what i get from that code
Where am i doing wrong ??

Answer 1

I don't know what kind of visual styling components you're using (the form icon indicates it's Delphi 7, though).
This code works perfectly for me:
function CaptureWindow(const WindowHandle: HWnd): TBitmap;
var
DC: HDC;
wRect: TRect;
Width, Height: Integer;
begin
DC := GetWindowDC(WindowHandle);
Result := TBitmap.Create;
try
GetWindowRect(WindowHandle, wRect);
Width := wRect.Right - wRect.Left;
Height := wRect.Bottom - wRect.Top;
Result.Width := Width;
Result.Height := Height;
Result.Modified := True;
BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
finally
ReleaseDC(WindowHandle, DC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Capture: TBitmap;
begin
// For active window, change Handle to GetForegroundWindow()
Capture := CaptureWindow(Handle);
try
Capture.SaveToFile('E:\TempFiles\ScreenCapture2014.bmp');
finally
Capture.Free;
end;
end;
Here's the image I captured:

Answer 2

I have tested and got the same result.
original with border
But if you set
sSkinProvider1.AllowExtBorders:=False;
you get a screenshot without the transparent roundet border.
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