Imagelists - Copiar - Diversos Tamanhos

Pra quem precisar copiar um image list em tamanhos diferntes: Taí!


Sohad
Sohad@ig.com.br


Procedure ImageListCopiar(e_Origem, e_Destino:TImagelist);
var i:integer;
Bmp,BmpM,
Bmp_D,BmpM_D:TBitmap;
Rect:TRect;
begin
e_Destino.Clear;
Rect.Top:=0;
Rect.Left:=0;
Rect.Right:=e_Destino.Width;
Rect.Bottom:=e_Destino.Height;
for i:=0 to e_origem.Count-1 do
begin
Bmp:=TBitMap.Create;
Bmp.Width:=e_origem.Width;
Bmp.Height:=e_origem.Height;
BmpM:=TBitMap.Create;
BmpM.Width:=e_origem.Width;
BmpM.Height:=e_origem.Height;

e_origem.Draw(Bmp.Canvas,0,0,i,dsTransparent,itImage,True);
e_origem.Draw(BmpM.Canvas,0,0,i,dsTransparent,itMask,True);

Bmp_D:=TBitMap.Create;
Bmp_D.Width:=e_origem.Width;
Bmp_D.Height:=e_origem.Height;
BmpM_D:=TBitMap.Create;
BmpM_D.Width:=e_Destino.Width;
BmpM_D.Height:=e_Destino.Height;

//Bmp_M.Canvas.CopyMode:=cmSrcCopy;
Bmp_D.Canvas.StretchDraw(Rect,Bmp);
//BmpM_D.Canvas.CopyMode:=cmSrcCopy;
BmpM_D.Canvas.StretchDraw(Rect,BmpM);
e_Destino.Add(Bmp_D,BmpM_D);
Bmp.Free;
BmpM.Free;
Bmp_D.Free;
BmpM_D.Free;
Application.ProcessMessages;
end;
end;