VCL如果要支持SVG,只有 Image32好点,SVGIconImageList 第三方库也使用 Image32.
unit uFrmPaths;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, //
System.Types, System.Math, Img32, Img32.Panels, Img32.Vector, Img32.Extra,
Img32.Fmt.PNG, Img32.Draw, Img32.Text, Vcl.ComCtrls;
type
TfrmPaths = class(TForm)
TabControl1: TTabControl;
procedure FormCreate(Sender: TObject);
procedure TabControl1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
private
arial12: TFontCache;
arial16: TFontCache;
ImagePanel: TImage32Panel;
procedure ImagePanelClick(Sender: TObject);
procedure DoClosedPaths1;
procedure DoClosedPaths2;
procedure DoOpenPaths;
end;
var
frmPaths: TfrmPaths;
implementation
{$R *.dfm}
procedure TfrmPaths.DoClosedPaths1;
var
margin, adjustX: integer;
path, smoothedPath: TPathD;
srcRec, spRec, dstRec: TRect;
Scale, dx, dy: double;
str: UnicodeString;
begin
margin := DPIAware(20);
path := MakePath([190, 120, 240, 160, 560, 120, 190, 490]); // Img32.Vector 数组
// get the bounds of the smoothpath with the largest bounds
smoothedPath := SmoothPath(path, true, -1); // 路径点,是否闭合,张力 Img32.Extra
spRec := GetBounds(smoothedPath); // Img32.Vector
// get dstRec
dstRec := ImagePanel.InnerClientRect; // 绑定区域
System.Types.InflateRect(dstRec, -margin, -margin); // 缩小区域
dstRec.Width := dstRec.Width div 3 - margin; // 1/3 宽度,后面要显示3组图形
inc(dstRec.Top, DPIAware(20)); // making sure there's room for text
dec(dstRec.Bottom, DPIAware(20)); // making sure there's room for text
adjustX := dstRec.Width + margin;
// 绘制文本
str := 'SmoothPath function - using different tensions(不同张力)'; // 这里的 中文 如果不能正常显示,是因为字体问题,请参考:FormCreate中描述
DrawText(ImagePanel.Image, dstRec.Left, dstRec.Top - DPIAware(20), str, arial16);
Scale := Min(dstRec.Width / spRec.Width, dstRec.Height / spRec.Height); // 最小比例
path := ScalePath(path, Scale); // 根据比例缩放路径
dx := dstRec.Left - spRec.Left * Scale;
dy := dstRec.Top - spRec.Top * Scale;
path := TranslatePath(path, dx, dy); // 平移路径
srcRec := GetBounds(path);
smoothedPath := SmoothPath(path, true, 0); // tensions :0
// 第1组图形绘制
DrawLine(ImagePanel.Image, path, DPIAware(1), clRed32, esClosed); // 绘制封闭的红线
DrawLine(ImagePanel.Image, smoothedPath, DPIAware(2), clBlue32, esClosed); // 绘制封闭的蓝线
DrawText(ImagePanel.Image, srcRec.Left, srcRec.Bottom + DPIAware(20), '0', arial16); // 绘制文字
// ====
path := TranslatePath(path, adjustX, 0); // 平移路径
TranslateRect(srcRec, adjustX, 0); // 平均区域
smoothedPath := SmoothPath(path, true, -1); // tensions :-1
// 第2组图形绘制
DrawLine(ImagePanel.Image, path, DPIAware(1), clRed32, esClosed); // 绘制封闭的红线
DrawLine(ImagePanel.Image, smoothedPath, DPIAware(2), clBlue32, esClosed); // 绘制封闭的蓝线
DrawText(ImagePanel.Image, srcRec.Left, srcRec.Bottom + DPIAware(20), '-1', arial16); // 绘制文字
//
path := TranslatePath(path, adjustX, 0);
TranslateRect(srcRec, adjustX, 0);
smoothedPath := SmoothPath(path, true, 0.5); // tensions :0.5
// 第2组图形绘制
DrawLine(ImagePanel.Image, path, DPIAware(1), clRed32, esClosed); // 绘制封闭的红线
DrawLine(ImagePanel.Image, smoothedPath, DPIAware(2), clBlue32, esClosed); // 绘制封闭的蓝线
DrawText(ImagePanel.Image, srcRec.Left, srcRec.Bottom + DPIAware(20), '0.5', arial16); // 绘制文字
end;
procedure TfrmPaths.DoClosedPaths2;
var
i, j, maxX, maxY: integer;
path, smoothedPath: TPathD;
dstRec, srcRec: TRect;
scaleX, scaleY: double;
const
margin = 50;
ptCount = 3;
begin
SetLength(path, ptCount); // 3个点
dstRec := ImagePanel.InnerClientRect; // 客户区域
System.Types.InflateRect(dstRec, -margin, -margin); // 缩小 margin
maxX := dstRec.Width;
maxY := dstRec.Height;
for i := 0 to ptCount - 1 do
path := PointD(Random(maxX), Random(maxY)); // 随机产生3个点
smoothedPath := SmoothPath(path, true, -0.5); // 路径点,是否闭合,张力 Img32.Extra
srcRec := GetBounds(smoothedPath); // Img32.Vector
scaleX := maxX / srcRec.Width;
scaleY := maxY / srcRec.Height;
path := ScalePath(path, scaleX, scaleY); // 根据比例缩放路径
// repeat smoothing now that the path has been properly scaled
smoothedPath := SmoothPath(path, true, -0.5);
srcRec := GetBounds(smoothedPath);
path := TranslatePath(path, margin - srcRec.Left, margin - srcRec.Top); // 路径平移
smoothedPath := TranslatePath(smoothedPath, margin - srcRec.Left, margin - srcRec.Top);
DrawLine(ImagePanel.Image, smoothedPath, DPIAware(2.5), clGreen32, esPolygon); // 绘制平滑的闭合路径线
for j := 0 to High(path) do
begin
DrawPoint(ImagePanel.Image, path[j], DPIAware(3.5), clRed32); // 绘制点
DrawText(ImagePanel.Image, path[j].X - 50, path[j].Y + 0, Format('[%f,%f]', [path[j].X, path[j].Y]), arial16); // 绘制文字
end;
DrawText(ImagePanel.Image, 30, 30, '点击后重新生成', arial16); // 绘制文字
end;
procedure TfrmPaths.DoOpenPaths;
var
i, j, dx: integer;
paths, smoothedPaths: TPathsD;
rec: TRect;
const
margin = 50;
ptCount = 8;
pathCount = 3;
begin
rec := ImagePanel.InnerClientRect; // 客户区域
System.Types.InflateRect(rec, -margin, -margin); // 缩小 margin
dx := rec.Width div (ptCount); // 点间距
SetLength(paths, pathCount); // 3个路径
SetLength(smoothedPaths, pathCount); // 3个平滑路径
for i := 0 to High(paths) do
begin
SetLength(paths, ptCount); // 每条路径 N 个点
for j := 0 to High(paths) do
paths[j] := PointD(rec.Left + j * dx, rec.Bottom - Random(rec.Height)); // 每个点 随机值
end;
for i := 0 to High(smoothedPaths) do
smoothedPaths := SmoothPath(paths, false, 0); // 生成每条路径的平滑路径
for i := 0 to High(smoothedPaths) do
begin
DrawLine(ImagePanel.Image, smoothedPaths, DPIAware(3), RainbowColor(i / pathCount), esSquare); // 绘制平滑路径 (非闭合)
for j := 0 to High(paths) do
DrawPoint(ImagePanel.Image, paths[j], DPIAware(2.5), clRed32); // 绘制点
end;
DrawText(ImagePanel.Image, 30, 30, '点击后重新生成', arial16); // 绘制文字
end;
procedure TfrmPaths.FormCreate(Sender: TObject);
const
// C_FontName='Arial'; //这个显示不了汉字
// C_FontName='Arial Unicode MS';//名称 可以从 office Word字体下拉框查找(可以显示汉字) [控制面板\所有控制面板项\字体]
C_FontName = '方正舒体'; // 默认找不到字体(需要修改 TFontReader.Load 中 CreateFontIndirect )
var
arialFont: TFontReader;
begin
self.BorderStyle := bsNone;
// Img32.Text中 TFontReader.Load 中 CreateFontIndirect 默认 logFont.lfCharSet:ANSI_CHARSET,很多中文字体是找不到的)
// 因此,要将 logFont.lfCharSet= GB2312_CHARSET 即可找到中文字体 (如:方正舒体)
FontManager.Load(C_FontName, 800);
arialFont := FontManager.GetFont(C_FontName);
arial12 := TFontCache.Create(arialFont, DPIAware(12));
arial16 := TFontCache.Create(arialFont, DPIAware(16));
ImagePanel := TImage32Panel.Create(self);
ImagePanel.Parent := TabControl1;
ImagePanel.Align := alClient;
ImagePanel.OnClick := ImagePanelClick;
ActiveControl := ImagePanel;
ImagePanel.BorderWidth := 0; // 默认有14的边框.
with ImagePanel.InnerClientRect do
ImagePanel.Image.SetSize(Width, Height);
TabControl1Change(nil);
end;
procedure TfrmPaths.FormDestroy(Sender: TObject);
begin
arial12.Free;
arial16.Free;
end;
procedure TfrmPaths.FormResize(Sender: TObject);
begin
if Assigned(ImagePanel) then
begin
with ImagePanel.InnerClientRect do
ImagePanel.Image.SetSize(Width, Height);
TabControl1Change(nil);
end;
end;
procedure TfrmPaths.ImagePanelClick(Sender: TObject);
begin
if TabControl1.TabIndex <> 0 then
TabControl1Change(nil);
end;
procedure TfrmPaths.TabControl1Change(Sender: TObject);
begin
ImagePanel.Scale := 1.0;
ImagePanel.Image.Clear;
case TabControl1.TabIndex of
0:
DoClosedPaths1;
1:
DoClosedPaths2;
else
DoOpenPaths;
end;
end;
end.