花了一整天时间来想这个问题...总算在下午下班后一个小时搞定(因昨晚太迟睡3:30结果造成今天
一整天昏昏沉沉的,都集中不了精神来想问题...浪费了好多时间),现将源码贡献出来,利用下面
这一小段代码你可以做到类似QQ头像大小图标切换功能:
const
iH = 20;
iW = 20;
var
ImgList1, ImgList2: TImageList; {全局变量}
...
procedure TForm1.FormCreate(Sender: TObject);
begin
{动态生成两个TImageList,分别用来保存大/小图标}
ImgList1 := TImageList.CreateSize(iW, iH); //小图标
ImgList2 := TImageList.CreateSize(32, 32); //大图标
end;
procedure TForm1.Button3Click(Sender: TObject);
var
slImgs: TStrings;
i: integer;
Bitmap: TBitmap;
MyImg: TImage;
MyRect, MyOther: TRect;
begin
slImgs := TStringList.Create;
MyImg := TImage.Create(Self);
Bitmap := TBitmap.Create;
//下面这个自定义函数可以得到目录C:/QQ/face下所有*.bmp文件名,并保存到slImgs中
GetFiles('C:/QQ/face', '*.bmp', slImgs, 0);
for i := 0 to slImgs.Count - 1 do
begin
// Application.ProcessMessages; {调试用}
// Label4.Caption := slImgs;
MyRect := Rect(0,0,32,32);
MyOther := Rect(0,0,iW,iH);
Bitmap.LoadFromFile(slImgs);
with MyImg do
begin
Height := iH;
Width := iW;
{注意下面这一句,关键所在}
Canvas.CopyRect(MyOther, Bitmap.Canvas, MyRect);
end;
{装入小图标}
ImgList1.AddMasked(MyImg.Picture.Bitmap, MyImg.Canvas.Pixels[0, 0]);
{装入大图标}
ImgList2.AddMasked(Bitmap, Bitmap.Canvas.Pixels[0, 0]);
end;
Bitmap.Free;
MyImg.Free;
slImgs.Free;
end;