如何在delphi中創建自定義繪制線

我想在我的 delphi 應用程式中的畫布上畫一條線，但需要它是一條 ****** 如何使用 * char 而不是破折號或點創建自定義線。

uj5u.com熱心網友回復：

您可以使用

此解決方案不僅限于星號和線條。使用“@”和一個圓圈查看結果：

uj5u.com熱心網友回復：

一條線有一個方程，其形式為：Y = A * X B

AB是原點的斜率和偏移量。

如果你想畫一條從點到點的線(X1, Y1)，(X2, Y2)你首先要確定方程的A和B常數：

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

有了 A 后，將 B 計算為：

B = Y1 - A * X1

現在你有了A和，你可以用它來計算和B之間的中間點。一個簡單的回圈就可以了。增加你想讓你分開的值。X1X2X*

注意：如果Y2 - Y1大于X2 - X1，則必須迭代Y而不是X。

作為練習，我讓你撰寫代碼......

uj5u.com熱心網友回復：

我將使用線條的引數表示，引數是到目前為止繪制的線條長度。這樣就可以畫出垂直線，并且可以實作星星的繪制等距，與線的斜率無關。

更準確地說：要從 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;

uj5u.com熱心網友回復：

計算機科學家 Jack Bresenham 設計了一種演算法，可以在整數網格上快速繪制直線。該演算法僅使用整數變數，不需要除法或乘法。
您可以直接在 Bresenham 代碼中撰寫星號，但使用回呼程序要簡潔得多：您可以使用回呼函式作為額外引數呼叫 Bresenham 程序。每次演算法計算出線上的一個點時，它都會呼叫回呼程序，傳遞 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;

標籤：德尔福 火猴 帕斯卡

上一篇：通過RTTI訪問TList類

下一篇：如何在Delphi中決議JSON？