德爾福活動窗口截圖

Question

我想使用此代碼

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; 

它做工不錯唯一的問題是它不能捕捉稱號巴:(

這裏到處是活動窗口視圖：

這裏是我從該代碼

如果我做錯了什麼？得到

Answer 1

我已經測試並得到了相同的結果。

原件邊境

但是，如果你設置

sSkinProvider1.AllowExtBorders:=False; 

你沒有透明roundet邊框的屏幕截圖。

然後重新設置

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

btw。不設置路徑類似

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

使用windows風格的反斜線只有一個

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

與Delphi5

Answer 2

我不知道你使用的是什麼樣的視覺樣式組件（表單圖標表示它是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; 

這是我所拍攝的圖像：