Module cApplication.pkg
1// cApplication.pkg
2// Author: SWB
3
4// Mar 1, 2002 SWB changed the order of the DoOpenWorkspace method to try to load the file from the path before looking in the Registered list
5// Mar 13, 2000 SWB changed the GetApplicationFileName method to use a safer method of retrieving the filename from the OS
6// Mar 13, 2000 SWB changed the default of psProgram to use Module_Name, as this works across chained-to programs
7
8Use Windows.pkg
9Use LanguageText.pkg
10Use WinUser.pkg
11Use WinShell.pkg
12Use cWorkspace.pkg
13Use cCommandLine.pkg
14Use cRegistry.pkg
15Use cVersionInfo.pkg
16Use GlobalFunctionsProcedures.pkg
17Use Dferror.pkg
18Use tWinStructs.pkg
19
20Register_Function phoWorkspace Returns Handle
21Register_Function phoCommandLine Returns Handle
22Register_Function pbEnterKeyAsTabKey Returns Boolean
23Register_Function GetApplicationName Returns String
24Register_Function GetApplicationFileName Returns String
25
26Register_Function Statusbar_State Returns Integer
27Register_Function Toolbar_State Returns Integer
28Register_Procedure Set Statusbar_State
29Register_Procedure Set Toolbar_State
30
31{ ClassLibrary=Common }
32{ HelpTopic=cApplication }
33Class cApplication is a cObject
34 Procedure Construct_Object
35 Forward Send Construct_Object
36
37 Move self To ghoApplication
38
39 { Category=Behavior }
40 { DesignTime=False }
41 Property Handle phoVersionInfo
42 { Category=Behavior }
43 { DesignTime=False }
44 Property Handle phoWorkspace
45 { Category=Behavior }
46 { DesignTime=False }
47 Property Handle phoCommandLine
48 { Category=Behavior }
49 { DesignTime=False }
50 Property Handle phoMainPanel // main panel will set this for us.
51 { Category=Help }
52 Property String psHelpFile // type of file is determined by peHelpType
53 { Category=Help }
54 { EnumList="htNoHelp, htHtmlHelp, htWinHelp" }
55 Property Integer peHelpType htWinHelp // htNoHelp htHtmlHelp htWinHelp
56
57 { Category=Behavior }
58 Property String psCompany "Data Access Worldwide"
59 { Category=Behavior }
60 Property String psProduct "Visual DataFlex Applications"
61 { Category=Behavior }
62 Property String psVersion "1"
63 { Category=Behavior }
64 Property String psProgram (Module_Name(desktop))
65
66 // set to '' to stop the auto open workspace behavior
67 { Category=Behavior }
68 Property String psAutoOpenWorkspace 'Config.ws'
69
70
71 { Category=Behavior }
72 Property Boolean pbPreserveEnvironment True
73
74 Object oCommandLine is a cCommandLine
75 delegate Set phoCommandLine To self
76 End_Object
77
78 Object oWorkspace is a cWorkspace
79 delegate Set phoWorkspace To self
80 End_Object
81
82 Object oVersionInfo is a cVersionInfo
83 delegate Set phoVersionInfo To self
84 Send DoCreate (GetApplicationFileName(parent(self)))
85 End_Object
86
87 End_Procedure
88
89 //************************************************************************************
90 // Get/Set pbEnterKeyAsTabKey
91 // Determines if the Enter key should act like the Tab key (and send msg_Next)
92 // The use of a global variable, gbKEnterNext, makes this an application-wide property
93 //************************************************************************************
94 { MethodType=Property }
95 { InitialValue=False }
96 { Category=Behavior }
97 Procedure Set pbEnterKeyAsTabKey Boolean bNext
98 Move bNext to gbKEnterNext
99 End_Procedure
100
101 { MethodType=Property }
102 Function pbEnterKeyAsTabKey Returns Boolean
103 Function_Return gbKEnterNext
104 End_Function
105
106 Procedure DoLoadEnvironment Handle hoContainer Boolean bProgram
107// not used with webapp
108#IFNDEF IS$WEBAPP
109 Handle hoRegistry hoCommandBars
110 Integer iError cxy
111 tWinWindowPlacement WindowPlacement
112 String sKey
113 Boolean bSuccess
114 String sObjectName
115
116 If (pbPreserveEnvironment(self)) Begin
117 Get Create U_cRegistry To hoRegistry
118 Set pfAccessRights of hoRegistry To KEY_READ
119
120 Get RegistryKeyString To sKey
121
122 If (bProgram = False) Begin
123 Move (sKey +"\WINDOWS") To sKey
124 Get Object_Label of hoContainer To sObjectName // just get the local name
125 Move (sKey +"\" +sObjectName) To sKey
126 End
127 Else ;
128 Move (sKey + "\Preferences") To sKey
129
130 Get OpenKey of hoRegistry sKey To bSuccess
131
132 If bSuccess Begin
133 If (ValueExists(hoRegistry, 'Placement')) Begin
134 Get ReadBinary of hoRegistry "Placement" (AddressOf(WindowPlacement)) (SizeOfType(tWinWindowPlacement)) to bSuccess
135 If bSuccess Begin
136 // Do not restore size if the window is not resizable
137 If (Border_Style(hoContainer) <> BORDER_THICK) Begin
138 // restore always works with outer size
139 Get GuiWindowSize of hoContainer to cxy
140 Move (WindowPlacement.NormalPosition.left + Low(cxy)) to WindowPlacement.NormalPosition.right
141 Move (WindowPlacement.NormalPosition.top + Hi(cxy)) to WindowPlacement.NormalPosition.bottom
142 End
143 Move (SetWindowPlacement(Window_Handle(hoContainer), AddressOf(WindowPlacement))) to bSuccess
144 End
145 End
146 If bProgram Begin
147 Get phoCommandBars of hoContainer to hoCommandBars
148 If not hoCommandBars Begin
149 If (ValueExists(hoRegistry, 'IsStatusBarVisible')) ;
150 Set Statusbar_State of hoContainer to (ReadDword(hoRegistry, 'IsStatusBarVisible'))
151 If (ValueExists(hoRegistry, 'IsToolBarVisible')) ;
152 Set Toolbar_State of hoContainer to (ReadDword(hoRegistry, 'IsToolBarVisible'))
153 End
154 End
155
156 Send CloseKey of hoRegistry
157 End
158
159 Send Destroy of hoRegistry
160 End
161#ENDIF
162 End_Procedure
163
164 Procedure DoSaveEnvironment Handle hoContainer Boolean bProgram
165// not used with webapp
166#IFNDEF IS$WEBAPP
167 Handle hoRegistry
168 Integer iError
169 tWinWindowPlacement WindowPlacement
170 String sKey
171 Boolean bSuccess
172 Integer eShowCmd
173 String sObjectName
174
175 If (pbPreserveEnvironment(self)) Begin
176 Get Create U_cRegistry To hoRegistry
177 Get RegistryKeyString To sKey
178
179 If (bProgram = False) Begin
180 Move (sKey +"\WINDOWS") To sKey
181 Get Object_Label of hoContainer To sObjectName // just get the local name
182 Move (sKey +"\" +sObjectName) To sKey
183 End
184 Else ;
185 Move (sKey +"\Preferences") To sKey
186
187 Get CreateKey of hoRegistry sKey To iError
188 If (iError = 0) Begin
189 Move (SizeOfType(tWinWindowPlacement)) to WindowPlacement.length
190 Move (GetWindowPlacement(Window_Handle(hoContainer), AddressOf(WindowPlacement))) to bSuccess
191 If bSuccess Begin
192 // if minimized, assume restored, as we don't want to restart minimized!
193 If (WindowPlacement.showCmd = SW_SHOWMINIMIZED) Begin
194 Move SW_SHOWNORMAL to WindowPlacement.showCmd
195 End
196 Send WriteBinary of hoRegistry "Placement" (AddressOf(WindowPlacement)) WindowPlacement.length
197 End
198
199 If bProgram Begin
200 Send WriteDword of hoRegistry 'IsStatusBarVisible' (Statusbar_State(hoContainer))
201 Send WriteDword of hoRegistry 'IsToolBarVisible' (Toolbar_State(hoContainer))
202 End
203
204
205 Send CloseKey of hoRegistry
206 End
207
208 Send Destroy of hoRegistry
209 End
210#ENDIF
211 End_Procedure
212
213 Function RegistryKeyString Returns String
214 String sCompany sProduct sVersion sProgram
215
216 Get psCompany To sCompany
217 Get psProduct To sProduct
218 Get psVersion To sVersion
219 Get psProgram To sProgram
220
221 If (sCompany = "") Move "Data Access Worldwide" To sCompany
222 If (sProduct = "") Move "Visual DataFlex Applications" To sProduct
223 If (sVersion = "") Move "1" To sVersion
224 If (sProgram ="") Move (Module_Name(desktop)) To sProgram
225
226 Function_Return ("SOFTWARE\" +sCompany +"\" +sProduct +"\" +sVersion +"\" +sProgram)
227 End_Function
228
229 Procedure WriteString String sSubKey String sValueName String sValueData
230 String sKey
231 Handle hoRegistry
232 Integer iError
233
234 Get Create U_cRegistry To hoRegistry
235 Get RegistryKeyString To sKey
236 If (sSubKey <>"") Move (sKey +'\' +sSubKey) To sKey
237 Get CreateKey of hoRegistry sKey To iError
238 If (iError = 0) Begin
239 Send WriteString of hoRegistry sValueName sValueData
240 Send CloseKey of hoRegistry
241 End
242
243 Send Destroy of hoRegistry
244 End_Procedure
245 Procedure WriteDword String sSubKey String sValueName Dword dwValueData
246 String sKey
247 Handle hoRegistry
248 Integer iError
249
250 Get Create U_cRegistry To hoRegistry
251 Get RegistryKeyString To sKey
252 If (sSubKey <>"") Move (sKey +'\' +sSubKey) To sKey
253 Get CreateKey of hoRegistry sKey To iError
254 If (iError = 0) Begin
255 Send WriteDword of hoRegistry sValueName dwValueData
256 Send CloseKey of hoRegistry
257 End
258
259 Send Destroy of hoRegistry
260 End_Procedure
261 Procedure WriteBinary String sSubKey String sValueName Address aValueData Integer iDataLength
262 String sKey
263 Handle hoRegistry
264 Integer iError
265
266 Get Create U_cRegistry To hoRegistry
267 Get RegistryKeyString To sKey
268 If (sSubKey <>"") Move (sKey +'\' +sSubKey) To sKey
269 Get CreateKey of hoRegistry sKey To iError
270 If (iError = 0) Begin
271 Send WriteBinary of hoRegistry sValueName aValueData iDataLength
272 Send CloseKey of hoRegistry
273 End
274
275 Send Destroy of hoRegistry
276 End_Procedure
277
278 // returns true if both sub-key and value exists.
279 Function ValueExists string sSubKey string sValueName returns Boolean
280 String sKey
281 Handle hoRegistry
282 Boolean bOK
283 Get Create U_cRegistry To hoRegistry
284 Get RegistryKeyString To sKey
285 If (sSubKey <>"") Move (sKey +'\' +sSubKey) To sKey
286 Get OpenKey of hoRegistry sKey To bOk
287 If (bOK) Begin
288 Move (ValueExists(hoRegistry, sValueName)) TO bOk
289 Send CloseKey of hoRegistry
290 End
291 Send Destroy of hoRegistry
292 Function_Return bOk
293 End_Function
294
295 Function ReadString String sSubKey String sValueName string sDefault Returns String
296 String sKey sData
297 Handle hoRegistry
298 Boolean bOK
299
300 Move sDefault to sData
301 Get Create U_cRegistry To hoRegistry
302 Get RegistryKeyString To sKey
303 If (sSubKey <>"") Move (sKey +'\' +sSubKey) To sKey
304 Get OpenKey of hoRegistry sKey To bOk
305 If (bOK) Begin
306 If (ValueExists(hoRegistry, sValueName)) ;
307 Get ReadString of hoRegistry sValueName To sData
308 Send CloseKey of hoRegistry
309 End
310
311 Send Destroy of hoRegistry
312 Function_Return sData
313 End_Function
314
315 Function ReadDword String sSubKey String sValueName dword dwDefault Returns DWord
316 String sKey
317 DWord dwData
318 Handle hoRegistry
319 Boolean bOK
320
321 Move dwDefault to dwData
322 Get Create U_cRegistry To hoRegistry
323 Get RegistryKeyString To sKey
324 If (sSubKey <>"") Move (sKey +'\' +sSubKey) To sKey
325 Get OpenKey of hoRegistry sKey To bOk
326 If bOK Begin
327 If (ValueExists(hoRegistry, sValueName)) ;
328 Get ReadDword of hoRegistry sValueName To dwData
329 Send CloseKey of hoRegistry
330 End
331
332 Send Destroy of hoRegistry
333 Function_Return dwData
334 End_Function
335
336 Function ReadBinary String sSubKey String sValueName Address aValueData Integer iDataLength Returns Boolean
337 String sKey
338 Handle hoRegistry
339 Boolean bOK bSuccess
340
341 Get Create U_cRegistry To hoRegistry
342 Get RegistryKeyString To sKey
343 If (sSubKey <>"") Move (sKey +'\' +sSubKey) To sKey
344 Get OpenKey of hoRegistry sKey To bOk
345 If bOK Begin
346 Get ReadBinary of hoRegistry sValueName aValueData iDataLength To bSuccess
347 Send CloseKey of hoRegistry
348 End
349
350 Send Destroy of hoRegistry
351 Function_Return bSuccess
352 End_Function
353
354 Procedure DoOpenWorkspace String sWorkspace
355 // Tries to open in this order:
356 // 1) if absolute path, use that; otherwise
357 // 2) try to open in the path of the EXE; otherwise
358 // 3) load it via the Registered list
359
360 Integer eOpened
361 String sError sWSFile
362 Handle hoWorkspace
363
364 // As soon as an open is attempted, the application's object psAutoOpenWorkspace property
365 // is cleared. This way any attempt to manually open a workspace during its construction,
366 // which includes OnCreate, will stop the object from attempting to automatically open the
367 // workspace. This was added to make psAutoOpenWorkspace compatible with older applications.
368 // Typically these application will open a workspace in OnCreate. If this happens we assume
369 // that there should be no automatic opening of a worskpace.
370 Set psAutoOpenWorkspace to ""
371
372 Get phoWorkspace to hoWorkspace
373
374 Get OpenWorkspaceFile of hoWorkspace sWorkspace To eOpened
375 If (eOpened = wsWorkspaceFileNotFound) Begin
376 If (IsRegistered(hoWorkspace, sWorkspace) =True) Begin
377 Get OpenWorkspace of hoWorkspace sWorkspace To eOpened
378 End
379 End
380 If (eOpened <> wsWorkspaceOpened) Begin
381 Get OpenWorkspaceErrorMessage of hoWorkspace eOpened To sError
382 Get psWorkspaceWSFile of hoWorkspace to sWSFile
383 Error DFERR_CAPPLICATION (SFormat(C_$TheProgramCannotRun, sWorkspace) + ":\n\n" + if(sWSFile<>"",sWSfile+"\n\n","") +sError)
384 Abort
385 End
386 End_Procedure
387
388 { MethodType=Event }
389 Procedure OnCreate
390 // Event called when the Application object is ready to be used
391 // to open a Workspace, etc.
392 End_Procedure
393
394 Procedure End_Construct_Object
395 String sName
396 Forward Send End_Construct_Object
397 Send OnCreate
398 // note that psAutoOpenWorkspace will get cleared of OnCreate attempts to open a workspace
399 Get psAutoOpenWorkspace to sName
400 If (sName<>"") Begin
401 Send DoOpenWorkspace sName
402 end
403 End_Procedure
404
405 Function GetApplicationFileName Returns String
406 // Returns the filename from Windows
407 Integer iNumChars
408 String sFilename
409
410 Move (Repeat(Character(0), 1024)) To sFileName
411 Move (GetModuleFileName(0, AddressOf(sFilename), 1024)) To iNumChars
412
413 Function_Return (CString(sFilename))
414 End_Function
415
416 Function GetApplicationPath Returns String
417 // Returns the path of the Application (no trailing "\")
418 String sApplicationFileName sPath
419 Boolean bRemoved
420
421 Get GetApplicationFileName To sApplicationFileName
422 Move (PathRemoveFileSpec(AddressOf(sApplicationFileName))) To bRemoved
423 Move (CString(sApplicationFileName)) To sPath
424
425 If (Right(sPath, 1) ="\") Move (Left(sPath, Length(sPath) -1)) To sPath
426 Function_Return sPath
427 End_Function
428
429 Function GetApplicationName Returns String
430 // Returns the name of the Application (without its Path or Extension)
431 String sApplicationFileName sApplicationName
432 Boolean bRemoved
433 Integer iVoid
434
435 Get GetApplicationFileName To sApplicationFileName
436 Move (ExtractFileName(sApplicationFileName)) To sApplicationName
437 Move (PathRemoveExtension(AddressOf(sApplicationName))) To iVoid
438 Function_Return (CString(sApplicationName))
439 End_Function
440
441End_Class
442
443