如何在delphi中创建自定义绘制线
如何在delphi中创建自定义绘制线
提问于 2022-06-10 12:20:08
我想在我的delphi应用程序的画布上画一条线，但需要它是一条*，我怎么才能用* char而不是破折号或点创建一个自定义线。
回答 4
Stack Overflow用户
发布于 2022-06-11 18:28:56
您可以使用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;结果：
这个解决方案不仅限于星号和行。使用“@”和圆圈查看结果：
Stack Overflow用户
发布于 2022-06-10 14:06:12
一条线有一个形式为：Y = A * X + B的方程
A是坡度，B是原点的偏移量。
如果您想从(X1, Y1)点到(X2, Y2)点画一条线，您必须首先确定方程的A和B常数：
A = (Y2 - Y1) / (X2 - X1)获得A后，计算B为：
B = Y1 - A * X1现在有了A和B，您可以使用它来计算X1和X2之间的中间点。一个简单的循环就行了。将X增量为希望将*分隔开的值。
注意:如果Y2 - Y1大于X2 - X1，则必须迭代Y而不是X。
作为一个节选，我让你写代码..。
Stack Overflow用户
发布于 2022-06-11 11:54:24
我会使用这条线的参数表示，参数表示到目前为止绘制的直线长度。这种方法可以画出垂直线，并且可以实现星体以相同的距离绘制，而不依赖于直线的斜率。
更精确地说:要画一条从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;页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/72574213
复制相关文章
相似问题
腾讯云开发者
