Delphiによるスクリーンショットディスクの実装方法
1837 ワード
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,jpeg;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ScreenCap(LeftPos,TopPos,RightPos,BottomPos:integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
ScreenCap(0,0,Screen.Width,Screen.Height);
end;
procedure TForm1.ScreenCap(LeftPos,TopPos,RightPos,BottomPos:integer);
var
RectWidth,RectHeight:integer;
SourceDC,DestDC,Bhandle:integer;
Bitmap:TBitmap;
MyJpeg: TJpegImage;
Stream:TMemoryStream;
begin
MyJpeg:= TJpegImage.Create;
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
SourceDC:=CreateDC('DISPLAY','','',nil);
DestDC:=CreateCompatibleDC(SourceDC);
Bhandle:=CreateCompatibleBitmap(SourceDC,
RectWidth,RectHeight);
SelectObject(DestDC,Bhandle);
BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
LeftPos,TopPos,SRCCOPY);
Bitmap:=TBitmap.Create;
Bitmap.Handle:=BHandle;
Stream := TMemoryStream.Create;
Bitmap.SaveToStream(Stream);
Stream.Free;
try
MyJpeg.Assign(Bitmap);
MyJpeg.CompressionQuality:=70;
MyJpeg.Compress;
MyJpeg.SaveToFile('C:MyJPEGImage.JPG');
finally
MyJpeg.Free;
Bitmap.Free;
DeleteDC(DestDC);
ReleaseDC(Bhandle,SourceDC);
end;
end;
end.