Fórum Adiccionar imagem ao ImageList #291569

procedure TForm1.Button5Click(Sender: TObject);
var MyBitmap : TBitMap;
begin
 MyBitmap.LoadFromFile( ´C:\teste.bmp´ );
SetImageListFromBmp( MyBitmap, ImageList1, 0, MyBitmap.Height, 0 );
end;

procedure SetImageListFromBmp(Bitmap: TBitmap;
  ImageList: TImageList; Width, Height, Images: integer);
var
  mask, image : TBitmap;
  R : TRect;
  cnt : integer;
begin
  Assert( (Bitmap <> nil) and Assigned(ImageList) );

  if Width < 1 then Width := Bitmap.Height;

  if Height < 1 then
    raise ERangeError.Create(´Altura não pode ser menor que 1´);

  if Bitmap.Width mod Width <> 0 then
    raise EInvalidOp.Create(´A largura do Bitmap deve ser um múltiplo da Largura´);
  if Bitmap.Height mod Height <> 0 then
    raise EInvalidOp.Create(´A altura do Bitmap deve ser um múltiplo da Altura´);

  ImageList.Clear;
  ImageList.Height := Height;
  ImageList.Width := Width;

  mask := TBitmap.Create;
  image := TBitmap.Create;
  try
    mask.Width := Width;
    mask.Height := Height;

    image.Width := Width;
    image.Height := Height;

    if Images < 1 then cnt := (Bitmap.Width div Width) +(Bitmap.Height
div Height) 
      else cnt := Images;

    R := Rect(0, 0, Width, Height);
    while (cnt > 0) and (R.Bottom <= Bitmap.Height) do begin 
      R.Left := 0; 
      R.Right := Width;
      while (cnt > 0) and (R.Right <= Bitmap.Width) do begin 
        image.Canvas.CopyRect(Rect(0,0,Width,Height), Bitmap.Canvas, R); 

        mask.Assign(image); // lower left pixel 
        mask.Canvas.Brush.Color := image.Canvas.Pixels[0, image.Height 
-1];
        mask.Monochrome := true; 

        ImageList.Add(image, mask);
        Dec(cnt); 

        Inc(R.Left, Width);
        Inc(R.Right, Width);
      end; 
      Inc(R.Top, Height); 
      Inc(R.Bottom, Height); 
    end;
  finally 
    mask.Free; 
    image.Free; 
  end;
end;