Größe von TBitmap für TImageList anpassen

[Matze]

Hallo,

ich habe mal etwas herumprobiert und das funktioniert bei mir:

Delphi-Quellcode:

procedure AddBmpToImgList(ImgList: TImageList; SourceBmp: TBitmap; IcoWidth: Integer; IcoHeight: Integer);
var
  ImgListBmp: TBitmap;
begin
  ImgListBmp := TBitmap.Create;
  try
    ImgListBmp.Width := IcoWidth;
    ImgListBmp.Height := IcoHeight;

    ImgListBmp.TransparentColor := clFuchsia;
    ImgListBmp.Transparent := True;
    ImgListBmp.TransparentMode := tmAuto;

    // resize bitmap
    StretchBlt(ImgListBmp.Canvas.Handle, 0, 0, IcoWidth, IcoHeight, SourceBmp.Canvas.Handle, 0, 0, SourceBmp.Width, SourceBmp.Height, SRCCOPY);

    // add bitmap to the image list
    ImgList.AddMasked(ImgListBmp, ImgListBmp.TransParentColor);
  finally
    FreeAndNil(ImgListBmp);
  end;
end;

Beispielaufruf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    if OpenPictureDialog1.Execute then
    begin
      Bmp.LoadFromFile(OpenPictureDialog1.FileName);
      AddBmpToImgList(ImageList1, Bmp, 16, 16);
    end;
  finally
    FreeAndNil(Bmp);
  end;
end;

Grüße, Matze

PS: Was wäre eigentlich, wenn man den Codes hier einfach eine Lizenz verpasst, die bei Verwendung eine Open-Source-Anwendung voraussetzt? *g*