绘制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.