Delphi中保存圖像列表

　　最近在做項目時遇到將圖像列表(TImageList)中一系列的圖像保存到指定的文件或二進制流中以便在需要時進行動態恢復的情況於是在Delphi的幫助中查找TImageList類相關的屬性方法遺憾的是Delphi在TImageList中並未提供SaveToFile和SaveToStream方法所以針對TImageList目前的限制必須采取其它的辦法來擴展TImageList的功能以滿足實際項目的需要

　　一解決方法

　　方法一

　　使用API函數ImageList_Write和ImageList_Read二者都需要指定一個類型為IStream的參數前者的作用是將指定句柄的圖像列表保存到類型為IStream的二進制流中後者是從類型為IStream的二進制流中讀出原先保存的圖像列表並且返回指向這個圖像列表的句柄

　　IStream是一個OLE對象它在Delphi中的聲明為TStreamAdapter =　class(TInterfacedObject IStream)意為TStreamAdapter是從TInterfacedObject繼承下來的操縱 IStream接口的對象通過TStreamAdapter對象可以實現Delphi內部TStream對象對ISTream接口對象的操縱

　　方法二

　　從TImageList繼承一個子類TImageListEx實現自定義的SaveToFileEx和SaveToStreamEx方法在默認情況下TImageList中保存的圖像是由普通圖像及其掩碼圖像組合而成所以必須調用其基類TCustomImageList的Protected部分提供的GetImages(Index: Integer; Image Mask: TBitmap)方法以獲得圖像列表中指定索引號的位圖及其掩碼位圖之後分別保存到自定義的文件或二進制流中此外還需提供LoadFromFileEx和LoadFromStreamEx方法從自定義的文件或二進制流中恢復圖像集合

　　二實現步驟

　　自定義的TImageListEx控件在Public部分一並實現了對上述兩種方法的封裝

TImageListEx類源代碼如下

unit ImageListEx;

interface

uses Windows SysUtils Classes Graphics Controls Commctrl ImgList Consts;

type
TImageListEx = class(TImageList)
public
procedure LoadFromFile(const FileName: string);//實現API方式保存
procedure LoadFromStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFileEx(const FileName: string);//實現自定義方式保存
procedure LoadFromStreamEx(Stream: TStream);
procedure SaveToFileEx(const FileName: string);
procedure SaveToStreamEx(Stream: TStream);
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents(ImageListEx [TImageListEx]);
end;

{ TImageListEx }

procedure TImageListExLoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStreamCreate(FileName fmOpenRead);
try
LoadFromStream(Stream);
finally
StreamFree;
end;
end;

