Skip to content

Instantly share code, notes, and snippets.

@HemulGM
Last active May 21, 2020 14:05
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save HemulGM/cf2651fa4c8303fe7b0ef9cbd5432c29 to your computer and use it in GitHub Desktop.
Save HemulGM/cf2651fa4c8303fe7b0ef9cbd5432c29 to your computer and use it in GitHub Desktop.
type
TImageListHelper = class helper for TImageList
function Add(ABitmap: TBitmap): integer;
end;
...
function TImageListHelper.Add(aBitmap: TBitmap): integer;
const
SCALE = 1;
var
vSource: TCustomSourceItem;
vBitmapItem: TCustomBitmapItem;
vDest: TCustomDestinationItem;
vLayer: TLayer;
begin
Result := -1;
if (aBitmap.Width = 0) or (aBitmap.Height = 0) then
exit;
// add source bitmap
vSource := Source.Add;
vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia;
vSource.MultiResBitmap.SizeKind := TSizeKind.Source;
vSource.MultiResBitmap.Width := Round(aBitmap.Width / SCALE);
vSource.MultiResBitmap.Height := Round(aBitmap.Height / SCALE);
vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True);
if vBitmapItem = nil then
begin
vBitmapItem := vSource.MultiResBitmap.Add;
vBitmapItem.Scale := Scale;
end;
vBitmapItem.Bitmap.Assign(aBitmap);
vDest := Destination.Add;
vLayer := vDest.Layers.Add;
vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero, vSource.MultiResBitmap.Width,
vSource.MultiResBitmap.Height);
vLayer.Name := vSource.Name;
Result := vDest.Index;
end;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment