TImageList问题!(50分)

  • 主题发起人 wind2000
  • 开始时间
W

wind2000

Unregistered / Unconfirmed
GUEST, unregistred user!
动态往TImageList中装入图片(.bmp),图片大小为32*32,我想装成16*16的:
MyBmp := TBitmap.Create;
with ImageList1 do
begin
Height := 16;
Width := 16;
AddMasked(MyBmp, MyBmp.Canvas.Pixels[0, 0]);
end;
MyBmp.Free;
结果显示时只显示图像的左上角一部分,而不是变小了的全部,我想找有没有Stretch属性,
可惜没找到(倒是在设计期时直接往里装图片时有显示Stretch属性),请问如何解决?
 
你可以设置MyBmp的Stretch属性为TRUE,然后在MyBmp载入图片后设置为16*16,然后再ADD进
IMAGELIST应该就OK啦.
 
to peng_qs:
MyBmp是TBitMap类,没有Stretch,我用Image来做也不行,如下:
var
MyImg : TImage;
begin
MyImg := TImage.Create;
...
MyImg.Picture.LoadFromFile(slImgs);
with MyImg do
begin
Stretch := True;
Height := 16;
Width := 16;
end;
with ImageList1 do
begin
AddMasked(MyImg.Picture.BitMap, MyImg.Picture.Bitmap.Canvas.Pixels[0, 0]);
end;
...
end;
 
Set TImage.stretch to True is not really revise the bitmap. Maybe you can
stretchdraw the 32X32 bitmap to 16X16 bitmap, then load with imagelist.
 
to cony:
please you write detaily....
 
to cony:
It is a TImageList, It is not a TImage,
TImageList has not a Stretch property, how do you do it.
 
看来建议使用Stretch属性的人可能都没有在Delphi上测试过,希望后面的人能够测试成功了
再把详细步骤贴上来,帮忙UP也有分(分数不够可以现加)
 
就是把原图真的缩成16X16大小的,不是仅仅设个Stretch:=true属性,
这样只是看上去小了,实际图还是大的。在用imagelist来load.
这样不是和用32X32的图一样吗?
 
花了一整天时间来想这个问题...总算在下午下班后一个小时搞定(因昨晚太迟睡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;

 
多人接受答案了。
 
顶部