如何实现大十字光标(200分)

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

shanxi

Unregistered / Unconfirmed
GUEST, unregistred user!
狠急,请大虾帮忙
 
在什么地方实现?在cursor属性里面设置不是得了吗
 
我估计shanxi想要 Auto CAD 里的那个效果,不知道怎么作。
 
声明全局变量:var i,j:integer;
procedure tform1.formpaint(sender:tobject);{在窗体上绘制两条直线}
begin
with canvas do
begin
form1.moveto(i,0);
form1.lineto(i,form1.height);
form1.moveto(0,j);
form1.lineto(form1.width,j);
end;
end;
procedure tform1.mousemove(sender:tobject;shift:tshiftstate;x,y:integer);
begin
i:=x;
j:=y;
invalidate;
statusbar.panel[0].text:=format('位置:(%d,%d)',[x,y]);{显示鼠标位置}
end;
end.

 
DELPHI里自己画一个嘛!
 
绘制CAD中的交叉光标关键有两点:
1. 画笔的绘图模式应该取反(Pen.Mode := pmNotXor
2. 每次移动后绘制十字之前要先擦除旧的十字(记住旧位置, 用取反画笔在原来位置画一次)

unit Crossfrm;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
procedure FormClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
ShowCrossing: boolean;
PCursor: TPoint;
Procedure DrawCrossing;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.DrawCrossing;
begin
With Canvas do
begin
Pen.Mode:=pmNotXor;
MoveTo(0,PCursor.y);
LineTo(width,PCursor.y);
MoveTo(PCursor.x, 0);
LineTo(PCursor.x, Height)
end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
if ShowCrossing then
begin
ShowCrossing:=false;
DrawCrossing;
Cursor := crDefault;
end else
begin
ShowCrossing:=true;
GetCursorPos(PCursor);
PCursor:=ScreenToClient(PCursor);
DrawCrossing;
Cursor := crNone;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ShowCrossing then
begin
DrawCrossing;
PCursor := Point(x,y);
DrawCrossing;
end;
Panel1.Caption:=Format('X,Y: %d,%d', [X,Y]);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
if ShowCrossing then
DrawCrossing;
end;

end.
 
var
First :Boolean;
ox,oy :Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
First :=True;
Canvas.Pen.Mode :=pmNotXor;
Canvas.Pen.Color :=clRed;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not First then
begin
Canvas.MoveTo(ox-50,oy);
Canvas.LineTo(ox+50,oy);
Canvas.MoveTo(ox,oy-50);
Canvas.LineTo(ox,oy+50);
end;
Canvas.MoveTo(x-50,y);
Canvas.LineTo(x+50,y);
Canvas.MoveTo(x,y-50);
Canvas.LineTo(x,y+50);
OX :=X;
OY :=Y;
First :=False;
end;
 
偶一看,卷卷打题就知道有结果了,收藏先
 
后退
顶部