请各位大虾帮忙,抓屏技术如何实现?(本机)(100分)

  • 主题发起人 主题发起人 angelwcm
  • 开始时间 开始时间
A

angelwcm

Unregistered / Unconfirmed
GUEST, unregistred user!
请问如何截取屏幕上的图片?恳求最好提供delphi源代码!!在此小女子谢谢各位了。
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
Panel1: TPanel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure GetScreen(var bmp: TBitmap);
var
dc : integer;
c : TCanvas;
R : TRect;
begin
bmp := TBitmap.Create;

dc := GetWindowDC(0);
try
c := TCanvas.Create;
c.Handle := dc;
R := Rect(0, 0, Screen.Width, Screen.Height);
bmp.Width := R.Right;
bmp.Height := R.Bottom;
bmp.Canvas.CopyRect(R, c, R);
c.Handle := 0;
c.Free;
finally
ReleaseDC(0, dc);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp := TBitmap.Create;
GetScreen(bmp);
Image1.Picture.Bitmap.Assign(bmp);
end;

end.
 
//直接保存到JPG文件
//iQuality指图片质量
procedure SaveSrcToJPEGFile(const FileName:String;iQuality:integer);
var SrcWidth,SrcHeight:integer;
DC:HDC;
FBitmap:TBitmap;
FJPEGImage:TJPEGImage;
begin
DC:=GetDC(0);
FBitmap:=TBitmap.Create;
FJPEGImage:=TJPEGImage.Create;
try
SrcWidth:=Screen.Width;
SrcHeight:=Screen.Height;
FBitmap.Width :=SrcWidth;
FBitmap.Height:=SrcHeight;
BitBlt(FBitmap.Canvas.Handle,0,0,SrcWidth,SrcHeight,DC,0,0,SRCCOPY);
FJPEGImage.Assign(FBitmap);
FJPEGImage.CompressionQuality:=iQuality;
FJPEGImage.Compress;
FJPEGImage.SaveToFile(FileName);
finally
FBitmap.Free;
FJPEGImage.Free;
end;
end;
 
var
desk:tcanvas;
bitmap:tbitmap;
hdesk:thandle;
begin
bitmap:=tbitmap.Create;
desk:=tcanvas.Create; //以下代码为取得当前屏幕图象
desk.Handle:=getdc(hwnd_desktop);
with bitmap do
begin
width:=screen.Width;
height:=screen.Height;
canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
end;
finally
bitmap.free;
desk.free;
end;
end;
end;
 
多人接受答案了。
 

Similar threads

I
回复
0
查看
598
import
I
I
回复
0
查看
774
import
I
D
回复
0
查看
2K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部