Delphi ScreenCap 截图

2022-11-19 09:13:21 作者:admin

本文整理自网络,侵删。

 unit Unit1;
interface
uses  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,  System.Classes, Vcl.Graphics,  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, jpeg;
type  TForm1 = class(TForm)    btnScreenCap: TButton;    procedure ScreenCap(LeftPos, TopPos, RightPos, BottomPos: integer);    procedure btnScreenCapClick(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end;
var  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnScreenCapClick(Sender: TObject);begin  ScreenCap(1, 1, 500, 500);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 := 100;    MyJpeg.Compress;    MyJpeg.SaveToFile('d:\MyJPEGImage.JPG');  finally    MyJpeg.Free;    Bitmap.Free;    DeleteDC(DestDC);    ReleaseDC(Bhandle, SourceDC);  end;end;
end.

相关阅读 >>

Delphi tmemo 可以显示、编辑多行文本

Delphi webbrowser控件里编辑网页

Delphi 获取cpu使用单元文件

Delphi 判断当前网络连接方式

Delphi7 中tstringlist的delimiter delimitedtext有bug,字符串分割有问题

Delphi xe10 百度车牌识别

Delphi sizetostr 文件大小转换kb mb gb tb

Delphi复制粘贴操作

Delphixe firemonkey 如何画图

Delphi 获取系统托盘程序列表

更多相关阅读请进入《Delphi》频道 >>



在线咨询 拨打电话