在画布上用自定义样式画一条线（Delphi）

Question

我需要在画布上绘制一些线条，但我需要使用自定义样式，而不是标准的实线、虚线等样式。

例如，我需要绘制一条线 "__ . __ . _" 或 " . _ . _ . _ . _"。所有线条都是由点和短划线组成的，我还需要设置短划线长度和点的宽度。

我不想使用GDI+或其他外部库...

有没有简单的方法可以做到这一点？

- Martin

---

ExtCreatePen函数允许创建用户样式笔（有一些限制）。 - MBo

可能是更改线条虚线的大小是否可能？的重复问题。 - Sertac Akyuz

谴责那些投票关闭此问题的人... - Jerry Dodge

@Jerry - 投票属于我，原因是这个问题是一个确切的重复，回答也是。请跟随链接... - Sertac Akyuz

我会称之为部分重复，而不是完全相同。之前的问题是要求“更改破折号的大小”，而这个问题是“如何制作自定义样式线” - 尽管实现两者的方法相同，但每个问题的最终目标是不同的。 - Jerry Dodge

@Jerry - 你不能改变破折号的大小，除非自定义线条样式，这些问题是相同的。虽然显然我们在这个问题上有不同的看法.. :) - Sertac Akyuz

Answer 1

您可以使用普通的GDI完成此操作：

procedure TForm1.FormPaint(Sender: TObject);
const
  pattern: array[0..3] of cardinal = (10, 1, 1, 1);
var
  lb: TLogBrush;
  pen, oldpen: HPEN;
begin
  lb.lbStyle := BS_SOLID;
  lb.lbColor := RGB(255, 0, 0);
  pen := ExtCreatePen(PS_COSMETIC or PS_USERSTYLE, 1, lb, length(pattern), @pattern);
  if pen <> 0 then
    try
      oldpen := SelectObject(Canvas.Handle, pen);
      Canvas.MoveTo(0, 0);
      Canvas.LineTo(ClientWidth, ClientHeight);
      SelectObject(Canvas.Handle, oldpen);
    finally
      DeleteObject(pen);
    end;
end;

- Andreas Rejbrand

---

为什么我无法更改宽度参数？如果我更改它，我总是得到宽度为1的实线... - Martin

@Martin：我认为GDI cosmetic pens只能有单位宽度。[doc]（http://msdn.microsoft.com/en-us/library/windows/desktop/dd162705(v=vs.85).aspx） - Andreas Rejbrand

如果我将“pattern：array [0..3] of cardinal”更改为“pattern：array of cardinal”，然后使用“SetLength（pattern，4）;”并将数组值设置为10、1、1和1，则始终会得到一个连续的线。为什么？有没有办法在创建新笔之前设置数组长度并更改值？ - Martin

@Martin：因为动态数组是指针，所以不会被“原地”存储在内存中。因此，如果您使用动态数组，必须将@pattern替换为@pattern[0]。 - Andreas Rejbrand

Answer 2

您还可以使用LineDDA API。虽然Andreas Rejbrand建议使用笔划样式更快，但使用LineDDA可以让您以不同颜色绘制线条的各个部分。

var
  DottedLineDrawCounter: Integer;

procedure DDAProc(AX, AY: Integer; ACanvas: TCanvas); stdcall;
begin
  if DottedLineDrawCounter mod 4 = 0 then
    ACanvas.Pixels[AX, AY] := clRed
  else
    ACanvas.Pixels[AX, AY] := clBlack;
  Inc(DottedLineDrawCounter);
end;

...
begin
  // Usage
  DottedLineDrawCounter := 0;
  LineDDA(X1, Y1, X2, Y2, @DDAProc, LPARAM(Canvas));
end;

- Andrew