德尔福活动窗口截图

我想使用此代码德尔福活动窗口截图

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

如果我做错了什么？得到

来源

2014-05-01 dudey

参见[这个答案]（HTTP测试：//计算器。com/q/16700014/62576）到一个类似的问题。它应该有所帮助。 –

改为使用'GetWindowDC'。 –

@KenWhite在答案中的代码给我错误在Bitmap.SetSize（宽度，高度）;说Undeclared标识符：'SetSize' – dudey

我已经测试并得到了相同的结果。

enter image description here

原件边境

enter image description here

但是，如果你设置

sSkinProvider1.AllowExtBorders:=False;

你没有透明roundet边框的屏幕截图。

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

btw。不设置路径类似

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

使用windows风格的反斜线只有一个

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

与Delphi5

来源

2014-05-02 20:57:59

好吧，这是很好的技巧;）我没有想过这个之前反正thx to @kenwhite也 - 问题解决（Y） – dudey

我不知道你使用的是什么样的视觉样式组件（表单图标表示它是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

来源

2014-05-02 16:11:04

嗨它的alphaskins /德尔福7即时通讯使用当我从窗体中删除蒙皮组件它捕获所有形式 – dudey

似乎AlphaSkins干扰正常捕获的东西然后，对不起 - 我没有在这里安装Delphi 7，也没有AlphaSkins在任何地方，所以我无法帮助你，也许应该编辑你的原始问题以包含这些信息。 –

德尔福活动窗口截图

回答

相关问题