我想在我的 delphi 应用程序中的画布上画一条线,但需要它是一条 ****** 如何使用 * char 而不是破折号或点创建自定义线。
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:
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...
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;
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;
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.