码迷,mamicode.com
首页 > Windows程序 > 详细

Delphi实现截屏存盘的方法

时间:2016-03-05 06:54:45      阅读:241      评论:0      收藏:0      [点我收藏+]

标签:

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.

  

Delphi实现截屏存盘的方法

标签:

原文地址:http://www.cnblogs.com/tc310/p/5244055.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!