如何在 Delphi 中创建自定义绘图线

jhiyze9q  于 2022-11-23  发布在  其他
关注(0)|答案(4)|浏览(323)

我想在我的 Delphi 应用程序中在画布上画一条线,但需要一条******的线。我如何创建一条带有 * 字符而不是虚线或圆点的自定义线?

gupuwyp2

gupuwyp21#

您可以使用Skia4Delphi程式库来解决这个问题。下面是使用TSkPaintBox控件和TSkPaintBox.OnDraw事件的范例:

uses
  System.Math.Vectors, FMX.TextLayout, Skia, Skia.FMX;

procedure TForm1.SkPaintBox1Draw(ASender: TObject; const ACanvas: ISkCanvas;
  const ADest: TRectF; const AOpacity: Single);

  function GetTextPath(const AText: string): ISkPath;
  var
    LTextLayout: TTextLayout;
    LPathData: TPathData;
  begin
    LTextLayout := TTextLayoutManager.DefaultTextLayout.Create;
    try
      LTextLayout.BeginUpdate;
      try
        LTextLayout.Font.Size := 30;
        LTextLayout.Font.Style := [TFontStyle.fsBold];
        LTextLayout.Text := AText;
      finally
        LTextLayout.EndUpdate;
      end;
      LPathData := TPathData.Create;
      try
        LTextLayout.ConvertToPath(LPathData);
        Result := LPathData.ToSkPath;
      finally
        LPathData.Free;
      end;
    finally
      LTextLayout.Free;
    end;
  end;

var
  LPaint: ISkPaint;
  LTextPath: ISkPath;
  LPathBuilder: ISkPathBuilder;
begin
  LTextPath := GetTextPath('*');
  LPaint := TSkPaint.Create(TSkPaintStyle.Stroke);
  LPaint.AntiAlias := True;
  LPaint.Color := TAlphaColors.Black;
  LPaint.PathEffect := TSkPathEffect.Make1DPath(LTextPath, LTextPath.Bounds.Width + 2, 0, TSkPathEffect1DStyle.Rotate);
  LPathBuilder := TSkPathBuilder.Create;
  LPathBuilder.MoveTo(PointF(50, 100));
  LPathBuilder.LineTo(PointF(400, 290));
  ACanvas.DrawPath(LPathBuilder.Detach, LPaint);
end;

结果:

此解决方案并不局限于使用星号和线条。请使用“@”和圆圈查看结果:

slmsl1lt

slmsl1lt2#

一条直线的方程式如下:Y = A * X + B
A是斜率,B是原点处的偏移。
如果要从点(X1, Y1)到点(X2, Y2)画一条线,首先必须确定方程中的AB常数:

A = (Y2 - Y1) / (X2 - X1)

得到A后,计算B为:

B = Y1 - A * X1

现在你有了AB,你可以用它来计算X1X2之间的中间点。一个简单的循环就可以了。把X增加你想让*分开的值。
注意:如果Y2 - Y1大于X2 - X1,则必须迭代Y而不是X
作为练习,我让你写代码...

ev7lccsx

ev7lccsx3#

我将使用一个参数化的线表示,参数是到目前为止所画的线的长度。这样可以画垂直线,并可以实现以相同的距离画星星,而与线的斜率无关。
更确切地说:要画一条从A点到B点的直线,计算直线的长度L,然后计算直线方向的单位向量Dir。直线上的点P的公式为P = A + t*Dir,其中t从0到L。(这是一个伪代码,可作为向量表示法读取。)
下面是一个简单的例程。

procedure DrawStarAt(P: TPointF; Radius: Single; aCanvas: TCanvas);
begin
  var
  r := RectF(P.X - Radius, P.Y - Radius, P.X + Radius, P.Y + Radius);
  aCanvas.FillText(r, '*', false, 1, [], TTextAlign.Center, TTextAlign.Center);
end;

procedure DrawStarLine(A, B: TPointF; aCanvas: TCanvas);
var
  // line length
  L,
  // line parameter
  t,
  // step for t
  dt,
  // Radius of the text rectangle
  Radius: Single;

  // Point to be drawn
  P,
  // unit vector for line direction
  Direction: TPointF;
  n: integer;
begin
  aCanvas.BeginScene;
  aCanvas.Fill.Color := TAlphaColorRec.Black;
  Radius := aCanvas.TextWidth('*');
  L := sqrt(sqr(B.X - A.X) + sqr(B.Y - A.Y));
  n:=trunc(L/Radius);
  //adjust dt so the last star is drawn exactly at B
  dt:=L/n;
  if L = 0 then
  begin
    DrawStarAt(A, Radius, aCanvas);
    aCanvas.EndScene;
    exit;
  end;
  Direction := PointF((B.X - A.X) / L, (B.Y - A.Y) / L);
  t := 0;
  while t < L do
  begin
    P := PointF(A.X + t * Direction.X, A.Y + t * Direction.Y);
    DrawStarAt(P, Radius, aCanvas);
    t := t + dt;
  end;
  DrawStarAt(B, Radius, aCanvas);
  aCanvas.EndScene;
end;
bxpogfeg

bxpogfeg4#

计算机科学家杰克·布雷森汉姆设计了一种算法,可以在整数网格上快速绘制直线。该算法只使用整数变量,不需要除法或乘法。
您可以直接在Bresenham代码中编写星号,但使用回调过程会更简洁:调用Bresenham过程,并将回调函数作为额外参数。2每次算法计算出直线上的一个点时,它都会调用回调过程,传递X和Y坐标。
最大的优点是,您可以编写一个通用的Bresenham过程,而只在回调中编写一个不同的操作,这取决于您要绘制一个点还是一个星号。
是这样的
定义回调过程类型:

type
  TCallbackProc = procedure(X, Y: Integer) of Object;

写出回调过程的操作。这里我画了一个像素。你把这行改成画一个星号:

procedure TForm1.DrawPixel(X, Y: Integer);
begin
  Image1.Canvas.Pixels[X, Y] := clBlack;
end;

然后是Bresenham过程本身。回想一下,该过程找到了直线上的所有点,但不知道如何处理它们,所以它将它们传递给回调过程:

procedure TForm1.Bresenham(X1, Y1, X2, Y2: Integer; CallbackProc: TCallBackProc);
var
  Dx, Dy, Sx, Sy, Error, E2: Integer;
  Done: Boolean;
begin
  Dx := Abs(X2 - X1);
  if X1 < X2 then
    Sx := 1
  else
    Sx := -1;
  Dy := -Abs(Y2 - Y1);
  if Y1 < Y2 then
    Sy := 1
  else
    Sy := -1;
  Error := Dx + Dy;

  while True do
  begin
    if Assigned(CallbackProc) then
      CallbackProc(X1, Y1);
    if (X1 = X2) and (Y1 = Y2) then
      Exit;
    E2 := 2 * Error;
    if E2 >= Dy then
    begin
      if X1 = X2 then
      Exit;
      Error := Error + Dy;
      X1 := X1 + Sx;
    end;
    if E2 <= Dx then
    begin
      if Y1 = Y2 then
        Exit;
      Error := Error + Dx;
      Y1 := Y1 + Sy;
    end;
  end;
end;

用法:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Bresenham(100, 50, 250, 350, DrawPixel);
  Bresenham(100, 50, 250, 350, DrawDaisies);
  Bresenham(100, 50, 250, 350, DrawSquirrels);
end;

相关问题