實現步驟
自定義的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.
