首頁>網絡編程教程>Delphi教程

Delphi中保存影像列表

作者：Eve Cole 更新時間：2025-02-03 12:00:04

最近在做專案時遇到將圖片清單(TImageList)中一系列的圖片儲存到指定的檔案或二進位流中，以便在需要時進行動態復原的情況。於是在Delphi的幫助中查找TImageList類別相關的屬性、方法，遺憾的是Delphi在TImageList中並未提供SaveToFile和SaveToStream方法，所以針對TImageList目前的限制，必須採取其它的辦法來擴展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 = 0 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 := 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;
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, 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;
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 中偵錯執行通過。

相關文章