最近在做项目时遇到将图像列表(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 中调试运行通过
