用 Image32的理由之一,也是路径这块做得比delphi(FMX)自带的要好,skia中支持svg,但对路径处理功能不够强大。VCL只能使用第三方库。
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[i] := 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[i], ptCount); // 每条路径 N 个点 for j := 0 to High(paths[i]) do paths[i][j] := PointD(rec.Left + j * dx, rec.Bottom - Random(rec.Height)); // 每个点 随机值 end; for i := 0 to High(smoothedPaths) do smoothedPaths[i] := SmoothPath(paths[i], false, 0); // 生成每条路径的平滑路径 for i := 0 to High(smoothedPaths) do begin DrawLine(ImagePanel.Image, smoothedPaths[i], DPIAware(3), RainbowColor(i / pathCount), esSquare); // 绘制平滑路径 (非闭合) for j := 0 to High(paths[i]) do DrawPoint(ImagePanel.Image, paths[i][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.
看看效果: