delphi Image32 路径

用 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.

看看效果：

欢迎微信搜一搜 IT软件部落 关注公众号，你可以了解更详细的内容

欢儿微信扫码关注 IT软件部落 公众号，你可以了解更详细的内容