虚线 转 不得闲

procedure DrawVirtualLine(Cvs: TCanvas;FromP,ToP: TPoint);
var
i: integer;
Xl: Single;
x,y: Integer;
begin
Cvs.MoveTo(FromP.x,FromP.y);
if FromP.x = ToP.X then
begin
i := FromP.Y;
while i <= ToP.Y do
begin
Cvs.LineTo(FromP.x,i + 1);
Cvs.MoveTo(FromP.X,i+4);
Inc(i,4);
end;
end
else if FromP.Y = ToP.Y then
begin
i := FromP.X;
while i <= Top.X do
begin
Cvs.LineTo(i + 1,FromP.y);
Cvs.MoveTo(i + 4,FromP.y);
Inc(i,4);
end;
end
else
begin
Xl := (ToP.Y - FromP.Y)/(ToP.X - FromP.x);
if Abs(xl) >= 1 then
begin
i := FromP.x;
y := FromP.Y;
if FromP.X < ToP.X then
while i <= ToP.X do
begin
Cvs.LineTo(i + 1,y+trunc(Xl));
y := y + Trunc(xl*2);
Cvs.MoveTo(i + 2,y);
Inc(i,2);
end
else
while i >= ToP.X do
begin
Cvs.LineTo(i - 1, y - Trunc(Xl));
y := y - Trunc(xl*2);
Cvs.MoveTo(i - 2,y);
dec(i,2);
end;
end
else
begin
i := FromP.Y;
x := FromP.X;
if FromP.y < ToP.y then
while i <= ToP.Y do
begin
Cvs.LineTo(x+trunc(1/xl),i+ 1);
x := x + Trunc(2/xl);
Cvs.MoveTo(x,i + 2);
Inc(i,2);
end
else
while i >= ToP.Y do
begin
Cvs.LineTo(x - Trunc(1 / Xl),i - 1);
x := x - Trunc(2 / Xl);
cvs.MoveTo(x,i - 2);
Dec(i,2);
end;
end;
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
Canvas.Pen.Color := clred;
Canvas.Pen.Width := 3;
DrawVirtualLine(Canvas,Point(30,80),Point(30,220));
// DrawVirtualLine(Canvas,Point(10,120),Point(70,60));
// DrawVirtualLine(Canvas,Point(70,60),Point(30,80));
end;