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;
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;
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;
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。完美解决主程序的加载资源消耗时间过长问题。
还种更懒的方法，列表配置文件都不需要，直接读取目录内所有文件进行拼接。这种方式只要在开发时约定图标资源的使用方式就没问题。如按照 前缀_<文件名> 方式引用。不管代码还是外部配置，代码就是定义的常量，外部配置就是个字符串，加载时转换到常量定义值。这样内部资源顺序不管怎么变都使用都不会受影响。
最终的RC文件的内容
1 ; 功能图标 16x16 2 ; 所有同类规格Action16图标变成一个资源， 3 ; 读取一次，在动态加载时可以一次装载到ImageList 4 ; -------------------------------------------------------------- 5 ACTION16 RCDATA .\Icons16.IconPack
通过这个方法保证了动态加载资源时的效率。
开发环境
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.
完整工程代码
https://github.com/cmacro/simple/tree/master/MergeIconsRes
1194
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
