Delphi中保存圖像列表

2019-11-18 18:54:04

字體：大中小

來源：轉載

供稿：網友

最近在做項目時遇到將圖像列表(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;

procedure TImageListEx.LoadFromFileEx(const FileName: string);

var

Stream: TStream;

begin

Stream := TFileStream.Create(FileName, fmOpenRead);

try

LoadFromStreamEx(Stream);

finally

Stream.Free;

end;

procedure TImageListEx.LoadFromStream(Stream: TStream);

var

SA: TStreamAdapter;

begin

SA := TStreamAdapter.Create(Stream);

try

Handle := ImageList_Read(SA);//將當前圖像列表的句柄指向從二進制流中得到的句柄

if Handle = 0 then

raise EReadError.CreateRes(@SImageReadFail);

finally

SA.Free;

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 := 0;//流指針復位

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;

procedure TImageListEx.SaveToFile(const FileName: string);

var

Stream: TStream;

begin

Stream := TFileStream.Create(FileName, fmCreate);

try

SaveToStream(Stream);

finally

Stream.Free;

end;

procedure TImageListEx.SaveToFileEx(const FileName: string);

var

Stream: TStream;

begin

Stream := TFileStream.Create(FileName, fmCreate);

try

SaveToStreamEx(Stream);

finally

Stream.Free;

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;

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;

procedure SaveImageToStream(Image: TBitmap);

var

Count: DWORD;

begin

BinStream.Clear;

Image.SaveToStream(BinStream);

Count := BinStream.Size;

Stream.WriteBuffer(Count, SizeOf(Count));//首先保存位圖的大小

Stream.CopyFrom(BinStream, 0);//接著保存位圖

end;

begin

Height := Self.Height;

Width := Self.Width;

Stream.WriteBuffer(Height, SizeOf(Height));//保存原圖像列表的高度

Stream.WriteBuffer(Width, SizeOf(Width));//保存將原圖像列表的寬度

Bitmap := TBitmap.Create;

Mask := TBitmap.Create;

BinStream := TMemoryStream.Create;

try

for I := 0 to Count - 1 do//遂一保存圖像列表中的圖像

begin

SetImage(Bitmap, False);

SetImage(Mask, True);

GetImages(I, Bitmap, Mask);//取得指定索引號的位圖及其掩碼位圖

SaveImageToStream(Bitmap);//保存位圖到二進制流中

SaveImageToStream(Mask);//保存掩碼位圖到二進制流中

end;

finally

Bitmap.Free;

Mask.Free;

BinStream.Free;

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 中調試運行通過。

上一篇：在Delphi中調用Flash

下一篇：創建良好設計的代碼（基于Delphi/VCL）