一个绘制虚线的非常规函数（常规方法，打印机上绘制不出虚线）

    昨天碰到一个灰常的，郁闷之极的问题！在打印机上，竟然使用Delphi的常规方式绘制虚线的时候，竟然显示的始终是实线。

我们常规绘制虚线的方法很简单的，就是指定Canvas的PenStyle为虚线模式就可以了。代码简单了

Canvas.pen.style := psdot;

canvas.pen.color := clred;

canvas.moveto(20,30);

canvas.lineto(800,800);

这样绘制在窗体上，就可以画一条虚线咯。可是用这个绘制到打印机上，就不行了，在打印机画布上，用这个相同的代码，执行之后，实际上打印机打印出来的是实线。在这个破地方蛋疼了半天，打印的代码又多，前后来来回回的找可能出现问题的地方，找了半天都没发现神马问题，于是转而用纯API来写

tempPen := CreatePen(PS_DASH,1,clred);

selectObject(canvas.Handle,tempPen);

MovetoEx(Canvas.Handle,20,30,nil);

lineto(Canvas.Handle,800,800);

deleteobject(tempPen);

这样写了之后，还是一样的蛋疼。显示的还是实线。后来蛋疼的没办法了，找了半天也招不到问题所在！之后在网上谷歌一番。网上提出了一个更加蛋疼的方案，先把虚线画到一个位图上，然后再在打印机上输出位图。很不淡定的方案。看来这个问题，可能就是系统的问题了。于是恨不淡定的自己写了一个绘制虚线的函数。

直线的虚线条绘制，其实简单。X,Y上可以用多个小线段一条一条的模拟过去，如果是倾斜的斜线，可以计算出斜率，然后同时计算X,Y的步进步长，然后在一个一个的绘制小短线段，虚线就由小短线段组成了。

贴代码把

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;

用法

  Canvas.Pen.Color := clred;
  DrawVirtualLine(Canvas,Point(30,80),Point(10,120));
  DrawVirtualLine(Canvas,Point(10,120),Point(70,60));
  DrawVirtualLine(Canvas,Point(70,60),Point(30,80));