PNG图标是个好东西，现在系统都支持而且工具软件都能很方便生成(包括PS)，要比做Icon方便很多。因此理所当然的现在项目图标PNG已经霸占了ICON的霸主地位。
项目功能比较多的时候，就会有无数的图标资源。现做的项目功能图标单16x16规格已经有200个之多～～，一个功能一个PNG图标，散落在目录中(俺们的美工喜欢做PNG图标，不太喜欢做icon)。虽然有RC资源管理着，但程序第一次加载大量功能图标时，明显会感觉有些卡的感觉。实际性能测试中也确实反映出这个情况，加载功能图标耗时严重。
第一种：直接加入RC资源
一般处理功能图标的方法，把图标分组编号。如16x16规格的功能图标分成ACTION16的类型图标组，加载时枚举所有的Action16类型组资源名称，读入ImageList中。
处理过程：
1、枚举组资源名
2、加载PNG资源 x N次
3、转换成BMP带Alpha通道 x N次
4、装入ImageList x N次
1 ; 功能图标 16x16 2 ; ------------------------ 3 ICON01 ACTION16 .\16\NewFile.png 4 ICON02 ACTION16 .\16\SaveFile.png 5 ... ... 6 ICONxx ACTION16 .\16\xx.png
这种方式在资源比较少的时候没什么大问题，但资源一多时损失的效率就显现出来。
第二种：把一组资源拼接成单个文件
这种方式的好处显而易见，不需要枚举名称，只有一次读资源的过程，读出来的图标直接装入ImageList，由ImageList自动切割成16规格的图标。这效率是杠杠的～。
不过这种方式还是有个制作问题。这么多资源图标通常不是一次全部完成的，除了些基本的，其他的都是有了功能才有图标。功能图标样式修改，都要重新拼接。这个人力成本很大，再说了让俺们的美工MM做这事于心不忍啊。
解决方案
介于上面这两种情况，第一种效率慢、第二种费时费力。为解决问题本人又比较懒，所以想方法就是做个预处理。结合第一种RC管理的方法是用程序自动拼接，生成单个图标组资源文件。
如上面的16x16图标的RC内容独立出来一个配置文件(icons16.lst)，维护图标的资源索引（程序内部有常量对应）。
1 ; icons16.lst 2 ; 3 ; 功能图标 16x16 4 ; ------------------------ 5 .\16\NewFile.png 6 .\16\SaveFile.png 7 ... ... 8 .\16\xx.png
然后通过程序读取这个列表，合并图标资源并产生相应的常量定义代码。这事太美了，一箭双雕！哈～哈～哈～哈～～～
解决：资源加载慢，人工合并费时费力还不用手工维护代码常量表。
处理方案过程
1、读取定义列表
2、根据图标数量生成合并后的资源图标尺寸
3、依次读入，绘制到相应偏移位置。
4、压缩合并的资源图片并保存
OK～ 完成
1 procedure TMergeSrv.Exec; 2 var 3 cConvert: TConvertRes; 4 begin 5 if FDataFile.ReadFileName then 6 begin 7 case FDataFile.Kind of 8 dtIconMerge : cConvert := TMergeIcons.Create(FDataFile); 9 dtPngPack : cConvert := TPngPack.Create(FDataFile); 10 else cConvert := nil; 11 end; 12 13 if cConvert <> nil then 14 begin 15 try 16 if cConvert.Exec(PrintMsg) then 17 if SaveResMap(cConvert.FIconMap) then 18 PrintMsg(format(‘Finish: %s‘,[ChangeFileExt(FDataFile.OutFileName, ‘.IconPack‘)])); 19 finally 20 cConvert.Free; 21 end; 22 end 23 else 24 PrintMsg(‘Err: ‘ + MSG_NONAMES); 25 end 26 else 27 PrintHelp; 28 end;
执行合并资源图标过程
1、读取参数定义列表
使用那个图标组索引定义，输出到哪里。主要有一个2个比较细节的地方。第一个：输出路径需要转换成完整路径（如： .\action16.pack）。第二个资源定义文件位置需要设成当前路径。这两个处理主要是为了简化PNG图标文件的读取。
1 function TParams.ReadFileName: Boolean; 2 var 3 sFileName: string; 4 sPath: string; 5 begin 6 Result := False; 7 FileName := ‘‘; 8 9 // 从参数读取资源图标维护列表 10 sFileName := ChangeFileExt(ParamStr(0), ‘.lst‘); 11 if ParamCount >= 1 then 12 sFileName := Trim(ParamStr(1)); 13 if FileExists(sFileName) then 14 FileName := sFileName; 15 16 // 从第二个参数中读取需要输出的资源包名称 17 // 情景：1、没有第二个参数，默认使用配置文件名 18 // 2、第二个参数是个路径，作为输出路径，文件名同配置名。 19 // 3、有明确输出文件名，直接使用。 20 OutFileName := ChangeFileExt(FileName, ‘.bmp‘); 21 if ParamCount >= 2 then 22 begin 23 sFileName := Trim(ParamStr(2)); 24 if (sFileName <> ‘‘) then 25 begin 26 if (sFileName[Length(sFileName)] = ‘\‘) then 27 OutFileName := Format(‘%s%s‘,[sFileName, ExtractFileName(OutFileName)]) 28 else 29 begin 30 OutFileName := sFileName; 31 if not DirectoryExists(ExtractFilePath(sFileName)) then 32 if not CreateDir(ExtractFilePath(sFileName)) then 33 OutFileName := ‘‘; 34 end; 35 end; 36 end; 37 38 // 把输出文件变成完整路径，为简化后续PNG资源的加载 39 if OutFileName <> ‘‘ then 40 OutFileName := ExpandFileName(OutFileName); 41 42 /// 设置当前处理目录，为简化后续图标资源的加载 43 if FileName <> ‘‘ then 44 begin 45 sPath := ExtractFilePath(FileName); 46 SetCurrentDir(sPath); 47 FileName := ExtractFileName(FileName); 48 end; 49 50 // 51 if SameText(ExtractFileExt(FileName), ‘.lst‘) then 52 Kind := dtIconMerge 53 else 54 Kind := dtPngPack; 55 56 Result := (FileName <> ‘‘) and (OutFileName <> ‘‘); 57 end;
读入参数设置的配置文件
1 function TMergeIcons.LoadImageNames: Boolean; 2 var 3 I: Integer; 4 sVal: string; 5 begin 6 // 读取配置文件 7 // 清除空白行和注释行 8 FFiles := TStringList.Create; 9 FFiles.LoadFromFile(SourceFile); 10 for I := FFiles.Count - 1 downto 0 do 11 begin 12 sVal := Trim(FFiles[i]); 13 if (sVal = ‘‘) or (sVal[1] = ‘;‘) or (sVal[1] = ‘/‘) then 14 FFiles.Delete(i) 15 else 16 FFiles[i] := sVal; 17 end; 18 19 Result := FFiles.Count > 0; 20 end;
2、生成拼接图片的规格
1 procedure TMergeIcons.BuildResMap; 2 var 3 bExists: Boolean; 4 I: Integer; 5 begin 6 // 预读图标文件尺寸 7 FIcon := TPngImage.Create; 8 bExists := False; 9 for I := 0 to Count - 1 do 10 begin 11 bExists := LoadIcon(0); 12 if bExists then 13 Break; 14 end; 15 16 if not bExists then 17 Exit; 18 19 // 设置图标拼接行列数 20 FColCnt := 10; 21 FRowCnt := Count div FColCnt; 22 if Count mod FColCnt > 0 then 23 inc(FRowCnt); 24 25 FWidth := FIcon.Width; 26 FHeight:= FIcon.Height; 27 28 BuildMap(FWidth * FColCnt, FHeight * FRowCnt); 29 end;
1 procedure TConvertRes.BuildMap(w, h:Integer); 2 begin 3 FIconMap := TBitmap.Create; 4 FIconMap.PixelFormat := pf32bit; 5 FIconMap.alphaFormat := afIgnored; 6 FIconMap.SetSize(w, h); 7 // Alpha 透明化 8 FIconMap.Canvas.Brush.Color := clBlack; 9 FIconMap.Canvas.FillRect(Rect(0, 0, FIconMap.Width, FIconMap.Height)); 10 end;
生成带有Alpha通道的透明Bitmap
3、并入资源图标
1 for I := 0 to Count - 1 do 2 begin 3 if LoadIcon(i) then 4 begin 5 MergeIcon(i); 6 PrintMsg(format(‘ok：并入资源（%d）%s‘, [i, FileNames[i]])); 7 end 8 else 9 PrintMsg(format(‘Err: 无法加载 (%d)%s 文件‘, [i, FileNames[i]])); 10 end;
1 function TMergeIcons.LoadIcon(AIndex: Integer): Boolean; 2 begin 3 try 4 Result := False; 5 if FileExists(FileNames[AIndex]) then 6 begin 7 FIcon.LoadFromFile(FileNames[AIndex]); 8 Result := not FIcon.Empty; 9 end; 10 except 11 Result := False; 12 end; 13 end;
fun LoadIcon
1 function TMergeIcons.MergeIcon(AIndex: Integer): Boolean; 2 var 3 iCol: Integer; 4 iRow: Integer; 5 begin 6 Result := True; 7 // 按照索引进行偏移并入 8 iRow := AIndex div FColCnt; 9 iCol := AIndex mod FColCnt; 10 FIconMap.Canvas.Draw(FWidth * iCol, FHeight * iRow, FIcon); 11 end;
fun MergeIcon 根据索引进行偏移并入
4、压缩资源并输出
1 function TMergeSrv.SaveResMap(ASource: TBitmap): Boolean; 2 var 3 cData: TMemoryStream; 4 cPack: TZCompressionStream; 5 begin 6 Result := False; 7 if ASource = nil then 8 Exit; 9 if not DirectoryExists(ExtractFilePath(FDataFile.OutFileName)) then 10 if not CreateDir(ExtractFilePath(FDataFile.OutFileName)) then 11 Exit; 12 13 // 把资源压缩到内存流中 14 cData := TMemoryStream.Create; 15 try 16 // 生成一份对照Bitmap文件，用户检测合并文件是否有问题。 17 ASource.SaveToStream(cData); 18 cData.SaveToFile(FDataFile.OutFileName); 19 cData.Clear; 20 21 // 生成资源使用的压缩包文件 22 cPack := TZCompressionStream.Create(clMax, cData); 23 try 24 ASource.SaveToStream(cPack); 25 finally 26 cPack.free; 27 end; 28 cData.SaveToFile(ChangeFileExt(FDataFile.OutFileName, ‘.IconPack‘)); 29 30 finally 31 cData.Free; 32 end; 33 Result := True; 34 end;
最终产生的效果
下面是个测试目录，16文件夹是存放所有16x16规格的图标。Icons16.ist文件用于维护功能图标组文件。
执行完处理产生的合并文件
完成的目标文件
最终资源文件会产生一个具有Alpha通道的Bitmap文件，Alpha通道就是一个Mark文件。程序中产生同Icon相应的透明效果。
加载资源时不需要任何处理，直接加入到ImageList。完美解决主程序的加载资源消耗时间过长问题。
还种更懒的方法，列表配置文件都不需要，直接读取目录内所有文件进行拼接。这种方式只要在开发时约定图标资源的使用方式就没问题。如按照 前缀_<文件名> 方式引用。不管代码还是外部配置，代码就是定义的常量，外部配置就是个字符串，加载时转换到常量定义值。这样内部资源顺序不管怎么变都使用都不会受影响。
开发环境
XE3
Win7
完整单元代码
1 program MergeRes;
2
3
4 {$APPTYPE CONSOLE}
5
6 {$R *.res}
7
8 uses
9 Winapi.Windows,
10 Classes,
11 Vcl.Graphics,
12 System.SysUtils,
13 Vcl.Imaging.pngimage,
14 ZLib;
15
16 const
17 MSG_NONAMES = ‘没有资源图标文件名称列表‘;
18
19 type
20 TPrintProc = procedure (const AVal: string) of object;
21
22 TDataType = (dtIconMerge, dtPngPack);
23
24 TParams = class
25 private
26 FileName: string;
27 OutFileName: string;
28 Kind: TDataType;
29
30 function ReadFileName: Boolean;
31 end;
32
33 TConvertRes = class
34 private
35 FParams: TParams;
36 FIconMap: TBitmap;
37 function GetSourceFile: string;
38 procedure BuildMap(w, h:Integer);
39 public
40 destructor Destroy; override;
41 constructor Create(AFiles: TParams); virtual;
42
43 function Exec(PrintMsg: TPrintProc): Boolean; virtual; abstract;
44
45 property SourceFile: string read GetSourceFile;
46 property ResMap: TBitmap read FIconMap;
47 end;
48
49 TPngPack = class(TConvertRes)
50 public
51 function Exec(PrintMsg: TPrintProc): Boolean; override;
52 end;
53
54 TMergeIcons = class(TConvertRes)
55 private
56 FIcon: TPngImage;
57 FRowCnt: Integer;
58 FColCnt: Integer;
59 FFiles: TStringList;
60 FWidth: integer;
61 FHeight: integer;
62
63 procedure BuildResMap;
64 function GetCount: Integer;
65 function GetFileNames(Index: Integer): string;
66 function LoadIcon(AIndex: Integer): Boolean;
67 function LoadImageNames: Boolean;
68 function MergeIcon(AIndex: Integer): Boolean;
69 public
70 destructor Destroy; override;
71 property Count: Integer read GetCount;
72 property FileNames[Index: Integer]: string read GetFileNames;
73
74 function Exec(PrintMsg: TPrintProc): Boolean; override;
75 end;
76
77 TMergeSrv = class
78 private
79 FDataFile: TParams;
80 procedure PrintHelp;
81 procedure PrintMsg(const AVal: string);
82 function SaveResMap(ASource: TBitmap): Boolean;
83 public
84 constructor Create;
85 destructor Destroy; override;
86
87 procedure Exec;
88 end;
89
90 constructor TMergeSrv.Create;
91 begin
92 FDataFile := TParams.Create;
93 end;
94
95 destructor TMergeSrv.Destroy;
96 begin
97 FDataFile.free;
98 inherited;
99 end;
100
101 procedure TMergeSrv.Exec;
102 var
103 cConvert: TConvertRes;
104 begin
105 if FDataFile.ReadFileName then
106 begin
107 case FDataFile.Kind of
108 dtIconMerge : cConvert := TMergeIcons.Create(FDataFile);
109 dtPngPack : cConvert := TPngPack.Create(FDataFile);
110 else cConvert := nil;
111 end;
112
113 if cConvert <> nil then
114 begin
115 try
116 if cConvert.Exec(PrintMsg) then
117 if SaveResMap(cConvert.FIconMap) then
118 PrintMsg(format(‘Finish: %s‘,[ChangeFileExt(FDataFile.OutFileName, ‘.IconPack‘)]));
119 finally
120 cConvert.Free;
121 end;
122 end
123 else
124 PrintMsg(‘Err: ‘ + MSG_NONAMES);
125 end
126 else
127 PrintHelp;
128 end;
129
130 procedure TMergeSrv.PrintHelp;
131 begin
132 // TODO -cMM: TMergeSrv.PrintHelp default body inserted
133 end;
134
135 procedure TMergeSrv.PrintMsg(const AVal: string);
136 begin
137 Writeln(AVal);
138 end;
139
140 function TMergeSrv.SaveResMap(ASource: TBitmap): Boolean;
141 var
142 cData: TMemoryStream;
143 cPack: TZCompressionStream;
144 begin
145 Result := False;
146 if ASource = nil then
147 Exit;
148 if not DirectoryExists(ExtractFilePath(FDataFile.OutFileName)) then
149 if not CreateDir(ExtractFilePath(FDataFile.OutFileName)) then
150 Exit;
151
152 // 把资源压缩到内存流中
153 cData := TMemoryStream.Create;
154 try
155 // 生成一份对照Bitmap文件，用户检测合并文件是否有问题。
156 ASource.SaveToStream(cData);
157 cData.SaveToFile(FDataFile.OutFileName);
158 cData.Clear;
159
160 // 生成资源使用的压缩包文件
161 cPack := TZCompressionStream.Create(clMax, cData);
162 try
163 ASource.SaveToStream(cPack);
164 finally
165 cPack.free;
166 end;
167 cData.SaveToFile(ChangeFileExt(FDataFile.OutFileName, ‘.IconPack‘));
168
169 finally
170 cData.Free;
171 end;
172 Result := True;
173 end;
174
175 function TParams.ReadFileName: Boolean;
176 var
177 sFileName: string;
178 sPath: string;
179 begin
180 Result := False;
181 FileName := ‘‘;
182
183 // 从参数读取资源图标维护列表
184 sFileName := ChangeFileExt(ParamStr(0), ‘.lst‘);
185 if ParamCount >= 1 then
186 sFileName := Trim(ParamStr(1));
187 if FileExists(sFileName) then
188 FileName := sFileName;
189
190 // 从第二个参数中读取需要输出的资源包名称
191 // 情景：1、没有第二个参数，默认使用配置文件名
192 // 2、第二个参数是个路径，作为输出路径，文件名同配置名。
193 // 3、有明确输出文件名，直接使用。
194 OutFileName := ChangeFileExt(FileName, ‘.bmp‘);
195 if ParamCount >= 2 then
196 begin
197 sFileName := Trim(ParamStr(2));
198 if (sFileName <> ‘‘) then
199 begin
200 if (sFileName[Length(sFileName)] = ‘\‘) then
201 OutFileName := Format(‘%s%s‘,[sFileName, ExtractFileName(OutFileName)])
202 else
203 begin
204 OutFileName := sFileName;
205 if not DirectoryExists(ExtractFilePath(sFileName)) then
206 if not CreateDir(ExtractFilePath(sFileName)) then
207 OutFileName := ‘‘;
208 end;
209 end;
210 end;
211
212 // 把输出文件变成完整路径，为简化后续PNG资源的加载
213 if OutFileName <> ‘‘ then
214 OutFileName := ExpandFileName(OutFileName);
215
216 /// 设置当前处理目录，为简化后续图标资源的加载
217 if FileName <> ‘‘ then
218 begin
219 sPath := ExtractFilePath(FileName);
220 SetCurrentDir(sPath);
221 FileName := ExtractFileName(FileName);
222 end;
223
224 //
225 if SameText(ExtractFileExt(FileName), ‘.lst‘) then
226 Kind := dtIconMerge
227 else
228 Kind := dtPngPack;
229
230 Result := (FileName <> ‘‘) and (OutFileName <> ‘‘);
231 end;
232
233 procedure TMergeIcons.BuildResMap;
234 var
235 bExists: Boolean;
236 I: Integer;
237 begin
238 // 预读图标文件尺寸
239 FIcon := TPngImage.Create;
240 bExists := False;
241 for I := 0 to Count - 1 do
242 begin
243 bExists := LoadIcon(0);
244 if bExists then
245 Break;
246 end;
247
248 if not bExists then
249 Exit;
250
251 // 设置图标拼接行列数
252 FColCnt := 10;
253 FRowCnt := Count div FColCnt;
254 if Count mod FColCnt > 0 then
255 inc(FRowCnt);
256
257 FWidth := FIcon.Width;
258 FHeight:= FIcon.Height;
259
260 BuildMap(FWidth * FColCnt, FHeight * FRowCnt);
261 end;
262
263 destructor TMergeIcons.Destroy;
264 begin
265 if FFiles <> nil then FFiles.Free;
266 if FIcon <> nil then FIcon.free;
267 inherited;
268 end;
269
270 function TMergeIcons.Exec(PrintMsg: TPrintProc): Boolean;
271 var
272 I: Integer;
273 begin
274 Result := False;
275 if LoadImageNames then
276 begin
277 BuildResMap;
278
279 for I := 0 to Count - 1 do
280 begin
281 if LoadIcon(i) then
282 begin
283 MergeIcon(i);
284 PrintMsg(format(‘ok：并入资源（%d）%s‘, [i, FileNames[i]]));
285 end
286 else
287 PrintMsg(format(‘Err: 无法加载 (%d)%s 文件‘, [i, FileNames[i]]));
288 end;
289
290 Result := True;
291 end
292 else
293 PrintMsg(‘Err: ‘ + MSG_NONAMES);
294 end;
295
296 function TMergeIcons.GetCount: Integer;
297 begin
298 Result := FFiles.Count;
299 end;
300
301 function TMergeIcons.GetFileNames(Index: Integer): string;
302 begin
303 Result := FFiles[Index];
304 end;
305
306 function TMergeIcons.LoadIcon(AIndex: Integer): Boolean;
307 begin
308 try
309 Result := False;
310 if FileExists(FileNames[AIndex]) then
311 begin
312 FIcon.LoadFromFile(FileNames[AIndex]);
313 Result := not FIcon.Empty;
314 end;
315 except
316 Result := False;
317 end;
318 end;
319
320 function TMergeIcons.LoadImageNames: Boolean;
321 var
322 I: Integer;
323 sVal: string;
324 begin
325 FFiles := TStringList.Create;
326 FFiles.LoadFromFile(SourceFile);
327 for I := FFiles.Count - 1 downto 0 do
328 begin
329 sVal := Trim(FFiles[i]);
330 if (sVal = ‘‘) or (sVal[1] = ‘;‘) or (sVal[1] = ‘/‘) then
331 FFiles.Delete(i)
332 else
333 FFiles[i] := sVal;
334 end;
335
336 Result := FFiles.Count > 0;
337 end;
338
339 function TMergeIcons.MergeIcon(AIndex: Integer): Boolean;
340 var
341 iCol: Integer;
342 iRow: Integer;
343 begin
344 Result := True;
345 // 按照索引进行偏移并入
346 iRow := AIndex div FColCnt;
347 iCol := AIndex mod FColCnt;
348 FIconMap.Canvas.Draw(FWidth * iCol, FHeight * iRow, FIcon);
349 end;
350
351 var
352 cSrv: TMergeSrv;
353
354 { TPngPack }
355
356 function TPngPack.Exec(PrintMsg: TPrintProc): Boolean;
357 var
358 cSrc: TPngImage;
359 begin
360 Result := False;
361 cSrc := TPngImage.Create;
362 try
363 cSrc.LoadFromFile(SourceFile);
364 if not cSrc.Empty then
365 begin
366 BuildMap(cSrc.Width, cSrc.Height);
367 ResMap.Canvas.Draw(0, 0, cSrc);
368 Result := True;
369 end;
370 finally
371 cSrc.Free
372 end;
373 end;
374
375 { TConvertRes }
376
377 procedure TConvertRes.BuildMap(w, h:Integer);
378 begin
379 FIconMap := TBitmap.Create;
380 FIconMap.PixelFormat := pf32bit;
381 FIconMap.alphaFormat := afIgnored;
382 FIconMap.SetSize(w, h);
383 // Alpha 透明化
384 FIconMap.Canvas.Brush.Color := clBlack;
385 FIconMap.Canvas.FillRect(Rect(0, 0, FIconMap.Width, FIconMap.Height));
386 end;
387
388 constructor TConvertRes.Create(AFiles: TParams);
389 begin
390 FParams := AFiles;
391 end;
392
393 destructor TConvertRes.Destroy;
394 begin
395 if FIconMap <> nil then
396 FIconMap.Free;
397 inherited;
398 end;
399
400 function TConvertRes.GetSourceFile: string;
401 begin
402 Result := FParams.FileName;
403 end;
404
405 begin
406 ReportMemoryLeaksOnShutdown := True;
407 cSrv := TMergeSrv.Create;
408 try
409 cSrv.Exec;
410 finally
411 cSrv.Free;
412 end;
413 end.
program MergeRes;
完整工程代码
https://github.com/cmacro/simple/tree/master/MergeIconsRes
时间： 2024-10-13 09:06:37