知识大全 Delphi中保存图像列表

Posted 2022-07-22 知

篇首语：博观而约取，厚积而薄发。本文由小常识网(cha138.com)小编为大家整理，主要介绍了知识大全 Delphi中保存图像列表相关的知识，希望对你有一定的参考价值。

Delphi中保存图像列表 以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容，让我们赶快一起来看一下吧！

　　最近在做项目时遇到将图像列表(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 TImageListEx LoadFromFile(const FileName: string); var Stream: TStream; begin Stream := TFileStream Create(FileName fmOpenRead); try LoadFromStream(Stream); finally Stream Free; end; end;

procedure TImageListEx LoadFromFileEx(const FileName: string); var Stream: TStream; begin Stream := TFileStream Create(FileName fmOpenRead); try LoadFromStreamEx(Stream); finally Stream Free; end; end;

procedure TImageListEx LoadFromStream(Stream: TStream); var SA: TStreamAdapter; begin SA := TStreamAdapter Create(Stream); try Handle := ImageList_Read(SA);//将当前图像列表的句柄指向从二进制流中得到的句柄 if Handle = then raise EReadError CreateRes(@SImageReadFail); finally SA Free; end; end;

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

procedure LoadImageFromStream(Image: TBitmap); var Count: DWORD; begin Image Assign(nil); Stream ReadBuffer(Count SizeOf(Count));//首先读出位图的大小 BinStream Clear; BinStream CopyFrom(Stream Count);//接着读出位图 BinStream Position := ;//流指针复位 Image LoadFromStream(BinStream); end;

begin Stream ReadBuffer(Height SizeOf(Height)); Stream ReadBuffer(Width SizeOf(Width)); Self Height := Height; Self Width := Width;//恢复图像列表原来的高度宽度 Bitmap := TBitmap Create; Mask := TBitmap Create; BinStream := TMemoryStream Create; try while Stream Position <> Stream Size do begin LoadImageFromStream(Bitmap);//从二进制流中读出位图 LoadImageFromStream(Mask);//从二进制流中读出掩码位图 Add(Bitmap Mask);//将位图及其掩码位图合并添加到图像列表中 end; finally Bitmap Free; Mask Free; BinStream Free; end; end;

procedure TImageListEx SaveToFile(const FileName: string); var Stream: TStream; begin Stream := TFileStream Create(FileName fmCreate); try SaveToStream(Stream); finally Stream Free; end; end;

procedure TImageListEx SaveToFileEx(const FileName: string); var Stream: TStream; begin Stream := TFileStream Create(FileName fmCreate); try SaveToStreamEx(Stream); finally Stream Free; end; end;

procedure TImageListEx SaveToStream(Stream: TStream); var SA: TStreamAdapter; begin SA := TStreamAdapter Create(Stream); try if not ImageList_Write(Handle SA) then//将当前图像列表保存到二进制流中 raise EWriteError CreateRes(@SImageWriteFail); finally SA Free; end; end;

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

procedure SetImage(Image: TBitmap; IsMask: Boolean); begin Image Assign(nil);//清除上一次保存的图像避免出现图像重叠 with Image do begin if IsMask then Monochrome := True;//掩码位图必须使用单色 Height := Self Height; Width := Self Width; end; end;

procedure SaveImageToStream(Image: TBitmap); var Count: DWORD; begin BinStream Clear; Image SaveToStream(BinStream); Count := BinStream Size; Stream WriteBuffer(Count SizeOf(Count));//首先保存位图的大小 Stream CopyFrom(BinStream );//接着保存位图 end;

cha138/Article/program/Delphi/201311/8481