局部抓图的问题会的请看一看啊谢谢 了(100分)

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

liujianan

Unregistered / Unconfirmed
GUEST, unregistred user!
这是部分代码也是书上的代码小弟才学这个的哦有几个地方错了不知道怎么解决了谢谢大家帮一帮忙了代码后面是错!
procedure TForm2.Timer1Timer(Sender: TObject);
var
foldx,foldy:integer;
full:tbitmap;

fc:tcanvas;
dc:hdc;
begin
timer1.Enabled :=false;
full:=tbitmap.Create;
full.Width :=screen.Width;
full.Height :=screen.Height;
dc:=getdc(0);
fc:=tcanvas.Create ;
fc.handle:=dc;
full.Canvas.CopyRect(rect(0,0,screen.Width,screen.Height),fc,rect(0,0,screen.Width,screen.Height ));
fc.Free;
releasedc(0,dc);
image1.Picture.Bitmap:=full;
image1.Width:=full.Width ;
image1.Height:=full.Height ;
full.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
x1,x2,y1,y2,foldx,foldy:integer;
width,height,oldx,oldy:integer;
n:tbitmap;
begin
if trace=false then
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
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;
n:=tbitmap.Create;
n.width:=width;
n.height:=height;
n.Canvas.CopyRect(rect(0,0,width,height),form2.Canvas,Rect(x1,y1,x2,y2));
form1.image1.picture.bitmap:=n;
n.Free;
form2.Hide;
form2.Show;
end;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var x1,y1,foldx,foldy,oldx,oldy: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;
出错的地方是:undeclared identifier:'flag'
undeclared identifier:'trace'
我不知道这两 个是做什么用的我要怎么做才可以啊
 
这两个错误提示意思是未声明变量flag,trace,在声明变量部分把他们加上应该可以了
但具体类型还需看一下程序来确定,看看在程序里他们是被当作什么类型来用的
 
不行啊在程序里它们是boolean可是我加上去以后又多了很 多的错误
 
{*******************************************************}
{ }
{ 区域抓图程序V1.0 }
{ }
{ Copyright (c) 2003.10.20 Borland Software Corporation }
{ }
{*******************************************************}

unit FormP;

interface

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

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

var
FormPic: TFormPic;
Trace,Flag:boolean;
x1,y1,x2,y2,oldx,oldy,foldx,foldy:integer;

implementation


{$R *.dfm}

procedure TFormPic.Timer1Timer(Sender: TObject);
var
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
DC:HDC;
begin
Timer1.Enabled:=false; //停止时钟
Fullscreen:=TBitmap.Create; //创建一个BITMAP来存放图象
FullscreenCanvas:=TCanvas.Create; //创建一个CANVAS对象
try
Fullscreen.Width:=Screen.width;
Fullscreen.Height:=Screen.Height;
DC:=GetDC(0); //取得屏幕的 DC,参数0指的是屏幕
FullscreenCanvas.Handle:=DC;
//*************************************
Fullscreen.Canvas.CopyRect(Rect (0, 0, Screen.Width, Screen.Height), fullscreenCanvas,Rect(0, 0, Screen.Width, Screen.Height));
//把整个屏幕复制到BITMAP中
ReleaseDC(0, DC); //释放DC
//*******************************
Image1.Picture.Bitmap:=Fullscreen;//拷贝下的图象赋给IMAGE对象
Image1.Width:=Fullscreen.Width;
Image1.Height:=Fullscreen.Height;
finally
FullscreenCanvas.Free; //释放CANVAS对象
Fullscreen.Free; //释放bitmap
end;
FormPic.show; //显示窗口
FormPic.WindowState:=wsMaximized; //窗口最大化
//Messagebeep(1); //BEEP叫一声,报告图象已经截取好了。
foldx:=-1;
foldy:=-1;
Image1.Canvas.Pen.Mode:=pmnot; //笔的模式为取反
Image1.Canvas.Pen.Color:=clblack; //笔为黑色
Image1.Canvas.Brush.Style:=bsclear; //空白刷子
Flag:=True;
end;

procedure TFormPic.FormCreate(Sender: TObject);
begin
FormPic.WindowState:=wsMinimized;
Timer1.Enabled:=True;
end;

procedure TFormPic.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Width,Height:integer;
NewBitmap:Tbitmap;
begin
if (Button=mbRight) then
Application.Terminate;
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);
Image1.Width:=Width;
Image1.Height:=Height;
//*******************************
NewBitmap:=Tbitmap.Create; //创建一个NewBitmap来存放区域图片
try
NewBitmap.Width:=Width;
NewBitmap.Height:=Height;
NewBitmap.Canvas.CopyRect(Rect(0, 0, width, Height),image1.canvas,Rect(x1, y1,x2,y2)); //拷贝
Image1.Picture.Bitmap:=NewBitmap; //放到FORM的IMAGE上
finally
NewBitmap.Free;
end;
Clipboard.Assign(Image1.Picture);//把截取的图象拷贝到剪切板
Application.Terminate;
end;
end;

procedure TFormPic.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: 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
//Image1.Stretch:=true; //消除屏幕闪烁
Image1.Parent.DoubleBuffered:=True;//消除屏幕闪烁
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;

procedure TFormPic.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=VK_ESCAPE) then
Application.Terminate;
end;

end.

*********************
这是我原来修改过的代码!图象直接存到了剪切板然后直接退出程序!
你可以用画笔粘贴了来看,截取的图象!
 
你把procedure tformpic.image1mousedown 中 application.terminate去掉程序就不会退出了!
 
把声明加上吧。
 
谢谢 大家哈哈我弄好了
 

Similar threads

I
回复
0
查看
528
import
I
I
回复
0
查看
425
import
I
I
回复
0
查看
686
import
I
顶部