如何在delphi中创建自定义绘制线

Question

我想在我的 delphi 应用程序中的画布上画一条线，但需要它是一条 ****** 如何使用 * char 而不是破折号或点创建自定义线。

Answer 1

You can use the Skia4Delphi library for a generic solution to the problem. Below is an example using the TSkPaintBox control and the TSkPaintBox.OnDraw event:

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;

Result:

This solution is not restricted to just asterisks and lines. See the result using the '@' and a circle:

Answer 2

A line has an equation having the form: Y = A * X + B

A is the slope and B the offset at the origin.

If you want to draw a line from point (X1, Y1) to point (X2, Y2) , you have first to determine the A and B constants of the equation:

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

Once you have A, compute B as :

B = Y1 - A * X1

Now you have A and B , you can use it to compute the intermediate points between X1 and X2 . A simple loop will do. Increment X by the value you want to have you * separated.

Note: If Y2 - Y1 is greater than X2 - X1 , you must iterate Y instead of X .

As an excercise, I let you write the code...

Answer 3

I would use a parametric representation of the line, parameter being the line length so far drawn. This way one can draw vertical lines, and can achieve that the stars are drawn with the same distance, independent of the slope of the line.

To be more precise: To draw a line from point A to point B, compute the length of the line L, then the unit vector Dir of the direction of the line. The formula for a point P on the line is then P = A + t*Dir, where t runs from 0 to L. (This is pseudo-code to be read as vector notation.)

Here is a simple routine which does this.

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;

Answer 4

Computer scientist Jack Bresenham devised an algorithm to draw straight lines fast on an integer grid. The algorithm only uses integer variables and doesn't require division or multiplication.
You could write the asterisk directly in the Bresenham code, but it's much neater to use a callback procedure: you call the Bresenham procedure with the callback function as extra parameter. Every time the algorithm has calculated a point on the line it calls the callback procedure, passing the X and Y coordinates.
The big advantage is that you could write a generic Bresenham procedure and only write a different action in the callback, depending on whether you want to draw a dot, or an asterisk.
It goes like this.
You define a callback procedure type:

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

Write out the callback procedure's action. Here I draw a pixel. You change this line to draw an asterisk:

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

And then the Bresenham procedure itself. Recall that the procedure finds all points on the line, but doesn't know what to do with them, so it passes them to the callback procedure:

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;

Usage:

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;