Module GlobalFunctionsProcedures.pkg
1//*************************************************************************
2//*
3//* Copyright (c) 2000 Data Access Corporation, Miami Florida,
4//* All rights reserved.
5//* DataFlex is a registered trademark of Data Access Corporation.
6//*
7//*************************************************************************
8//*
9//* Module Name:
10//* GlobalFunctionsProcedures.pkg
11//*
12//* Creator:
13//* Data Access Corporation
14//*
15//* Purpose:
16//* Module contains global functions and procedures used by VDF
17//*
18//* Modifications:
19//* 5/23/00 JJT - created file and merged from various sources
20//*************************************************************************
21//
22use VDFBase.pkg
23Use Winuser.pkg
24Use Wingdi.pkg
25Use tWinStructs.pkg
26Use errornum.inc
27
28// define first, so we can use this for strings anywhere else.
29Function SFormat Global String sText ;
30 string s1 string s2 string s3 string s4 string s5 string s6 string s7 string s8 string s9 ;
31 returns string
32 string sParam
33 integer iArg
34 If (num_arguments>10) error DFERR_WRONG_NUMBER_OF_ARGUMENTS // only allow max of 9 params
35 Move (Replaces("%%",sText,"$%$")) to sText // %% is used when you want a single % followed by a 1-9. e.g. "%%1"=%1
36 For iArg from 2 to Num_Arguments
37 MoveStr iArg& to sParam
38 Move (Replaces("%"+string(iArg-1),sText,sParam)) to sText
39 Loop
40 Move (Replaces("$%$",sText,"%")) to sText
41 function_return sText
42End_Function
43
44
45// This returns the appropriate window handle to be used when you need a handle for a modal windows
46// dialog (e.g. Message box, Open file dialog). The handle returned insures that the proper handle
47// is used that will provide the required modality. The runtime uses the same logic when creating
48// DataFlex Modal objects
49
50Function gOwnerWindowHandle global Handle hoObj Returns Handle
51 Handle hWnd hwPrnt hwTest hwOwner
52 Boolean bEnabled
53
54 If (hoObj<=Desktop) Begin // if no focus, use main_window
55 Get Main_Window of Desktop to hoObj
56 End
57 // find the first container handle.
58 If (hoObj>desktop) Begin
59 Get Container_Handle of hoObj to hWnd
60 While (hWnd=0 and hoObj>Desktop)
61 Get Parent of hoObj to hoObj
62 Get Container_Handle of hoObj to hWnd
63 End
64 End
65
66 // 12.0 change: check to make sure we have the correct owner handle for message box. If the message
67 // box is getting used within a toolpanel (or any top level panel that is not the main_window panel and is
68 // not a modal panel) then we want to use the main_window handle. When the main panel is used it will disable all other
69 // top level panels (this is 12.0 r/t change). In addition we only want to do this if windows are not already disabled.
70 // Therefore, start with the current target handle and search its parents. If the handle or any parent is disabled, we
71 // don't have to do anything. Check parents until you hit a top level window (parent=0). If this top-level parent has a
72 // gw_owner it is not the main-window (e.g. it's a toolpanel). These we must adjust. We want to use the main-window as the
73 // handle, which will give us the proper modality.
74 // A note about GetParent. This windows message returns the parent or the owner (which is different than
75 // the gw_owner). Top-level modeless windows (panel, toolpanel), return a parent of 0 (and not the gw_owner). Modal panels return
76 // the panel that owns them, which is presumably already disabled. Therefore using GetParent works for our needs.
77 If hWnd Begin
78 Move hWnd to hwPrnt
79 Repeat
80 Move (IsWindowEnabled(hwPrnt)) to bEnabled
81 If bEnabled Begin // if we encounter a disabled parent, we are done ... we don't change anything
82 Move (GetParent(hwPrnt)) to hwTest
83 If (hwTest=0) Begin // no parent, a top level window
84 Move (GetWindow(hwPrnt,GW_Owner)) to hwOwner // if this has a gw_owner, we will use that owner
85 // If top level window, either return it's owner or if no owner, that window
86 // If no owner it is probably a panel (possibly the main window), if a owner it is probably a toolpanel
87 Move (If(hwOwner,hwOwner,hwPrnt)) to hWnd // toolpanels have a gw_owner, Panels do not.
88 // so this adjusts toolpanels which is what we want
89 //If hwOwner Begin
90 //Move hwOwner to hWnd
91 //End
92 End
93 Move hwTest to hwPrnt
94 End
95 Until (not(bEnabled) or hwPrnt=0)
96 End
97 Function_Return hWnd
98End_Function
99
100
101Use LanguageText.pkg
102Use WinKern.pkg
103Use Registry.Pkg
104
105Use RGB.pkg // rgb.pkg adds globals
106 // Get RGB
107 // Get R_from_RGB
108 // Get G_from_RGB
109 // Get B_from_RGB
110
111Use MsgBox.pkg // msgbox adds globals
112 // Get Message_Box
113 // Send Info_Box
114 // Send Stop_Box
115 // Get YesNo_Box
116 // Get YesNoCancel_Box
117
118//Use DFGSIni.pkg // DFSGIni.pkg add globals ---------methods no longer supported in VDF8
119 // Get System_Profile_String --- use ReadString of ghoApplication
120 // Set System_Profile_String --- use WriteString of ghoApplication
121 // Get System_Profile_DWord --- use ReadDWord of ghoApplication
122 // Set System_Profile_DWord --- use WriteDWord of ghoApplication
123
124Use WinHlp.pkg // Defines
125 // Send gDoWinHelp
126
127//
128// Function: CString
129//
130// Take a DF string and return a zero terminated string.
131//
132Function CString Global String Buffer Returns String
133 Integer TermPos
134 Pos (Character(0)) in Buffer to TermPos
135 Function_Return (left(buffer,termpos-1))
136End_Function
137
138
139//
140// Function: IsFlagIn
141//
142// Is bit in Flag (or any bit in Flag) in Flags
143//
144Function IsFlagIn Global Integer fFlag Integer fFlags Returns Integer
145 Function_Return ((fFlags iand fFlag) = fFlag)
146End_Function
147
148//
149// Function: AddBitValue
150//
151// Add bit (set to 1) iBitValue to iSource
152//
153Function AddBitValue GLOBAL integer iBitValue integer iSource RETURNS integer
154 Function_Return (iSource IOR iBitValue)
155End_Function
156
157//
158// Function: RemoveBitValue
159//
160// Remove bit (set to 0) in iBitValye to iSource
161//
162Function RemoveBitValue GLOBAL integer iBitValue integer iSource RETURNS integer
163 if (iSource IAND iBitValue) eq iBitValue ;
164 Function_Return (iSource - iBitValue)
165 Else Function_Return iSource
166End_Function
167
168
169//
170// Function: ShowLastError
171//
172// This function shows the error message for the system error codes
173// returned by GetLastError and returns the error code or NO_ERROR.
174//
175{ Visibility=Private }
176Function ShowLastError Global Returns Integer
177 Integer iError iFlags iBytes iResult
178 Pointer pAddress
179 String sBuffer
180
181 // Get the system error code
182 Move (GetLastError()) To iError
183 If (iError = NO_ERROR) Function_Return NO_ERROR
184
185 // Initialize pAddress, just to make sure AddressOf() works
186 Move 0 To pAddress
187
188 // Set the flags...
189 Move (FORMAT_MESSAGE_ALLOCATE_BUFFER iOr FORMAT_MESSAGE_FROM_SYSTEM iOr FORMAT_MESSAGE_IGNORE_INSERTS) To iFlags
190
191 // If FormatMessage fails iBytes will be 0, therefore no bytes will be copied and the error will only
192 // display the error code returned from GetLastError...
193 Move (FormatMessage(iFlags,0,iError,0,AddressOf(pAddress),0,0)) To iBytes
194
195 // Allocate the buffer...
196 Move (Repeat(Character(0),iBytes)) To sBuffer
197 If (iBytes > 0) Move (CopyMemory(AddressOf(sBuffer),pAddress,iBytes)) To iResult
198
199 // Display the error code and message, if no message is available use 'No error text available'.
200 If (Trim(sBuffer) = "") Move C_$NoErrorTextAvailable To sBuffer
201 Error DFERR_WINDOWS ("("+String(iError)+") "+sBuffer)
202
203 // Free memory used by the buffer...
204 Move (Free(pAddress)) To iResult
205 Function_Return iError
206End_Function // ShowLastError
207
208//
209// Function GUIScreen_Size
210// global returns the size of the screen
211// If eMode is 0 or no argument is passed, return actual screen size
212// if eMode is 1, return workspace size. (adjusted for Taskbar)
213Function GUIScreen_Size GLOBAL integer eMode Returns Integer
214 Integer iTop iLeft iRight iBottom bSuccess iHeight iWidth iSize
215 String sRect
216 Pointer lpsRect
217 // if no arguments passed or it is 0, get full screen.
218 if (Num_arguments=0 OR eMode=0) ;
219 Function_Return (GetSystemMetrics(SM_CYSCREEN)*65536 + ;
220 GetSystemMetrics(SM_CXSCREEN) )
221
222 // This is a replacement for the GUIScreen_Size. The normal function uses the
223 // GetSystemMetrics to get the workable screensize. The systemmetric API call doesn't
224 // care about the size of your taskbar. The result of this is that panels that
225 // are auto_located on your screen suddenly run off the screen even with plenty of
226 // space around them.
227 // (Contributed by Wil van Antwerpen)
228 ZeroType tRect To sRect
229 GetAddress of sRect To lpsRect
230 Move (SystemParametersInfo(SPI_GETWORKAREA, 0, lpsRect, 0)) To bSuccess
231 If bSuccess Begin
232 GetBuff From sRect At tRect.top to iTop
233 GetBuff From sRect At tRect.left to iLeft
234 GetBuff From sRect At tRect.bottom to iBottom
235 GetBuff From sRect At tRect.right to iRight
236 Move (iBottom - iTop) To iHeight
237 Move (iRight - iLeft) To iWidth
238 End
239 Function_Return ((iHeight*65536) + iWidth)
240End_Function // GUIScreen_Size
241
242// Private Function: gConvert$Char
243// Convert String to Oem->Ansi or Ansi->Oem: Pass bToAnsi to determine convserion
244// This will convert both DF Strings and C Strings (zero terminated). If passed a
245// Cstring it will return a string with a terminating zero. If passed a DFstring
246// the terminating zero is not returned.
247// This function is used by ToAnsi and ToOEM. Developers are encouraged to use
248// these two functions
249
250{ Visibility=Private }
251Function gConvertChar Global integer bToAnsi String sString Returns String
252 Pointer psString
253 Integer iVoid bIsCString
254
255 If (sString = "") Function_Return sString
256
257 Move (ascii(Right(sString,1))=0) to bIsCString
258 If Not bISCString Append sString (character(0))
259 GetAddress Of sString To psString
260 if bToAnsi Move (OEMToANSI(psString,psString)) To iVoid
261 else Move (ANSItoOEM(psString,psString)) To iVoid
262
263 Function_Return (if(bIsCString, sString, cstring(sString)))
264End_Function // ToANSI
265
266//
267// Function ToAnsi
268// Convert OEM string to ANSI
269// Can be either DF string or zero terminated C style string
270//
271Function ToANSI Global String sString Returns String
272 Function_Return (gConvertChar(1,sString))
273End_Function // ToANSI
274
275//
276// Function ToOEM
277// Convert ANSI string to OEM
278// Can be either DF string or zero terminated C style string
279//
280Function ToOEM Global String sString Returns String
281 Function_Return (gConvertChar(0,sString))
282End_Function // ToOEM
283
284// Private Function: To_Ascii
285//
286// Convert Passed info into an Ascii (ansi) character using the
287// current regional style defined within windows.
288//
289// Pass: Virtual Key, Shift key state, Capslock key state
290// Return: Ascii Char
291//
292{ Visibility=Private }
293Function To_Ascii Global Integer vKey Integer bShift integer bCaps Returns Integer
294 Integer iScan iChar
295 Map_virtual_key vKey to iScan // convert vkey to scan code
296 Reset_key_Array // clear keyboard array
297 Set_Key_Array vKey to ($80) // Push VKey Down
298 If bShift Set_Key_Array VK_SHIFT to ($80) // if shift, push shift key down
299 if bCaps Set_Key_Array VK_CAPITAL to 1 // if Capslock, toggle capital key
300 To_Ascii ((iScan*65536)+vkey) to iChar // convert.
301 Function_Return iChar
302End_Function
303
304//
305// Function: Default_Currency_Symbol
306//
307// Get currency symbol from Windows, stop any "." from symbol
308//
309Function Default_Currency_Symbol GLOBAL returns string
310 String sCurrency
311 Pointer lpCurrency
312 Integer iVal
313 Move (Repeat(character(0),20)) to sCurrency
314 GetAddress of sCurrency To lpCurrency
315 Move (GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SCURRENCY,lpCurrency,20)) to iVal
316 // currently our currency symbols do not handle periods ".", they should not
317 // be used in currency symbols. We will strip any periods that came through the
318 // windows currency symbol. This way the symbol will always be valid for VDF
319 function_return (replaces(".", CString(sCurrency), ""))
320end_Function
321
322
323//
324// Function: Number_Default_Mask
325//
326// Create a VDF numeric mask passing digits, points and mask
327//
328Function Number_Default_Mask GLOBAL integer ldigits integer rpoints String DfltMask Returns string
329 string MaskStr NumStr
330 If lDigits gt 0 ;
331 Move (Repeat("#",lDigits-1)+"0") to NumStr
332 If rPoints gt 0 ;
333 Move (NumStr+"."+(Repeat("0",rPoints))) to NumStr
334 Move (Replaces("*",DfltMask,NumStr)) to MaskStr
335 Function_Return MaskStr
336End_Function // Currency_Default_Mask
337
338
339//
340// Function: Field_Number_Default_Mask
341//
342// Create a currency mask based on File, field and dflt mask.
343//
344Function Field_Number_Default_Mask GLOBAL integer file# integer field# string DfltMask returns string
345 integer lDigit rDigit
346 string sMask
347 Get_Attribute DF_Field_Length of file# field# to lDigit
348 Get_Attribute DF_Field_Precision of file# field# to rDigit
349 If rDigit gt 0 Subtract rDigit from lDigit
350 Get Number_Default_Mask lDigit rDigit DfltMask to sMask
351 Function_return sMask
352End_Function
353
354//
355// Function: Get WindowsMessage
356//
357//
358Function WindowsMessage Global Integer iMsg Dword wParam DWord lParam Returns Integer
359 Handle hWnd
360 Get Window_Handle To hWnd
361 If hWnd ;
362 Function_Return (SendMessage(hWnd, iMsg, wParam, lParam))
363End_Function
364
365// Duplicate maintained for backwards compatibility..Obsolete
366{ Obsolete=True }
367Function Windows_Message Global Integer iMsg Dword wParam DWord lParam Returns Integer
368 Function_Return (WindowsMessage(iMsg, wParam, lParam))
369End_Function
370
371// Procedure Set Profile_Dword
372//
373{ Obsolete=True }
374Procedure Set Profile_Dword Global String sKey String sValueName Dword dwValue
375 REG_SET_DWORD "" sKey sValueName to dwValue
376End_Procedure
377
378
379// Function Profile_Dword
380//
381{ Obsolete=True }
382Function Profile_Dword Global String sKey String sValueName Returns Dword
383 Integer dwValue defValue
384 move REG_VALUE_NOT_EXIST to defValue
385 REG_GET_DWORD "" sKey sValueName defValue to dwValue
386 Function_Return dwValue
387End_Function
388
389External_Function IsUserAnAdmin "IsUserAnAdmin" shell32.dll Returns Boolean
390
391Function IsAdministrator Global Returns Boolean
392 Integer iMajor iMinor
393 Boolean bUnderstands
394 // IsUserAnAdmin can only be used on XP or above. If running
395 // 2000 or below, just return true.
396 Move (SysConf(SYSCONF_OS_MAJOR_REV)) to iMajor
397 Move (SysConf(SYSCONF_OS_MINOR_REV)) to iMinor
398 // Check for XP or above (5.1 or above)
399 Move (iMajor>5 or (iMajor=5 and iMinor>0)) to bUnderstands
400 Function_Return (If(bUnderstands,IsUserAnAdmin(),True))
401End_Function
402
403
404// Returns the VDF physical_FontSize value for the primary screen device for the passed typeface & pointsize.
405// This can be used to set the font size of a VDF control for any Font/Point Size.
406Function PointSizeToPhysicalFontSize Global String sTypeFace Integer iPointSize Returns Integer
407 Integer iFontSize iLogPixelsY
408 Number nFontSize
409 Boolean bVoid
410 Handle hDC hFont hOldFont
411 Pointer lpLogFont lptm
412 Address pTypeFace
413 tWinTextMetric tm
414 tWinLogFont ALogFont
415
416 // Convert Font point size to logical pixels....
417 Move (GetDC(0)) to hDC
418 Move (GetDeviceCaps(hDC, LOGPIXELSY)) to iLogPixelsY
419 Move ((iPointSize * iLogPixelsY / 72.0) + 0.5) to nFontSize
420 Move nFontSize to iFontSize // nFontSize is rounded up, then we truncate it into iFontSize - this reduces rounding error due to integer truncation
421
422 // Convert the TypeFace name into a Char Array....
423 Move (ToANSI(sTypeFace)) to sTypeFace // convert OEM typeface name into an ANSI string.
424 Move (AddressOf(ALogFont.lfFaceName)) to pTypeFace
425 Move sTypeFace to pTypeFace
426
427 // Convert Logical Pixels into physical pixels....
428 Move (0-iFontSize) to ALogFont.lfHeight // use -ve value to instruct system to scale font to device
429 Move (AddressOf(ALogFont)) to lpLogFont
430
431 Move (CreateFontIndirect(lpLogFont)) to hFont // Here we create the font
432 Move (SelectObject(hDC, hFont)) to hOldFont // Now we select it to the device context
433 Move (AddressOf(tm)) to lptm
434 Move (GetTextMetrics(hDC, lptm)) to bVoid // Now we can get the font's text metrics
435
436 Move (tm.tmHeight + tm.tmExternalLeading) to iFontSize // Here is the font's physical size for this device
437
438 Move (ReleaseDC(0, hDC)) to hDC
439 Move (SelectObject(hDC, holdFont)) to hOldFont
440 Move (DeleteObject(hFont)) to bVoid
441
442 Function_Return iFontSize
443End_Function
444