Module cImageList32.pkg
1Use cImageList.pkg
2
3// Windows API Functions: These should be moved to the appropriate packages.
4// =========================================================================
5
6// GetPixel
7// --------
8
9#IFDEF Get_GetPixel
10#ELSE
11 External_Function GetPixel "GetPixel" Gdi32.dll ;
12 Handle hdc ; // handle to DC
13 Integer nXPos ; // x-coordinate of pixel
14 Integer nYPos ; // y-coordinate of pixel
15 Returns Integer
16#ENDIF
17
18// CreateCompatibleDC:
19// -------------------
20// The CreateCompatibleDC function creates a memory device context (DC) compatible with the specified device.
21// See Also DeleteDC.
22
23#IFDEF Get_CreateCompatibleDC
24#ELSE
25 External_Function CreateCompatibleDC "CreateCompatibleDC" Gdi32.dll ;
26 Handle hdc ; // Handle to an existing DC. If this handle is NULL, the function creates a memory DC compatible with the application's current screen.
27 Returns Handle // handle to a new memory DC, or null if it fails.
28#ENDIF
29
30
31// DeleteDC:
32// ---------
33// Deletes the specified device context (DC). Do not use to delete a DC whose handle was obtained using GetDC.
34// Instead use ReleaseDC for this purpose.
35
36#IFDEF Get_DeleteDC
37#ELSE
38 External_Function DeleteDC "DeleteDC" Gdi32.dll ;
39 Handle hdc ; // Handle to the device context being deleted.
40 Returns Boolean // True if successful.
41#ENDIF
42
43
44// SelectObject:
45// -------------
46// selects an object into the specified device context (DC). The new object replaces the previous object of the same type.
47
48#IFDEF Get_SelectObject
49#ELSE
50 External_Function SelectObject "SelectObject" Gdi32.dll ;
51 Handle hdc ; // handle to DC
52 Handle hgdiobj; // Handle to the object to be selected.
53 Returns Handle // handle to the object being replaced
54#ENDIF
55
56
57// ImageList_ReplaceIcon
58// ---------------------
59
60// Replaces an imagelist image with an icon or cursor.
61#IFDEF Get_ImageList_ReplaceIcon
62#ELSE
63 External_Function ImageList_ReplaceIcon "ImageList_ReplaceIcon" ComCtl32.dll ;
64 Handle hIml ; // handle to the image list
65 Integer i ; // index of the image to replace. -1 to append image to end of the list
66 Handle hIcon ; // handle to the icon or cursor for the new image.
67 Returns Integer // Returns the index of the image if successful, or -1 otherwise.
68#ENDIF
69
70// This all needs to be tidied up. I only need the LastDelimeter() function in this group but I have to declare
71// them all in this way so that when cWorkspace.pkg is compiled the functions are available there. I cannot
72// use cWorkspace.pkg here. The best thing would be if each global function was declared in its own package
73// and then used where needed rather than tying them into some wider package like this or cWorkspace.pkg.
74#IFDEF Get_LastDelimeter
75#ELSE
76Function LastDelimeter Global String sDelimeters String sString Returns Integer
77 // Returns last position of any sDelimeters in the sString
78 Integer iPos
79
80 Move (Length(sString) ) to iPos
81 While (iPos >0)
82 If (Mid(sString, 1, iPos)) In sDelimeters Function_Return iPos
83 Decrement iPos
84 Loop
85 Function_Return 0
86End_Function
87
88Function ExtractFilePath Global String sFileName Returns String
89 // Returns a path from a filename. "c:\Ide\Test\AbData.pkg" would return "c:\Ide\Test\"
90 Integer iPos
91 Move (LastDelimeter("\:", sFileName)) to iPos
92 Function_Return (Left(sFileName, iPos))
93End_Function
94
95Function IsFileNameQualified Global String sFileName Returns Integer
96 Function_Return (ExtractFilePath(sFileName) <> "")
97End_Function
98
99Function ExtractFileName Global String sFileName Returns String
100 // Returns a name from a fully-qualified filename. Eg: "c:\Test\IDE.src" will return "IDE.src"
101 Integer iPos
102
103 Move (LastDelimeter("\:", sFileName)) to iPos
104
105 Function_Return (Right(sFileName, Length(sFileName) -iPos))
106End_Function
107
108#ENDIF
109
110// ExtractFileExt
111// --------------
112
113#IFDEF Get_ExtractFileExt
114#ELSE
115 // Returns an extension from a filename: "c:\Test\IDE.src" will return ".src"
116 // See also ExtractFilePath()
117 Function ExtractFileExt Global String sFileName Returns String
118 Integer iPos
119
120 Move (LastDelimeter("\:.", sFileName)) to iPos
121
122 If ((iPos > 0) and (Mid(sFileName, 1, iPos) = ".")) Function_Return (Right(sFileName, Length(sFileName) - iPos + 1))
123 Else Function_Return ""
124 End_Function
125#ENDIF
126
127
128Define IL_AutoTransparency for -1
129
130Class cImageList32 is a cImageList
131
132 Procedure Construct_Object
133 Forward Send Construct_Object
134
135 // ILC_COLOR
136 // Use the default color depth. Typically, the default is ILC_COLOR4, but for older display drivers,
137 // the default is ILC_COLORDDB.
138 // ILC_COLOR4
139 // Use a 4-bit (16-color) device-independent bitmap (DIB) section as the bitmap for the image list.
140 // ILC_COLOR8
141 // Use an 8-bit DIB section. The colors used for the color table are the same colors as the halftone palette.
142 // ILC_COLOR16
143 // Use a 16-bit (32/64k-color) DIB section.
144 // ILC_COLOR24
145 // Use a 24-bit DIB section.
146 // ILC_COLOR32
147 // Use a 32-bit DIB section.
148 // ILC_COLORDDB
149 // Use a device-dependent bitmap.
150 { Category=Appearance }
151 { EnumList= "ILC_Color, ILC_COLOR4, ILC_COLOR8, ILC_COLOR16, ILC_COLOR24, ILC_COLOR32, ILC_COLORDDB" }
152 Property Integer peColorDepth ILC_Color32
153 End_Procedure // Construct_Object
154
155
156 // DoCreate:
157
158 // Overridden superclass method to create image list of the required color depth.
159 Procedure DoCreate
160 Integer cx cy dwFlags icInitial iGrowBy
161 Integer eColorDepth
162
163 Get piImageHeight to cy
164 Get piImageWidth to cx
165 Get piMaxImages to iGrowBy
166 Get peColorDepth to eColorDepth
167
168 If (eColorDepth = 0) Move ILC_COLOR32 to eColorDepth
169
170 Move (eColorDepth + ILC_MASK) to dwFlags
171
172 Set phImageList to (ImageList_Create(cx, cy, dwFlags, 0, iGrowBy))
173 End_Procedure // DoCreate
174
175
176 // AddBitmap
177 // ---------
178
179 // Use this function to add a Bitmap, to the imagelist. All images will be scaled to 16x16 pixels.
180 // If you do not specify a transparency color then the top left pixel is used to identify the transparent color.
181 //
182 // See also AddImage, AddCursor, AddIcon.
183 //
184 // sImage - is the image filename being loaded.
185 // iTransparentColor - Is the RGB color value used as a transparency mask. If you pass IL_AutoTransparency then the
186 // color of the top left pixel in the bitmap will be used as the transparency mask color.
187 // Returns - The image index of the loaded image or -1 if an error occurs.
188 Function AddBitmap String sImage Integer iTransparentColor Returns Integer
189 Integer iImage iVoid
190 Handle hImage
191 Boolean bOK
192
193 Move -1 to iImage // assume inability to add
194
195 Move (LoadImage(GetModuleHandle(0), sImage, IMAGE_BITMAP, 0, 0, LR_DEFAULTSIZE)) to hImage
196
197 If (hImage = 0) Begin // the bitmap was not in the EXE resource
198 Get_File_Path sImage to sImage // find path in DFPATH, if appropriate
199
200 If (sImage <> "") Begin // The image was found!
201 Move (LoadImage(0, sImage, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE + LR_DEFAULTSIZE)) to hImage
202 End
203 End
204
205 If (hImage <> 0) Begin
206 If (iTransparentColor = IL_AutoTransparency) Begin
207 // Get the bitmap's transparent color....
208 Handle hdc hOldObject
209
210 Move (CreateCompatibleDC(0)) to hdc
211 Move (SelectObject(hdc, hImage)) to hOldObject
212 Move (GetPixel(hdc, 0, 0)) to iTransparentColor
213 Move (DeleteDC(hdc)) to bOK
214 End
215
216 // Add the image list....
217 Move (ImageList_AddMasked(phImageList(Self), hImage, iTransparentColor)) to iImage
218 Move (DeleteObject(hImage)) to iVoid
219 End
220
221 Function_Return iImage
222 End_Function // AddBitmap
223
224
225 // AddCursor
226 // ---------
227
228 // Use this function to add a cursor, to the imagelist. All images will be scaled to 16x16 pixels.
229 //
230 // See also AddImage, AddBitmap, AddIcon.
231 //
232 // sImage - is the image filename being loaded.
233 // Returns - The image index of the loaded image or -1 if an error occurs.
234 Function AddCursor String sImage Returns Integer
235 Integer iImage iVoid
236 Handle hImage
237 Boolean bOK
238
239 Move -1 to iImage // assume inability to add
240
241 Get_File_Path sImage to sImage // find path in DFPATH, if appropriate
242
243 If (sImage <> "") Begin // The image was found!
244 Move (LoadImage(0, sImage, IMAGE_CURSOR, 0, 0, LR_LOADFROMFILE + LR_DEFAULTSIZE)) to hImage
245 End
246
247 If (hImage <> 0) Begin
248 Move (ImageList_ReplaceIcon(phImageList(Self), -1, hImage)) to iImage
249 Move (DestroyCursor(hImage)) to iVoid
250 End
251
252 Function_Return iImage
253 End_Function // AddCursor
254
255
256 // AddIcon
257 // -------
258
259 // Use this function to add a icon, to the imagelist. All images will be scaled to 16x16 pixels.
260 //
261 // See also AddImage, AddBitmap, AddCursor.
262 //
263 // sImage - is the image filename being loaded.
264 // Returns - The image index of the loaded image or -1 if an error occurs.
265 Function AddIcon String sImage Returns Integer
266 Integer iImage iVoid
267 Handle hImage
268 Boolean bOK
269
270 Move -1 to iImage // assume inability to add
271
272 Move (LoadImage(GetModuleHandle(0), sImage, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE)) to hImage
273
274 If (hImage = 0) Begin // the bitmap was not in the EXE resource
275 Get_File_Path sImage to sImage // find path in DFPATH, if appropriate
276
277 If (sImage <> "") Begin // The image was found!
278 Move (LoadImage(0, sImage, IMAGE_ICON, 0, 0, LR_LOADFROMFILE + LR_DEFAULTSIZE)) to hImage
279 End
280 End
281
282 If (hImage <> 0) Begin
283 Move (ImageList_ReplaceIcon(phImageList(Self), -1, hImage)) to iImage
284 Move (DestroyIcon(hImage)) to iVoid
285 End
286
287 Function_Return iImage
288 End_Function // AddIcon
289
290
291 // AddImage
292 // --------
293
294 // Use this function to add a Bitmap, Icon, or Cursor to the imagelist. All images will be scaled to 16x16 pixels.
295 // The type is determined by the file extension in the passed image name: .bmp = bitmap, .ico = icon, .cur = cursor.
296 // For bitmaps the top left pixel is used to identify the transparent color. Semi-transparent pixels in alpha-blend
297 // icons are rendered as black pixels.
298 //
299 // See also AddBitmap, AddCursor, AddIcon.
300 //
301 // sImage - is the image filename being loaded.
302 // Returns - the image index of the loaded image or -1 if an error occurs.
303 Function AddImage String sImage Returns Integer
304 Integer iImage
305 String sExt
306
307 Move -1 to iImage // assume inability to add
308
309 // Determine the file type....
310 Move (Uppercase(ExtractFileExt(sImage))) to sExt
311
312 Case Begin
313 Case (sExt = ".ICO") // icon
314 Get AddIcon sImage to iImage
315 Case Break
316
317 Case (sExt = ".CUR") // cursor
318 Get AddCursor sImage to iImage
319 Case Break
320
321 Case Else // for all others assume bitmap
322 Get AddBitmap sImage IL_AutoTransparency to iImage
323 Case Break
324 Case End
325
326 Function_Return iImage
327 End_Function // AddImage
328End_Class // cImageList32