程序功能圖標資源打包處理

時間 2019-11-09

標籤程序功能圖標資源打包處理简体版

原文原文鏈接

PNG圖標是個好東西，如今系統都支持並且工具軟件都能很方便生成(包括PS)，要比作Icon方便不少。所以理所固然的如今項目圖標PNG已經霸佔了ICON的霸主地位。git

項目功能比較多的時候，就會有無數的圖標資源。現作的項目功能圖標單16x16規格已經有200個之多～～，一個功能一個PNG圖標，散落在目錄中(俺們的美工喜歡作PNG圖標，不太喜歡作icon)。雖然有RC資源管理着，但程序第一次加載大量功能圖標時，明顯會感受有些卡的感受。實際性能測試中也確實反映出這個狀況，加載功能圖標耗時嚴重。github

第一種：直接加入RC資源

通常處理功能圖標的方法，把圖標分組編號。如16x16規格的功能圖標分紅ACTION16的類型圖標組，加載時枚舉全部的Action16類型組資源名稱，讀入ImageList中。api

處理過程：

一、枚舉組資源名ide

二、加載PNG資源 x N次工具

三、轉換成BMP帶Alpha通道 x N次性能

四、裝入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

這種方式在資源比較少的時候沒什麼大問題，但資源一多時損失的效率就顯現出來。ui

第二種：把一組資源拼接成單個文件

這種方式的好處顯而易見，不須要枚舉名稱，只有一次讀資源的過程，讀出來的圖標直接裝入ImageList，由ImageList自動切割成16規格的圖標。這效率是槓槓的～。spa

不過這種方式仍是有個製做問題。這麼多資源圖標一般不是一次所有完成的，除了些基本的，其餘的都是有了功能纔有圖標。功能圖標樣式修改，都要從新拼接。這我的力成本很大，再說了讓俺們的美工MM作這事於心不忍啊。3d

解決方案

介於上面這兩種狀況，第一種效率慢、第二種費時費力。爲解決問題本人又比較懶，因此想方法就是作個預處理。結合第一種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

而後經過程序讀取這個列表，合併圖標資源併產生相應的常量定義代碼。這事太美了，一舉兩得！哈～哈～哈～哈～～～

解決：資源加載慢，人工合併費時費力還不用手工維護代碼常量表。

處理方案過程

一、讀取定義列表

二、根據圖標數量生成合並後的資源圖標尺寸

三、依次讀入，繪製到相應偏移位置。

四、壓縮合並的資源圖片並保存

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;

執行合併資源圖標過程

一、讀取參數定義列表

使用那個圖標組索引定義，輸出到哪裏。主要有一個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;

二、生成拼接圖片的規格

 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

三、併入資源圖標

 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 根據索引進行偏移併入

四、壓縮資源並輸出

 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.