Module cCJSkinFramework.pkg
1Use windows.pkg
2Use cCJComSkinFramework.pkg
3Use cApplication.pkg
4
5// todo: move to fmac
6#Replace msg_EnableVisualStyles |CI$069b
7#IFDEF 0
8 Procedure EnableVisualStyles Boolean bEnable
9 End_Procedure
10#ENDIF
11
12Struct tSkinInformation
13 String sName // description of the skin
14 String sSkinfile // file path. Can be relative or full
15 String sSkinIni // section name
16End_Struct
17
18{ DesignerClass=None }
19{ OverrideProperty=Border_Style DesignTime=False }
20{ OverrideProperty=Enabled_State DesignTime=False }
21{ OverrideProperty=Color DesignTime=False }
22{ OverrideProperty=Label DesignTime=False }
23{ OverrideProperty=Label_Col_Offset DesignTime=False }
24{ OverrideProperty=Label_Row_Offset DesignTime=False }
25{ OverrideProperty=Label_Justification_Mode DesignTime=False }
26{ OverrideProperty=Label_Color DesignTime=False }
27{ OverrideProperty=Label_FontItalics DesignTime=False }
28{ OverrideProperty=Label_FontSize DesignTime=False }
29{ OverrideProperty=Label_FontUnderline DesignTime=False }
30{ OverrideProperty=Label_FontWeight DesignTime=False }
31{ OverrideProperty=Label_TextColor DesignTime=False }
32{ OverrideProperty=Label_TypeFace DesignTime=False }
33{ OverrideProperty=Location DesignTime=False }
34{ OverrideProperty=Size DesignTime=False }
35{ OverrideProperty=peAnchors DesignTime=False }
36{ OverrideProperty=piMinSize DesignTime=False }
37{ OverrideProperty=TextColor DesignTime=False }
38{ OverrideProperty=Visible_state DesignTime=False }
39{ OverrideProperty=Attach_Parent_State DesignTime=False }
40{ OverrideProperty=Block_Mouse_state DesignTime=False }
41{ OverrideProperty=Delegation_Mode DesignTime=False }
42{ OverrideProperty=Client_Area_State DesignTime=False }
43{ OverrideProperty=Focus_Mode DesignTime=False }
44{ OverrideProperty=pbBindValue DesignTime=False }
45{ OverrideProperty=peAutoCreate DesignTime=False }
46{ OverrideProperty=peNeighborhood DesignTime=False }
47{ OverrideProperty=Popup_State DesignTime=False }
48{ OverrideProperty=Ring_State DesignTime=False }
49{ OverrideProperty=Search_Case DesignTime=False }
50{ OverrideProperty=Skip_State DesignTime=False }
51{ OverrideProperty=Scope_State DesignTime=False }
52{ OverrideProperty=Help_Id DesignTime=False }
53{ OverrideProperty=Help_Keyword DesignTime=False }
54{ OverrideProperty=psHtmlHelpTopic DesignTime=False }
55{ OverrideProperty=Status_Help DesignTime=False }
56{ OverrideProperty=Use_Parent_Status_Help DesignTime=False }
57{ OverrideProperty=psLicenseKey DesignTime=False }
58{ OverrideProperty=psProgId DesignTime=False }
59
60Class cCJSkinFramework is a cCJComSkinFramework
61
62 Procedure Construct_Object
63 Forward Send Construct_Object
64
65 { Category="Appearance" }
66 { PropertyType=SkinFile }
67 Property String psSkinFile ""
68 { Category="Appearance" }
69 { PropertyType=SkinIni }
70 Property String psSkinIni ""
71 { Category="Behavior" }
72 Property Boolean pbLoadPreference False
73
74 Set peAutoCreate to acAutoCreate
75
76 Move Self to ghoSkinFramework
77 End_Procedure
78
79 // return the default skin path, which is the programs directory.
80 // This requires an application object.
81 // If you want to different skin path, override this.
82 Function SkinPath Returns String
83 String sPath sPaths
84 Handle hoWorkspace
85 If ghoApplication Begin
86 Get phoWorkspace of ghoApplication to hoWorkspace
87 Get psProgramPath of hoWorkspace to sPaths
88 Get PathAtIndex of hoWorkspace sPaths 1 to sPath
89 End
90 Else Begin
91 Error DFERR_PROGRAM C_$ApplicationObjectNotCreated
92 End
93 Function_Return sPath
94 End_Function
95
96 // Returns the Qualified name of psSkinFile. If the file is already qualified it just
97 // returns itself. If it is not, it uses SkinPath to get the path.
98 Function SkinQFile Returns String
99 String sFile sPath sSep
100 Boolean bQualified
101 Get psSkinFile to sFile
102 If not (IsFileNameQualified(sFile)) Begin
103 Get SkinPath to sPath
104 Move (SysConf(SYSCONF_DIR_SEPARATOR)) to sSep
105 Move (sPath - sSep - sFile) to sFile
106 End
107 Function_Return sFile
108 End_Function
109
110 // defines the default VDF window class mapping.
111 { Visibility=Private }
112 { MethodType=Event }
113 Procedure OnAddVDFWindowClasses
114 Send ComAddWindowClass "DFlistbox" "ListBox"
115 Send ComAddWindowClass "DFentry" "Edit"
116 Send ComAddWindowClass "DFtextbox" "Edit"
117 Send ComAddWindowClass "DFRichEditCtrl" "Edit"
118 Send ComAddWindowClass "DFcombobox" "ComboBox"
119 Send ComAddWindowClass "DFformlist" "Edit"
120 Send ComAddWindowClass "DFFormListHeader" "SysHeader32"
121 Send ComAddWindowClass "DFbutton" "Button"
122 Send ComAddWindowClass "HPromptBtn" "Button"
123 Send ComAddWindowClass "Hspinbtn" "msctls_updown32"
124 Send ComAddWindowClass "DFSysTabControl32" "SysTabControl32"
125 Send ComAddWindowClass "DFMDIClient" "MDIClient"
126 Send ComAddWindowClass "DFedit" "edit"
127 Send ComAddWindowClass "DFlistedit" "edit"
128 Send ComAddWindowClass "DFscrollbar" "scrollbar"
129 Send ComAddWindowClass "DFgroup" "Button"
130 Send ComAddWindowClass "DFComboGrid" "ComboBox"
131 // External class
132 Send ComAddWindowClass "cVdfAnimation" "SysAnimate32"
133 Send ComAddWindowClass "cVdfProgressBar" "msctls_progress32"
134 Send ComAddWindowClass "cVdfStatusBar" "msctls_statusbar32"
135 Send ComAddWindowClass "cVdfToolbar" "ToolbarWindow32"
136 Send ComAddWindowClass "cObsoleteVdfProgressBar" "msctls_progress32"
137 Send ComAddWindowClass "cVdfTrackBar" "msctls_trackbar32"
138 Send ComAddWindowClass "cObsoleteBasicStatusBar" "msctls_statusbar32"
139 Send ComAddWindowClass "cVdfTreeView" "SysTreeView32"
140 End_Procedure
141
142 // Used to support developer designed class mappings (e.g. COM controls)
143 { MethodType=Event }
144 Procedure OnAddCustomWindowClasses
145 End_Procedure
146
147 // called when object is created during end_construct_object.
148 { MethodType=Event }
149 Procedure OnCreate
150 Forward Send OnCreate
151
152 // this works around a CJ issue where skins applied to other threads causes an exception upon close down.
153 // We saw this with our mssql driver but it could occur elsewhere. This has been reported in the CJ newsgroup
154 // and this was the suggested workaround.
155 Set ComAutoApplyNewThreads to False
156
157 Send OnAddVDFWindowClasses
158 Send OnAddCustomWindowClasses
159
160 // if preferences are used, it will set psSkinFile and psSkinIni
161 If (pbLoadPreference(Self)) Begin
162 Send LoadSkinPreference
163 End
164 // if a skin file name exists, we apply the skin.
165 If (psSkinFile(Self)<>"") Begin
166 Send ApplySkin
167 End
168 End_Procedure
169
170 // called by framework as part of application exit.
171 { Visibility=Private }
172 { MethodType=Event }
173 Procedure Broadcast_Notify_Exit_Application
174 Send Notify_Exit_Application
175 End_Procedure // Notify_Exit_Application
176
177 { MethodType=Event }
178 Procedure Notify_Exit_Application
179 If (pbLoadPreference(Self)) Begin
180 Send SaveSkinPreference
181 End
182 End_Procedure
183
184 { MethodType=Event }
185 { Visibility=Private }
186 Procedure NotifyPreApplySkin
187 Broadcast Send OnPreApplySkin of Desktop True
188 End_Procedure
189
190 { MethodType=Event }
191 { Visibility=Private }
192 Procedure NotifyPostApplySkin
193 Broadcast Send OnPostApplySkin of Desktop True
194 End_Procedure
195
196 // returns an array of all skins in the path. If path is "", use the default path.
197 // If the default path is used, returns the file names as relative names, else use full path.
198 Function EnumerateSkins String sPath Boolean bRecursive Returns tSkinInformation[]
199 tSkinInformation[] Skins
200 String sSkinName sSkinFile sDefaultPath sSep
201 Variant vSkinDescriptions vSkinDescription vSkinIniFile
202 Handle hSkinDescriptions hSkinDescription hSkinIniFile
203 Integer iSkinsCount iSkinFilesCount iNumSkins iNumSkinFiles iArrayItem
204 Integer iPos iDfltLen
205 Boolean bUseRelativePath
206
207 Move (SysConf(SYSCONF_DIR_SEPARATOR)) to sSep
208
209 Get SkinPath to sDefaultPath
210 If (sPath="") Begin
211 Move sDefaultPath to sPath
212 End
213 Move (Uppercase(sDefaultPath)) to sDefaultPath
214 Move (Length(sDefaultPath)) to iDfltLen
215 Move (sDefaultPath=Uppercase(sPath)) to bUseRelativePath
216
217 Get ComEnumerateSkinDirectory sPath bRecursive to vSkinDescriptions
218 If (not(IsNullComObject(vSkinDescriptions))) Begin
219
220 Get Create U_cCJSkinDescriptions to hSkinDescriptions
221 Get Create U_cCJSkinDescription to hSkinDescription
222 Get Create U_cCJSkinIniFile to hSkinIniFile
223
224 Set pvComObject of hSkinDescriptions to vSkinDescriptions
225 Get ComCount of hSkinDescriptions to iNumSkinFiles
226
227 For iSkinFilesCount from 0 to (iNumSkinFiles-1)
228 Get ComSkin of hSkinDescriptions iSkinFilesCount to vSkinDescription
229 Set pvComObject of hSkinDescription to vSkinDescription
230
231 Get ComCount of hSkinDescription to iNumSkins
232
233 For iSkinsCount from 0 to (iNumSkins-1)
234 Get ComIniFile of hSkinDescription iSkinsCount to vSkinIniFile
235 Set pvComObject of hSkinIniFile to vSkinIniFile
236
237 Get ComName of hSkinDescription to Skins[iArrayItem].sName
238 Get ComPath of hSkinDescription to sSkinFile
239 If bUseRelativePath Begin
240 Move (pos(sDefaultPath,uppercase(sSkinFile))) to iPos
241 If iPos Begin
242 Move (Remove(sSkinFile,iPos,iDfltLen)) to sSkinFile
243 While (Left(sSkinFile,1)=sSep)
244 Move (Remove(sSkinFile,1,1)) to sSkinFile
245 Loop
246 End
247 End
248 Move sSkinFile to Skins[iArrayItem].sSkinfile
249 Get ComIniFileName of hSkinIniFile to Skins[iArrayItem].sSkinIni
250
251 Increment iArrayItem
252 Loop
253 Loop
254
255 Send Destroy of hSkinDescriptions
256 Send Destroy of hSkinDescription
257 Send Destroy of hSkinIniFile
258
259 End
260 Function_Return Skins
261 End_Function
262
263 // Save the skin preference. This requires an application object.
264 // Only do this if the application object allows it.
265 // This is called during startup if pbLoadPreference is True
266 // Suitable for override
267 Procedure SaveSkinPreference
268 String sSkin sIni
269 If ghoApplication Begin
270 If (pbPreserveEnvironment(ghoApplication)) Begin
271 Get psSkinFile to sSkin
272 Get psSkinIni to sIni
273 Send WriteString of ghoApplication "Preferences" "SkinFile" sSkin
274 Send WriteString of ghoApplication "Preferences" "SkinIni" sIni
275 End
276 End
277 Else Begin
278 Error DFERR_PROGRAM C_$ApplicationObjectNotCreated
279 End
280 End_Procedure
281
282 // Load the skin preference. This requires an application object.
283 // Only do this if the application object allows it.
284 // This is called during startup if pbLoadPreference is True
285 // Suitable for override
286 Procedure LoadSkinPreference
287 String sSkin sIni
288 Boolean bExists
289 If ghoApplication Begin
290 If (pbPreserveEnvironment(ghoApplication)) Begin
291 Get ValueExists of ghoApplication "Preferences" "SkinFile" to bExists
292 If bExists Begin
293 Get ReadString of ghoApplication "Preferences" "SkinFile" "" to sSkin
294 Get ReadString of ghoApplication "Preferences" "SkinIni" "" to sIni
295 Set psSkinFile to sSkin
296 Set psSkinIni to sIni
297 End
298 End
299 End
300 Else Begin
301 Error DFERR_PROGRAM C_$ApplicationObjectNotCreated
302 End
303 End_Procedure
304
305 // Can be called to apply the current skin.
306 Procedure ApplySkin
307 Boolean bOk
308 String sSkin sIni
309 If (IsComObjectCreated(Self)) Begin
310 Get SkinQFile to sSkin
311 Get psSkinIni to sIni
312
313 Send NotifyPreApplySkin
314 // when skins are used we don't want to use built in Visual Styles
315 Send EnableVisualStyles of Desktop (sSkin="")
316 Get ComLoadSkin sSkin sIni to bOK
317 If (sSkin<>"" and not(bOk)) Begin
318 // if not ok, no skin was appied. Enable visual styles
319 Send EnableVisualStyles of Desktop True
320 End
321 Send NotifyPostApplySkin
322 End
323 End_Procedure
324
325
326End_Class