抓取屏幕窗体的问题?(100分)

  • 主题发起人 主题发起人 ldz1978
  • 开始时间 开始时间
L

ldz1978

Unregistered / Unconfirmed
GUEST, unregistred user!
我在作抓取屏幕上窗体时是这么做的,取得所选窗体的HDC,和Rect后,用
m_adc->BitBlt(0,10,Rect->right-Rect->left,Rect->bottom-Rect->top,
&m_DC,0,0,SRCCOPY);
将窗体的图象copy下来,不过当所选窗体被其他船体遮盖了,这让作并不能取得所选窗体
的图象,而是把遮盖窗体的一部分也给抓下来了。
请问各位高手,如何才能把窗体完整的抓下来,而不管有没有窗体覆盖。
 
;没办法。因为不可见部分被 GDI 裁剪了,根本就没有向屏幕输出,内存中也没有被遮盖部分
的映像。
 
这个问题刚被问过,有好多馊主意,你可查查看.:)
 
用我的方法,保证行!只需两个Form
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
ScrollBox1: TScrollBox;
Image1: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Timer1: TTimer;
SaveDialog1: TSaveDialog;
procedure Button4Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.Button4Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
begin
timer1.Enabled:=false; //取消时钟
Fullscreen:=TBitmap.Create; //创建一个BITMAP来存放图象
Fullscreen.Width:=screen.width;
Fullscreen.Height:=screen.Height;
DC:=GetDC(0); //取得屏幕的DC,参数0指的是屏幕
FullscreenCanvas:=TCanvas.Create;//创建一个CANVAS对象
FullscreenCanvas.Handle:=DC;

Fullscreen.Canvas.CopyRect
(Rect(0,0,screen.Width,screen.Height),fullscreenCanvas,
Rect(0,0,Screen.Width,Screen.Height));
//把整个屏幕复制到BITMAP中
FullscreenCanvas.Free; //释放CANVAS对象
ReleaseDC(0,DC); //释放DC
//*******************************
image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象
image1.Width:=fullscreen.Width;
image1.Height:=fullscreen.Height;
fullscreen.free; //释放bitmap
form1.WindowState:=wsNormal; //复原窗口状态
form1.show; //显示窗口
messagebeep(1); //BEEP叫一声,报告图象已经截取好了。
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
form1.WindowState:=wsMinimized;//最小化程序窗口
form1.hide; //把程序藏起来
timer1.enabled:=true; //打开记时器
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if savedialog1.Execute then
begin
form1.Image1.Picture.SaveToFile(savedialog1.filename)
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
form1.Hide;
form2.hide;
form2.Timer1.Enabled:=true;
end;

end.


unit Unit2;

interface

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

type
TForm2 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;
foldx,foldy,x1,y1,oldx,oldy,x2,y2 : integer;
flag,trace : boolean;
implementation

uses Unit1;

{$R *.DFM}

procedure TForm2.Timer1Timer(Sender: TObject);
var
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
//foldx,foldy: integer;
//flag : boolean;
begin
timer1.Enabled:=false;
Fullscreen:=TBitmap.Create;
Fullscreen.Width:=screen.width;
Fullscreen.Height:=screen.Height;
DC:=GetDC(0);
FullscreenCanvas:=TCanvas.Create;
FullscreenCanvas.Handle:=DC;
Fullscreen.Canvas.CopyRect(Rect
(0,0,screen.Width,screen.Height),fullscreenCanvas,
Rect(0,0,Screen.Width,Screen.Height));
FullscreenCanvas.Free;
ReleaseDC(0,DC);
image1.picture.Bitmap:=fullscreen;
image1.Width:=fullscreen.Width;
image1.Height:=fullscreen.Height;
fullscreen.free;
form2.WindowState:=wsMaximized;
form2.show;

messagebeep(1);
foldx:=-1;
foldy:=-1;
image1.Canvas.Pen.mode:=pmnot;//笔的模式为取反
image1.canvas.pen.color:=clblack;//笔为黑色
image1.canvas.brush.Style:=bsclear;//空白刷子
flag:=true;

end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
width,height:integer;
newbitmap:Tbitmap;
//trace,flag : boolean;
begin
if(trace=false)then //TRACE表示是否在追踪鼠标
begin //首次点击鼠标左键,开始追踪鼠标。
flag:=false;
with image1.canvas do
begin
moveTo(foldx,0);
LineTo(foldx,screen.height);
moveto(0,foldy);
lineto(screen.width,foldy);
end;
x1:=x;
y1:=y;
oldx:=x;
oldy:=y;
trace:=true;
image1.Canvas.Pen.mode:=pmnot; //笔的模式为取反
//这样再在原处画一遍矩形,相当于擦除矩形。
image1.canvas.pen.color:=clblack; //笔为黑色
image1.canvas.brush.Style:=bsclear;//空白刷子
end
else
begin //第二次点击,表示已经得到矩形了,
//把它拷贝到FORM1中的IMAGE部件上。
x2:=x;
y2:=y;
trace:=false;
image1.canvas.rectangle(x1,y1,oldx,oldy);
width:=abs(x2-x1);
height:=abs(y2-y1);
form1.image1.Width:=Width;
form1.image1.Height:=Height;

newbitmap:=Tbitmap.create;
newbitmap.width:=width;
newbitmap.height:=height;
newbitmap.Canvas.CopyRect
(Rect(0,0,width,Height),form2.image1.canvas,
Rect(x1,y1,x2,y2));//拷贝
form1.image1.picture.bitmap:=newbitmap;//放到FORM的IMAGE上
newbitmap.free;
form2.hide;
form1.show;
end;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
//var trace,flag : boolean;
// x1,y1,oldx,oldy,foldx,foldy : integer;
begin
if trace=true then //是否在追踪鼠标?
begin //是,擦除旧的矩形并画上新的矩形
with image1.canvas do
begin
rectangle(x1,y1,oldx,oldy);
Rectangle(x1,y1,x,y);
oldx:=x;
oldy:=y;
end;
end
else if flag=true then //在鼠标所在的位置上画十字
begin
with image1.canvas do
begin
moveTo(foldx,0); //擦除旧的十字
LineTo(foldx,screen.height);
moveto(0,foldy);
lineto(screen.width,foldy);
moveTo(x,0); //画上新的十字
LineTo(x,screen.height);
moveto(0,y);
lineto(screen.width,y);
foldx:=x;
foldy:=y;
end;
end;
end;

end.
 
这人写一大篇在干啥? 根本文不对题嘛. 还保证行?
 
kisse的程序只是把屏幕上的矩形内的图象抓下来,并没有达到我的要求。
 
请继续或结束
 
ldz1978:如果你还要继续讨论请定期提前你的帖子,如果不想继续讨论请结束帖子。
 
没这么trouble吧,我用的是getformimage.dephi下有这个函数的例子
procedure TForm1.Button1Click(Sender: TObject);

var
FormImage: TBitmap;
begin
FormImage := GetFormImage;
try
Clipboard.Assign(FormImage);
Image1.Picture.Assign(Clipboard);
finally
FormImage.Free;
end;
end;
 
请继续或结束
 
请继续或结束
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
585
import
I
I
回复
0
查看
611
import
I
后退
顶部