多动手!~
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure CaptureWindows(hWnd : THandle;
FileName : PChar;
bmpType : Boolean= True);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CaptureWindows(hWnd: THandle;FileName : PChar;
bmpType : Boolean= True);
var
TempCanvas : TCanvas;
TempBitmap : TBitmap;
TempJpeg : TJPEGImage;
WinRect, TempRect : TRect;
begin
if hWnd <= 0 then
Exit;
TempCanvas := TCanvas.Create;
TempBitmap := TBitmap.Create;
TempJpeg := TJPEGImage.Create;
try
try
TempCanvas.Handle := GetWindowDC(GetDesktopWindow);
GetWindowRect(hWnd, TempRect);
WinRect := Rect(0, 0, TempRect.Right - TempRect.Left,
TempRect.Bottom - TempRect.Top);
TempBitmap.Width := TempRect.Right - TempRect.Left;
TempBitmap.Height := TempRect.Bottom - TempRect.Top;
TempBitmap.Canvas.CopyRect(WinRect, TempCanvas, TempRect);
if bmpType then
TempBitmap.SaveToFile(FileName+'.bmp')
else
begin
//要引用jpeg
TempJpeg.Assign(TempBitmap);
TempJpeg.Compress;
TempJpeg.SaveToFile(FileName+'.jpg');
end;
except
on e: Exceptiondo
begin
Application.MessageBox(PChar('保存窗体图片失败,' + e.Message), '错误', MB_OK+MB_ICONERROR)
end;
end;
finally
TempJpeg.Free;
TempBitmap.Free;
TempCanvas.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CaptureWindows(Self.Handle, 'test');
end;
end.