在 ImgView32 图层上画一条粗虚线

Drawing a thick dotted line on a ImgView32 layer

我只想在ImgView32的图层上画一条垂直的粗点线。 我还希望我的线更粗,所以我将多条线画得很近,因为 Canvas.Pen.Width 对 LineTo 方法没有影响。 所以我的代码如下:

procedure TMainForm.PaintDottedHandler(Sender: TObject;Buffer: TBitmap32);
var
  Cx, Cy,raza: Single;
  W2, H2: Single;
  I,J: Integer;
  points:TArrayOfFloatPoint;
  Center, Radius:TFloatPoint;
const
  CScale = 1 / 200;
begin

  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do
    begin
      W2 := (Right - Left) * 0.5;
      H2 := (Bottom - Top) * 0.5;

      Cx := Left + W2;
      Cy := Top + H2;
      W2 := W2 * CScale;
      H2 := H2 * CScale;
      Buffer.PenColor := clRed32;

      Buffer.MoveToF(Cx-2,Top);
      Buffer.LineToFSP(Cx-2 , Bottom);

      Buffer.MoveToF(Cx-1,Top);
      Buffer.LineToFSP(Cx-1 , Bottom);

      Buffer.MoveToF(Cx,Top);
      Buffer.LineToFSP(Cx , Bottom);

      Buffer.MoveToF(Cx+1,Top);
      Buffer.LineToFSP(Cx+1 , Bottom);

      Buffer.MoveToF(Cx+2,Top);
      Buffer.LineToFSP(Cx+2 , Bottom);
    end;
end;

所以这条线打算放在新图层的中间。我使用这个添加图层:

procedure TMainForm.DottedLine1Click(Sender: TObject);
var
  L: TPositionedLayer;
begin
  L := CreatePositionedLayer;
  L.OnPaint := PaintDottedHandler;
  L.Tag := 2;
  Selection := L;
end;

对于其余代码,只需将我的代码添加到 Layers 示例中,您就可以重现我的问题。

据我所知,为了绘制一条虚线,有多个方法,例如带有 LineToFSP 的 Stipple(在我的代码中使用)或带有 BuildDashedLine 点的 PolyPolygonFS。但我似乎无法让它们中的任何一个正常工作。 实际上第二种方法没有做任何事情......所以我坚持我的第一种方法。 所以看起来每次它开始画一条线时,虚线开始的方式都是随机的。所以它要么是一个像素,要么是一个空像素。 因此,当我调整图层大小时,线条会如下图所示进行变换:

事实上,我想要实现的是:

当然,我希望在调整图层大小时不扭曲它的情况下再次绘制线条(这就是我使用 onPaint 处理程序方法的原因)。 如果我只是在图层上画一条简单的线(使用 Bitmap.Canvas)然后调整图层的大小,那么线会像拉伸 jpeg 一样变形,所以我想避免这种情况。

所以请告诉我如何在 ImgView32 (TGraphics32) 中的图层上绘制粗虚线

编辑

在尝试了答案中的代码后,我成功了。然而,这一层有一个副作用:当调整层的大小时(使用鼠标),在某些宽度下,虚线的颜色会变暗和模糊,如下所示:

调整大小前 调整大小后(有时)。

您可以使用相同的代码自己重现。

编辑

这个特殊层还有另一个问题:将它保存到文件...我尝试使用两种方法将它保存为透明 PNG,但我总是收到损坏的文件。即使我尝试将图层保存为位图,也会发生相同的损坏。请也检查这个问题:

您需要重置每行之间的 stipple counter。否则每一行将继续前一行停止的模式:

Buffer.StippleCounter := 0;
Buffer.MoveToF(Cx-2,Top);
Buffer.LineToFSP(Cx-2 , Bottom);

Buffer.StippleCounter := 0;
Buffer.MoveToF(Cx-1,Top);
Buffer.LineToFSP(Cx-1 , Bottom);
...etc...

您没有展示您的 pattern 是如何设置的,但从您的示例来看,那里也可能存在问题。我会(现在)这样做:

Buffer.SetStipple([clBlack32, clBlack32, clBlack32, clBlack32, clBlack32,
  clWhite32, clWhite32, clWhite32, clWhite32, clWhite32]); // Alternating black and white, 5 pixels each

正如@SpeedFreak 提到的,您需要在每次绘制线条调用之前重置 StrippleCounter。您还需要为您的线路设置合适的线路模式。这可以通过 SetStripple 方法来完成。诀窍是为您的线条宽度正确设置此图案。如果你的线条是 5 像素宽,那么你需要一个由 5 个黑色像素和 5 个白色像素组成的图案。

试试这个,我删除了不必要的代码(更新):

procedure TMainForm.PaintDottedHandler(Sender: TObject; Buffer: TBitmap32);
var
  R: TRect;
  Cx: Integer;
begin
  if Sender is TPositionedLayer then
  begin
    // Five black pixels, five white pixels since width of the line is 5px
    Buffer.SetStipple([clBlack32, clBlack32, clBlack32, clBlack32, clBlack32,
      clWhite32, clWhite32, clWhite32, clWhite32, clWhite32]);
    // We mest operate on integer values to avoid blurred line.
    R := MakeRect(TPositionedLayer(Sender).GetAdjustedLocation);
    Cx := R.Left + (R.Right - R.Left) div 2;

    Buffer.StippleCounter := 0;
    Buffer.MoveToF(Cx-2, R.Top);
    Buffer.LineToFSP(Cx-2 , R.Bottom);

    Buffer.StippleCounter := 0;
    Buffer.MoveToF(Cx-1, R.Top);
    Buffer.LineToFSP(Cx-1 , R.Bottom);

    Buffer.StippleCounter := 0;
    Buffer.MoveToF(Cx, R.Top);
    Buffer.LineToFSP(Cx , R.Bottom);

    Buffer.StippleCounter := 0;
    Buffer.MoveToF(Cx+1, R.Top);
    Buffer.LineToFSP(Cx+1 , R.Bottom);

    Buffer.StippleCounter := 0;
    Buffer.MoveToF(Cx+2, R.Top);
    Buffer.LineToFSP(Cx+2 , R.Bottom);
  end;
end;

结果应该是图片上的样子:

调整图层大小时有时出现 "blurred" 线的原因是您在绘制线时对浮点值进行操作。您需要使用整数值。我猜想在某些情况下,当您的线条仅填充该像素的一部分时,绘图引擎决定绘制一个模糊像素。

希望这对您有所帮助。