http://www.iteer.net/modules/newschina/article.php?storyid=539 用 WINAPI 的 BitBlt 函数就可以实现 例子uses WinTypes, WinProcs, Forms, Controls, Classes, Graphics;function CaptureScreenRect( ARect: TRect ): TBitmap; var ScreenDC: HDC; begin Result := TBitmap.Create; with Result, ARect do begin Width := Right - Left; Height := Bottom - Top; ScreenDC := GetDC( 0 ); try BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY ); finally ReleaseDC( 0, ScreenDC ); end; end; end;思路是这样的parameter 是一个 TRect, 也就是一个 4 方形,你可以设定,函数是这样的 TRect defines a rectangle. Unit Types Delphi syntax: type TRect = packed record case Integer of 0: (Left, Top, Right, Bottom: Integer); 1: (TopLeft, BottomRight: TPoint); end;返回一个 Bitmap 也就是图像拉 创建一个新的 bitmap instance HDC 是一个 device context (DC),也就可以利用 BitBlt 把windows 图像转到 bitmap 里了。 完整代码在这里,朋友可以直接调用unit ScrnCap;interface uses WinTypes, WinProcs, Forms, Controls, Classes, Graphics;function CaptureScreenRect( ARect: TRect ): TBitmap; function CaptureScreen: TBitmap; function CaptureClientImage( Control: TControl ): TBitmap; function CaptureControlImage( Control: TControl ): TBitmap; function CaptureWindowImage( Wnd: HWND ): TBitmap;implementation{==============================================================================} { Use this to capture a rectangle on the screen... } function CaptureScreenRect( ARect: TRect ): TBitmap; {==============================================================================} var ScreenDC: HDC; begin Result := TBitmap.Create; with Result, ARect do begin Width := Right - Left; Height := Bottom - Top; ScreenDC := GetDC( 0 ); try BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY ); finally ReleaseDC( 0, ScreenDC ); end; end; end;{==============================================================================} { Use this to capture the entire screen... } function CaptureScreen: TBitmap; {==============================================================================} begin with Screen do Result := CaptureScreenRect( Rect( 0, 0, Width, Height )); end;{==============================================================================} { Use this to capture just the client area of a form or control... } function CaptureClientImage( Control: TControl ): TBitmap; {==============================================================================} begin with Control, Control.ClientOrigin do Result := CaptureScreenRect( Bounds( X, Y, ClientWidth, ClientHeight )); end;{==============================================================================} { Use this to capture an entire form or control... } function CaptureControlImage( Control: TControl ): TBitmap; {==============================================================================} begin with Control do if Parent = nil then Result := CaptureScreenRect( Bounds( Left, Top, Width, Height )) else with Parent.ClientToScreen( Point( Left, Top )) do Result := CaptureScreenRect( Bounds( X, Y, Width, Height )); end;{==============================================================================} { Use this to capture an entire form or control paased as an API hWnd... } function CaptureWindowImage( Wnd: HWND ): TBitmap; {==============================================================================} var R: TRect; begin GetWindowRect(Wnd, R); Result := CaptureScreenRect(R); end;end.
用 WINAPI 的 BitBlt 函数就可以实现
例子uses WinTypes, WinProcs, Forms, Controls, Classes, Graphics;function CaptureScreenRect( ARect: TRect ): TBitmap;
var
ScreenDC: HDC;
begin
Result := TBitmap.Create;
with Result, ARect do
begin
Width := Right - Left;
Height := Bottom - Top;
ScreenDC := GetDC( 0 );
try
BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC,
Left, Top, SRCCOPY );
finally
ReleaseDC( 0, ScreenDC );
end;
end;
end;思路是这样的parameter 是一个 TRect, 也就是一个 4 方形,你可以设定,函数是这样的
TRect defines a rectangle.
Unit
Types
Delphi syntax:
type
TRect = packed record
case Integer of
0: (Left, Top, Right, Bottom: Integer);
1: (TopLeft, BottomRight: TPoint);
end;返回一个 Bitmap 也就是图像拉
创建一个新的 bitmap instance
HDC 是一个 device context (DC),也就可以利用 BitBlt 把windows 图像转到 bitmap 里了。
完整代码在这里,朋友可以直接调用unit ScrnCap;interface
uses WinTypes, WinProcs, Forms, Controls, Classes, Graphics;function CaptureScreenRect( ARect: TRect ): TBitmap;
function CaptureScreen: TBitmap;
function CaptureClientImage( Control: TControl ): TBitmap;
function CaptureControlImage( Control: TControl ): TBitmap;
function CaptureWindowImage( Wnd: HWND ): TBitmap;implementation{==============================================================================}
{ Use this to capture a rectangle on the screen... }
function CaptureScreenRect( ARect: TRect ): TBitmap;
{==============================================================================}
var
ScreenDC: HDC;
begin
Result := TBitmap.Create;
with Result, ARect do
begin
Width := Right - Left;
Height := Bottom - Top;
ScreenDC := GetDC( 0 );
try
BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC,
Left, Top, SRCCOPY );
finally
ReleaseDC( 0, ScreenDC );
end;
end;
end;{==============================================================================}
{ Use this to capture the entire screen... }
function CaptureScreen: TBitmap;
{==============================================================================}
begin
with Screen do
Result := CaptureScreenRect( Rect( 0, 0, Width, Height ));
end;{==============================================================================}
{ Use this to capture just the client area of a form or control... }
function CaptureClientImage( Control: TControl ): TBitmap;
{==============================================================================}
begin
with Control, Control.ClientOrigin do
Result := CaptureScreenRect( Bounds( X, Y, ClientWidth,
ClientHeight ));
end;{==============================================================================}
{ Use this to capture an entire form or control... }
function CaptureControlImage( Control: TControl ): TBitmap;
{==============================================================================}
begin
with Control do
if Parent = nil then
Result := CaptureScreenRect( Bounds( Left, Top, Width,
Height ))
else
with Parent.ClientToScreen( Point( Left, Top )) do
Result := CaptureScreenRect( Bounds( X, Y, Width,
Height ));
end;{==============================================================================}
{ Use this to capture an entire form or control paased as an API hWnd... }
function CaptureWindowImage( Wnd: HWND ): TBitmap;
{==============================================================================}
var
R: TRect;
begin
GetWindowRect(Wnd, R);
Result := CaptureScreenRect(R);
end;end.
var
bm : TBitmap;
begin
bm := TBitmap.Create;
bm.Width := self.Width;
bm.Height := self.Height; self.PaintTo(bm.Canvas, 0, 0);
bm.SaveToFile('c:\dfgh.bmp');
bm.Free;
bm := nil;
end;
我是Delphi6 + Win2000
aiirii(ari-爱的眼睛) 的最多只能保存当前屏幕中的内容。
TechnoFantasy(冰儿马甲www.applevb.com) 的只能保存当前屏幕中当前窗口的部分。谢谢。继续顶住。期待中
你是要保存窗口全部内容(包括标题栏和边框)吗?
不包括也没关系。
你给的代码确实没有边框,但是,也没有容下整个Form的内容。
然后Form就被撑大了,于是,右边和下面有滚动条。
我要把整个Form的内容保存为图形文件(*.bmp),其中可以没有滚动条(我觉得不应该有滚动条才对),可以没有标题栏。情况就是这样。请求帮助!谢谢。