Я пытаюсь добавить снимок экрана активного окна с помощью этого кода

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;

И в Button1 я использую:

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;

Он работает хорошо, только проблема в том, что он не захватывает строку заголовка :(

Вот полный вид активного окна:

enter image description here

И вот что я получил из этого кода

enter image description here

Где я делаю не так ??

1
dudey 1 Май 2014 в 19:02

2 ответа

Лучший ответ

Я проверил и получил тот же результат.

enter image description here

Оригинал с рамкой

enter image description here

Но если вы установите

sSkinProvider1.AllowExtBorders:=False;

Вы получите снимок экрана без прозрачной круглой рамки.

enter image description here

Затем отступить

sSkinProvider1.AllowExtBorders:=True;

Не нужно делать после этого секунду

Form1.Repaint;

Вы увидите только короткий переключатель.

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;
[...]

Кстати. не устанавливайте путь как

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

Используйте обратную косую черту в стиле Windows и только одну

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

Протестировано с Delphi5

2
moskito-x 2 Май 2014 в 21:43

Я не знаю, какие компоненты визуального стиля вы используете (хотя значок формы указывает на Delphi 7).

Этот код отлично работает для меня:

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;

Вот изображение, которое я сделал:

Sample form window capture

3
Ken White 2 Май 2014 в 16:20