unit ImageListEx;
interface
uses
Classes, Controls, Graphics;
type
TImageListEx = class helper for TImageList
public
procedure LoadAndSplitImages(filename: string);
end;
implementation
(*
If Images < 1 then entire AGraphic will be split up into
individual images, otherwise only NumberOfImages will
be added to the ImageList.
Images are processed from left to right and top to bottom.
Source: http://www.delphipages.com/forum/showpost.php?p=154601&postcount=8
*)
procedure SetImageList(AGraphic: TGraphic; ImageList: TImageList; ClearList: boolean; NumberOfImages: integer = 0);
var
mask, image, bmp: TBitmap;
AColor: TColor;
modX, modY, x, y, xx, yy, imgWid, imgHgt: integer;
cnt: integer;
begin
Assert((AGraphic <> nil) and Assigned(ImageList));
if ClearList then ImageList.Clear;
mask := TBitmap.Create;
image := TBitmap.Create;
bmp := TBitmap.Create;
try
image.PixelFormat := pf24bit;
image.Width := AGraphic.Width;
image.Height := AGraphic.Height;
image.Canvas.Draw(0, 0, AGraphic);
//Get the lower left pixel color (the transparent color).
AColor := image.Canvas.Pixels[0, image.Height -1];
x := ImageList.Width;
y := ImageList.Height;
modX := x -(image.Width mod x);
modY := y -(image.Height mod y);
if (modX <> x) or (modY <> y) then
begin
//Resize image bitmap so that it's width and height
//are a multiple of the imagelist's width and height.
image.Width := AGraphic.Width +modX;
image.Height := AGraphic.Height +modY;
image.Canvas.Brush.Color := AColor;
image.Canvas.FillRect(Rect(0, 0, image.Width, image.Height));
//Draw the graphic centered on the image bitmap.
image.Canvas.Draw(modX div 2, modY div 2, AGraphic);
end;
imgWid := image.Width;
imgHgt := image.Height;
//Size bmp to the imagelist's sizes.
bmp.Width := x;
bmp.Height := y;
if NumberOfImages > 0 then
cnt := NumberOfImages
else
cnt := (imgWid div x) *(imgHgt div y);
xx := 0;
yy := 0;
while (cnt > 0) and (yy < imgHgt) do
begin
//Draw at negative xx/yy (only the portion that overlaps
//the canvas will be drawn.
bmp.Canvas.Draw(-xx, -yy, image);
//Create the mask for transparency.
mask.Assign(bmp);
mask.Canvas.Brush.Color := AColor;
mask.Monochrome := true;
//Add the bmp to the imagelist.
ImageList.Add(bmp, mask);
Dec(cnt);
Inc(xx, x);
if xx +x > imgWid then
begin
//Get the next row.
xx := 0;
Inc(yy, y);
end;
end;
finally
bmp.Free;
mask.Free;
image.Free;
end;
end;
procedure TImageListEx.LoadAndSplitImages(filename: string);
var
bmp : TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.LoadFromFile(filename);
SetImageList(bmp, Self, true);
finally
bmp.Free;
end;
end;
end.