1Use vdfBase.pkg
2Use Commctrl.pkg
3Use WinGDI.pkg
4
5// Note these constants are also defined in cStatusPane.pkg!! This should be moved somewhere else.
6Define IMAGE_BITMAP for 0
7Define IMAGE_ICON for 1
8Define IMAGE_CURSOR for 2
9
10Define LR_DEFAULTSIZE for |CI$0040
11Define LR_LOADFROMFILE for |CI$0010
12
13Define clDefault for |CI$FF000000
14Define clNone for |CI$FFFFFFFF
15
16// Changes 12.1
17// ------------
18// [JvH] Fixed RemoveAllImages method. Previously sending this message raised an error and did nothing.
19
20Enum_List // cImageList.peDrawingStyle
21 Define dsNormal
22 Define dsFocus
23 Define dsSelected
24 Define dsTransparent
25End_Enum_List
26
27Enum_List // cImageList.peImageType
28 Define itImage
29 Define itMask
30End_Enum_List
31
32
33{ HelpTopic=cImageList }
34Class cImageList is a cObject
35 Procedure Construct_Object
36 Forward Send Construct_Object
37
38 { Visibility=Private }
39 Property Integer private_piBackColor clNone // -1
40 { Category=Behavior }
41 Property Integer piMaxImages 0
42 { DesignTime=False }
43 Property Handle phImageList 0
44 { Category=Appearance }
45 Property Integer piImageWidth 16
46 { Category=Appearance }
47 Property Integer piImageHeight 16
48
49 // These properties are not implemented yet...
50 // Property Integer piBlendColor clNone // -1
51 // Property Integer peDrawingStyle c_dsNormal // c_dsNormal, c_dsFocus, c_dsSelected, c_dsTransparent
52 // Property Integer peImageType c_itImage // c_itImage, c_itMask
53 // Property Integer pbMasked True
54 End_Procedure
55
56 { MethodType=Property }
57 { PropertyType=Color }
58 { EnumList= "clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
59 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
60 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
61 { Category=Appearance }
62 { InitialValue=clNone }
63 Procedure Set piBackColor Integer iColor
64 Integer iVoid
65 Handle hImageList
66
67 Set Private_piBackColor to iColor
68 Get phImageList to hImageList
69
70 If hImageList Move (ImageList_SetBkColor(hImageList, iColor )) to iVoid
71 End_Procedure
72
73 { MethodType=Property }
74 Function piBackColor Returns Integer
75 Function_Return (Private_piBackColor(Self))
76 End_Function
77
78 { MethodType=Event }
79 Procedure OnCreate
80 // Add images here
81 End_Procedure
82
83 Procedure End_Construct_Object
84 Integer iVoid
85
86 Send DoCreate
87 Send OnCreate
88 Set piBackColor to (Private_piBackColor(Self))
89
90 Forward Send End_Construct_Object
91 End_Procedure
92
93 { Visibility=Private }
94 Procedure DoCreate
95 Integer cx cy dwFlags icInitial iGrowBy
96
97 Get piImageHeight to cy
98 Get piImageWidth to cx
99 Get piMaxImages to iGrowBy
100
101 Move (ILC_COLOR + ILC_MASK) to dwFlags // only 16-color bitmaps are supported here.
102
103 Set phImageList to (ImageList_Create(cx, cy, dwFlags, 0, iGrowBy))
104 End_Procedure
105
106 { MethodType=Event NoDoc=True }
107 Procedure Destroy_Object
108 Integer iVoid
109
110 If (phImageList(Self)) Move (ImageList_Destroy(phImageList(Self))) to iVoid
111 Forward Send Destroy_Object
112 End_Procedure
113
114 Function AddTransparentImage String sImage Integer iTransparentColor Returns Integer
115 Handle hBitmap
116 Integer iVoid iImage
117
118 Move -1 To iImage // assume inability to add
119
120 Move (LoadImage(GetModuleHandle(0), sImage, IMAGE_BITMAP, 0, 0, 0)) To hBitmap
121 If (hBitmap =0) Begin // the bitmap was not in the EXE resource
122 Get_File_Path sImage To sImage // find path in DFPATH, if appropriate
123 If (sImage <>"") Begin // The image was found!
124 Move (LoadImage(0, sImage, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)) To hBitmap
125 End
126 End
127
128 If hBitmap Begin
129 Move (ImageList_AddMasked(phImageList(self), hBitmap, iTransparentColor)) To iImage
130 Move (DeleteObject(hBitmap)) To iVoid
131 End
132
133 Function_Return iImage
134 End_Function
135
136 Function AddImage String sImage Returns Integer
137 Handle hBitmap
138 Integer iVoid iImage
139
140 Move -1 To iImage // assume inability to add
141
142 Move (LoadImage(GetModuleHandle(0), sImage, IMAGE_BITMAP, 0, 0, 0)) To hBitmap
143 If (hBitmap =0) Begin // the bitmap was not in the EXE resource
144 Get_File_Path sImage To sImage // find path in DFPATH, if appropriate
145 If (sImage <>"") Begin // The image was found!
146 Move (LoadImage(0, sImage, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)) To hBitmap
147 End
148 End
149
150 If hBitmap Begin
151 Move (ImageList_AddMasked(phImageList(self), hBitmap, 0)) To iImage
152 Move (DeleteObject(hBitmap)) To iVoid
153 End
154
155 Function_Return iImage
156 End_Function
157
158 Function ImageCount Returns Integer
159 Handle hImageList
160 Integer icImage
161
162 Move 0 to icImage
163 Get phImageList to hImageList
164 If hImageList Move (ImageList_GetImageCount(hImageList)) to icImage
165
166 Function_Return icImage
167 End_Function
168
169 Procedure RemoveImage Integer iIndex
170 Handle hImageList
171 Boolean bRemoved
172
173 Get phImageList to hImageList
174 If hImageList Move (ImageList_Remove(hImageList, iIndex)) to bRemoved
175 End_Procedure
176
177 Procedure RemoveAllImages
178 Handle hImageList
179 Boolean bRemoved
180
181 Get phImageList to hImageList
182 If hImageList Move (ImageList_Remove(hImageList, -1)) to bRemoved //JVH
183 End_Procedure
184
185 { MethodType=Property Visibility=Private }
186 Function Window_Handle Returns Integer
187 // This is required for TreeView support!
188 Function_Return (phImageList(Self))
189 End_Function
190End_Class