Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/fastphp/trunk/ImageListEx.pas
Revision: 36
Committed: Sat Dec 16 23:27:44 2017 UTC (2 years, 3 months ago) by daniel-marschall
Content type: text/x-pascal
File size: 3030 byte(s)

File Contents

# Content
1 unit ImageListEx;
2
3 interface
4
5 uses
6 Classes, Controls, Graphics;
7
8 type
9 TImageListEx = class helper for TImageList
10 public
11 procedure LoadAndSplitImages(filename: string);
12 end;
13
14 implementation
15
16 (*
17 If Images < 1 then entire AGraphic will be split up into
18 individual images, otherwise only NumberOfImages will
19 be added to the ImageList.
20
21 Images are processed from left to right and top to bottom.
22
23 Source: http://www.delphipages.com/forum/showpost.php?p=154601&postcount=8
24 *)
25 procedure SetImageList(AGraphic: TGraphic; ImageList: TImageList; ClearList: boolean; NumberOfImages: integer = 0);
26 var
27 mask, image, bmp: TBitmap;
28 AColor: TColor;
29 modX, modY, x, y, xx, yy, imgWid, imgHgt: integer;
30 cnt: integer;
31 begin
32 Assert((AGraphic <> nil) and Assigned(ImageList));
33 if ClearList then ImageList.Clear;
34
35 mask := TBitmap.Create;
36 image := TBitmap.Create;
37 bmp := TBitmap.Create;
38 try
39 image.PixelFormat := pf24bit;
40 image.Width := AGraphic.Width;
41 image.Height := AGraphic.Height;
42 image.Canvas.Draw(0, 0, AGraphic);
43 //Get the lower left pixel color (the transparent color).
44 AColor := image.Canvas.Pixels[0, image.Height -1];
45
46 x := ImageList.Width;
47 y := ImageList.Height;
48 modX := x -(image.Width mod x);
49 modY := y -(image.Height mod y);
50
51 if (modX <> x) or (modY <> y) then
52 begin
53 //Resize image bitmap so that it's width and height
54 //are a multiple of the imagelist's width and height.
55 image.Width := AGraphic.Width +modX;
56 image.Height := AGraphic.Height +modY;
57 image.Canvas.Brush.Color := AColor;
58 image.Canvas.FillRect(Rect(0, 0, image.Width, image.Height));
59 //Draw the graphic centered on the image bitmap.
60 image.Canvas.Draw(modX div 2, modY div 2, AGraphic);
61 end;
62
63 imgWid := image.Width;
64 imgHgt := image.Height;
65
66 //Size bmp to the imagelist's sizes.
67 bmp.Width := x;
68 bmp.Height := y;
69
70 if NumberOfImages > 0 then
71 cnt := NumberOfImages
72 else
73 cnt := (imgWid div x) *(imgHgt div y);
74
75 xx := 0;
76 yy := 0;
77 while (cnt > 0) and (yy < imgHgt) do
78 begin
79 //Draw at negative xx/yy (only the portion that overlaps
80 //the canvas will be drawn.
81 bmp.Canvas.Draw(-xx, -yy, image);
82 //Create the mask for transparency.
83 mask.Assign(bmp);
84 mask.Canvas.Brush.Color := AColor;
85 mask.Monochrome := true;
86
87 //Add the bmp to the imagelist.
88 ImageList.Add(bmp, mask);
89 Dec(cnt);
90
91 Inc(xx, x);
92 if xx +x > imgWid then
93 begin
94 //Get the next row.
95 xx := 0;
96 Inc(yy, y);
97 end;
98 end;
99 finally
100 bmp.Free;
101 mask.Free;
102 image.Free;
103 end;
104 end;
105
106 procedure TImageListEx.LoadAndSplitImages(filename: string);
107 var
108 bmp : TBitmap;
109 begin
110 bmp := TBitmap.Create;
111 try
112 bmp.LoadFromFile(filename);
113 SetImageList(bmp, Self, true);
114 finally
115 bmp.Free;
116 end;
117 end;
118
119 end.