procedure TImageListExLoadFromFileEx(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStreamCreate(FileName fmOpenRead);
try
LoadFromStreamEx(Stream);
finally
StreamFree;
end;
end;

procedure TImageListExLoadFromStream(Stream: TStream);
var
SA: TStreamAdapter;
begin
SA := TStreamAdapterCreate(Stream);
try
Handle := ImageList_Read(SA);//將當前圖像列表的句柄指向從二進制流中得到的句柄
if Handle = then
raise EReadErrorCreateRes(@SImageReadFail);
finally
SAFree;
end;
end;

procedure TImageListExLoadFromStreamEx(Stream: TStream);
var
Width Height: Integer;
Bitmap Mask: TBitmap;
BinStream: TMemoryStream;

procedure LoadImageFromStream(Image: TBitmap);
var
Count: DWORD;
begin
ImageAssign(nil);
StreamReadBuffer(Count SizeOf(Count));//首先讀出位圖的大小
BinStreamClear;
BinStreamCopyFrom(Stream Count);//接著讀出位圖
BinStreamPosition := ;//流指針復位
ImageLoadFromStream(BinStream);
end;

begin
StreamReadBuffer(Height SizeOf(Height));
StreamReadBuffer(Width SizeOf(Width));
SelfHeight := Height;
SelfWidth := Width;//恢復圖像列表原來的高度寬度
Bitmap := TBitmapCreate;
Mask := TBitmapCreate;
BinStream := TMemoryStreamCreate;
try
while StreamPosition <> StreamSize do
begin
LoadImageFromStream(Bitmap);//從二進制流中讀出位圖
LoadImageFromStream(Mask);//從二進制流中讀出掩碼位圖
Add(Bitmap Mask);//將位圖及其掩碼位圖合並添加到圖像列表中
end;
finally
BitmapFree;
MaskFree;
BinStreamFree;
end;
end;

procedure TImageListExSaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStreamCreate(FileName fmCreate);
try
SaveToStream(Stream);
finally
StreamFree;
end;
end;

procedure TImageListExSaveToFileEx(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStreamCreate(FileName fmCreate);
try
SaveToStreamEx(Stream);
finally
StreamFree;
end;
end;

procedure TImageListExSaveToStream(Stream: TStream);
var
SA: TStreamAdapter;
begin
SA := TStreamAdapterCreate(Stream);
try
if not ImageList_Write(Handle SA) then//將當前圖像列表保存到二進制流中
raise EWriteErrorCreateRes(@SImageWriteFail);
finally
SAFree;
end;
end;

procedure TImageListExSaveToStreamEx(Stream: TStream);
var
I: Integer;
Width Height: Integer;
Bitmap Mask: TBitmap;
BinStream: TMemoryStream;

procedure SetImage(Image: TBitmap; IsMask: Boolean);
begin
ImageAssign(nil);//清除上一次保存的圖像避免出現圖像重疊
with Image do
begin
if IsMask then Monochrome := True;//掩碼位圖必須使用單色
Height := SelfHeight;
Width := SelfWidth;
end;
end;

procedure SaveImageToStream(Image: TBitmap);
var
Count: DWORD;
begin
BinStreamClear;
ImageSaveToStream(BinStream);
Count := BinStreamSize;
StreamWriteBuffer(Count SizeOf(Count));//首先保存位圖的大小
StreamCopyFrom(BinStream );//接著保存位圖
end;

begin
Height := SelfHeight;
Width := SelfWidth;
StreamWriteBuffer(Height SizeOf(Height));//保存原圖像列表的高度
StreamWriteBuffer(Width SizeOf(Width));//保存將原圖像列表的寬度
Bitmap := TBitmapCreate;
Mask := TBitmapCreate;
BinStream := TMemoryStreamCreate;
try
for I := to Count do//遂一保存圖像列表中的圖像
begin
SetImage(Bitmap False);
SetImage(Mask True);
GetImages(I Bitmap Mask);//取得指定索引號的位圖及其掩碼位圖
SaveImageToStream(Bitmap);//保存位圖到二進制流中
SaveImageToStream(Mask);//保存掩碼位圖到二進制流中
end;
finally
BitmapFree;
MaskFree;
BinStreamFree;
end;
end;
end;

下面示范在Delphi中的使用方法

　　首先在Delphi中新建一個項目然後在Form上放置一個ImageListEx控件一個TreeView控件和四個Button控件將TreeView控件的Images屬性與ImageListEx相關聯在ImageListEx中任意添加幾幅圖像在TreeView中添加相應數量的項目項目的ImageIndex屬性分別對應於ImageListEx中圖像的索引號現在TreeView中每個項目之前已經能夠顯示出相應的圖標最後在Button的OnClick事件中寫上

ImageListExSaveToFile(C:\CJdat);
ImageListExSaveToFileEx(C:\CJExdat);

在Button的OnClick事件中寫上ImageListExClear;

在Button的OnClick事件中寫上ImageListExLoadFromFile(C:\CJdat);

在Button的OnClick事件中寫上ImageListExLoadFromFileEx(C:\CJExdat);

　　運行程序首先單擊Button之後單擊Button最後任意單擊Button或Button可以看到程序能夠將圖像列表中的圖像保存到指定的文件中可以從指定的文件中正確的恢復並顯示

　　三結束語

　　本文介紹的內容已用於解決本人在實際項目中遇到的情況也希望同樣遇到此問題的程序員能夠從中找到答案以上代碼在 DelphiWindows Server 中調試運行通過

From:http://tw.wingwit.com/Article/program/Delphi/201311/8481.html