delphi Image32 路径

前沿观查点 發表於 2024-6-13 20:58:00

用 Image32的理由之一，也是路径这块做得比delphi（FMX）自带的要好，skia中支持svg,但对路径处理功能不够强大。VCL只能使用第三方库。
VCL如果要支持SVG，只有 Image32好点，SVGIconImageList 第三方库也使用 Image32.
 
 
<div class="cnblogs_code">
<pre>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, DPIAware(3.5), clRed32); // 绘制点
DrawText(ImagePanel.Image, path.X - 50, path.Y + 0, Format('[%f,%f]', .X, path.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 := 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, 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.</pre>
</div>
看看效果：
<img src="https://img2024.cnblogs.com/blog/1103754/202406/1103754-20240613205526687-1683081046.gif">
欢迎微信搜一搜 IT软件部落 关注公众号，你可以了解更详细的内容 
<img src="https://img2024.cnblogs.com/blog/1103754/202410/1103754-20241027211531941-862695125.jpg">
欢儿微信扫码关注 IT软件部落 公众号，你可以了解更详细的内容
<img alt="" class="medium-zoom-image lazyload" data-src="https://img2024.cnblogs.com/blog/1103754/202410/1103754-20241027211540319-394205364.jpg">
  
来源：https://www.cnblogs.com/bluejade/p/18246759

頁: [1]

琼殿技术论坛's Archiver

delphi Image32 路径