一个关于图形的有趣的问题!(50分)

  • 主题发起人 主题发起人 suns
  • 开始时间 开始时间
S

suns

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TForm1.Chart1Mousemove(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var CrossHairColor:TColor;
CrossHairStyle:TPenStyle;
begin
With Chart1,Canvas do
begin
Pen.Color:=clblue;
Pen.Style:=CrossHairStyle;
Pen.Mode:=pmXor;
Pen.Width:=1;

MoveTo(x,ChartRect.Top-Height3D);
LineTo(x,ChartRect.Bottom-Height3D);
MoveTo(ChartRect.Left+Width3D,y);
LineTo(ChartRect.Right+Width3D,y);
end;
end;
这段代码大家一定熟悉,就是在鼠标移动时跟随一个十子型的框子用于定位的。
由于特殊原因,我不能在chart上这么容易的画这个十子型的框子,而是在桌面
的画布上实现它,但上我运行后发现虽然有显示十子型的框子,但鼠标的运行轨
迹还留在画布上,我开始想的在鼠标运行时来一个大扫除可我的坐标也随之清除
希望大家给我一个可行的方法。
这是我的代码
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var CrossHairColor:TColor;
CrossHairStyle:TPenStyle;
begin
label1.Caption :=inttostr(x);
label2.Caption :=inttostr(y);
statusbar1.Panels[0].Text :='当前位置是:'+label1.Caption+#18+'---'+#18+label2.Caption ;
With Canvas do
begin
Pen.Color:=clblue; //画笔颜色
Pen.Style:=CrossHairStyle;//画笔类型
Pen.Mode:=pmXor; //如何画线
Pen.Width:=2; //画笔宽度
MoveTo(x,form1.Top+20 );
LineTo(x,form1.Height-20 );
MoveTo(form1.Left+20,y);
LineTo(form1.Width-20 ,y);
end;
end;
 
来试试,呵呵

var
Form1: TForm1;
xx,yy :Integer;

implementation

{$R *.DFM}

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
xx :=x;
yy :=y;
Invalidate;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
with Canvas do
begin
MoveTo(0,yy);
LineTo(Form1.Width,yy);
MoveTo(xx,0);
LineTo(xx,Form1.Height);
end;
end;
 
还是这样好~~~

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
x0,y0 :Integer;
begin
with Canvas do
begin
MoveTo(x0-20,y0);
LineTo(x0+20,y0);
MoveTo(x0,y0-20);
LineTo(x0,y0+20);
Pen.Mode :=pmNotXor;
MoveTo(x-20,y);
LineTo(x+20,y);
MoveTo(x,y-20);
LineTo(x,y+20);
end;
x0 :=x;
y0 :=y;
end;
 
var
Form1: TForm1;
oldx,oldy:integer;
implementation

{$R *.dfm}

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var CrossHairColor:TColor;
CrossHairStyle:TPenStyle;

begin
label1.Caption :=inttostr(x);
label2.Caption :=inttostr(y);
statusbar1.Panels[0].Text :='当前位置是:'+label1.Caption+#18+'---'+#18+label2.Caption ;
With Canvas do
begin
Pen.Color:=clblue; //画笔颜色
Pen.Style:=CrossHairStyle;//画笔类型
Pen.Mode:=pmxor;

MoveTo(oldx,form1.Top+20 );
LineTo(oldx,form1.Height-20 );
MoveTo(form1.Left+20,oldy);
LineTo(form1.Width-20 ,oldy);

MoveTo(x,form1.Top+20 );
LineTo(x,form1.Height-20 );
MoveTo(form1.Left+20,y);
LineTo(form1.Width-20 ,y);
oldx:=x;oldy:=y;
end;

end;

end.
 

Similar threads

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