Delphi中保存图像列表

<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 728x15, 创建于 08-4-23MSDN */google_ad_slot = "3624277373";google_ad_width = 728;google_ad_height = 15;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>

<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 160x600, 创建于 08-4-23MSDN */google_ad_slot = "4367022601";google_ad_width = 160;google_ad_height = 600;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>

原作发表在计算机世界日报：

http://www.ccw.com.cn/htm/app/aprog/01_6_5_2.asp

 

Delphi中保存图像列表

蔡健 01-6-5 下午 02:07:11

---

最近在做项目时遇到将图像列表(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;interfaceuses Windows, SysUtils, Classes, Graphics, Controls, Commctrl, ImgList, Consts;typeTImageListEx = class(TImageList)publicprocedure 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;implementationprocedure Register;beginRegisterComponents('ImageListEx', [TImageListEx]);end;{ TImageListEx }procedure TImageListEx.LoadFromFile(const FileName: string);varStream: TStream;beginStream := TFileStream.Create(FileName, fmOpenRead);tryLoadFromStream(Stream);finallyStream.Free;end;end;procedure TImageListEx.LoadFromFileEx(const FileName: string);varStream: TStream;beginStream := TFileStream.Create(FileName, fmOpenRead);tryLoadFromStreamEx(Stream);finallyStream.Free;end;end;procedure TImageListEx.LoadFromStream(Stream: TStream);varSA: TStreamAdapter;beginSA := TStreamAdapter.Create(Stream);tryHandle := ImageList_Read(SA);//将当前图像列表的句柄指向从二进制流中得到的句柄if Handle = 0 thenraise EReadError.CreateRes(@SImageReadFail);finallySA.Free;end;end;procedure TImageListEx.LoadFromStreamEx(Stream: TStream);varWidth, Height: Integer;Bitmap, Mask: TBitmap;BinStream: TMemoryStream;procedure LoadImageFromStream(Image: TBitmap);varCount: DWORD;beginImage.Assign(nil);Stream.ReadBuffer(Count, SizeOf(Count));//首先读出位图的大小BinStream.Clear;BinStream.CopyFrom(Stream, Count);//接着读出位图BinStream.Position := 0;//流指针复位Image.LoadFromStream(BinStream);end;beginStream.ReadBuffer(Height, SizeOf(Height));Stream.ReadBuffer(Width, SizeOf(Width));Self.Height := Height;Self.Width := Width;//恢复图像列表原来的高度、宽度Bitmap := TBitmap.Create;Mask := TBitmap.Create;BinStream := TMemoryStream.Create;trywhile Stream.Position <> Stream.Size dobeginLoadImageFromStream(Bitmap);//从二进制流中读出位图LoadImageFromStream(Mask);//从二进制流中读出掩码位图Add(Bitmap, Mask);//将位图及其掩码位图合并添加到图像列表中end;finallyBitmap.Free;Mask.Free;BinStream.Free;end;end;procedure TImageListEx.SaveToFile(const FileName: string);varStream: TStream;beginStream := TFileStream.Create(FileName, fmCreate);trySaveToStream(Stream);finallyStream.Free;end;end;procedure TImageListEx.SaveToFileEx(const FileName: string);varStream: TStream;beginStream := TFileStream.Create(FileName, fmCreate);trySaveToStreamEx(Stream);finallyStream.Free;end;end;procedure TImageListEx.SaveToStream(Stream: TStream);varSA: TStreamAdapter;beginSA := TStreamAdapter.Create(Stream);tryif not ImageList_Write(Handle, SA) then//将当前图像列表保存到二进制流中raise EWriteError.CreateRes(@SImageWriteFail);finallySA.Free;end;end;procedure TImageListEx.SaveToStreamEx(Stream: TStream);varI: Integer;Width, Height: Integer;Bitmap, Mask: TBitmap;BinStream: TMemoryStream;procedure SetImage(Image: TBitmap; IsMask: Boolean);beginImage.Assign(nil);//清除上一次保存的图像，避免出现图像重叠with Image dobeginif IsMask then Monochrome := True;//掩码位图必须使用单色Height := Self.Height;Width := Self.Width;end;end;procedure SaveImageToStream(Image: TBitmap);varCount: DWORD;beginBinStream.Clear;Image.SaveToStream(BinStream);Count := BinStream.Size;Stream.WriteBuffer(Count, SizeOf(Count));//首先保存位图的大小Stream.CopyFrom(BinStream, 0);//接着保存位图end;beginHeight := Self.Height;Width := Self.Width;Stream.WriteBuffer(Height, SizeOf(Height));//保存原图像列表的高度Stream.WriteBuffer(Width, SizeOf(Width));//保存将原图像列表的宽度Bitmap := TBitmap.Create;Mask := TBitmap.Create;BinStream := TMemoryStream.Create;tryfor I := 0 to Count - 1 do//遂一保存图像列表中的图像beginSetImage(Bitmap, False);SetImage(Mask, True);GetImages(I, Bitmap, Mask);//取得指定索引号的位图及其掩码位图SaveImageToStream(Bitmap);//保存位图到二进制流中SaveImageToStream(Mask);//保存掩码位图到二进制流中end;finallyBitmap.Free;Mask.Free;BinStream.Free;end;end;end.下面示范在Delphi中的使用方法：首先在Delphi中新建一个项目，然后在Form1上放置一个ImageListEx控件，一个TreeView控件和四个Button控件。将TreeView控件的Images属性与ImageListEx相关联，在ImageListEx中任意添加几幅图像，在TreeView中添加相应数量的项目，项目的ImageIndex属性分别对应于ImageListEx中图像的索引号。现在TreeView中每个项目之前已经能够显示出相应的图标。最后，在Button1的OnClick事件中写上：ImageListEx1.SaveToFile('C:CJ.dat');ImageListEx1.SaveToFileEx('C:CJEx.dat');在Button2的OnClick事件中写上：ImageListEx1.Clear;在Button3的OnClick事件中写上：ImageListEx1.LoadFromFile('C:CJ.dat');在Button4的OnClick事件中写上：ImageListEx1.LoadFromFileEx('C:CJEx.dat');运行程序，首先单击Button1，之后单击Button2，最后任意单击Button3或Button4，可以看到程序能够将图像列表中的图像保存到指定的文件中，可以从指定的文件中正确的恢复并显示。结束语本文介绍的内容已用于解决本人在实际项目中遇到的情况，也希望同样遇到此问题的程序员能够从中找到答案。以上代码在 Delphi5.0、Windows2000 Server 中调试运行通过。

<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 728x15, 创建于 08-4-23MSDN */google_ad_slot = "3624277373";google_ad_width = 728;google_ad_height = 15;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>

<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 160x600, 创建于 08-4-23MSDN */google_ad_slot = "4367022601";google_ad_width = 160;google_ad_height = 600;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>