2039 lines
94 KiB
Plaintext
2039 lines
94 KiB
Plaintext
Function Form_Services(Service, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10)
|
|
/***********************************************************************************************************************
|
|
|
|
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
|
|
permission from SRP Computer Solutions, Inc.
|
|
|
|
Name : Form_Services
|
|
|
|
Description : Handler program for all module related services.
|
|
|
|
Notes : The generic paramters should contain all the necessary information to process the services. Often
|
|
this will be information like the data Record and Key ID.
|
|
|
|
Parameters :
|
|
Service [in] -- Name of the service being requested
|
|
Error [out] -- Any errors that were created
|
|
Param1-10 [in/out] -- Additional request parameter holders
|
|
Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
|
|
|
|
Metadata :
|
|
@@DEFINE_SERVICES_SIGNATURE(@SERVICE, @PARAMS)
|
|
@@DEFINE_QUOTED_OPTIONS MESSAGE_TYPE(HELP, VALIDATION, REQUIRED)
|
|
@@DEFINE_UNQUOTED_OPTIONS BOOLEAN(True$, False$)
|
|
|
|
History : (Date, Initials, Notes)
|
|
02/08/13 dmb Original programmer. Add SetDropDown and SetFocusBorders services. - [SRPFW-7]
|
|
02/21/13 dmb Add SetWindowText service. This replaces the Update_Window_Text routine. - [SRPFW-8]
|
|
02/28/13 dmb Add FindSubclassControl and FindPopupControl services. - [SRPFW-10]
|
|
03/03/13 dmb Rename SetFocusBorders to SetSpecialColors. - [SRPFW-9]
|
|
03/04/13 dmb Add support for SelectionStyle and CellColors in the SetSpecialColors service. - [SRPFW-9]
|
|
03/04/13 dmb Modify FindSubclassControl and FindPopupControl services to allow a specific form to be
|
|
passed in from the calling routine. - [SRPFW-9]
|
|
03/11/13 dmb Modify logic in GetRequiredControls and GetNonRequiredControls services to support
|
|
edit table columns. - [SRPFW-9]
|
|
03/13/13 dmb Move the GetMDIFrame service from FrameWorks_Services to Form_Services. - [SRPFW-9]
|
|
03/13/13 dmb Create the DisplayContextHelp service to replace the Display_Help routine. - [SRPFW-9]
|
|
03/13/13 dmb Create the DisplayControlMessage service to support services that need to display control
|
|
specific messages using the SRP Popup control. - [SRPFW-9]
|
|
03/18/13 dmb Create the SelectOpenWindowsItem service so processes that change the active MDI Child
|
|
can easily change the selected Open Windows item. - [SRPFW-9]
|
|
03/19/13 dmb Replace internal Set_Colors gosub with SetRequiredColors, SetNonRequiredColors, and
|
|
Set_SRP_EditTable_Colors services. This was done to allow more discreet controls over
|
|
custom colors. - [SRPFW-9]
|
|
03/20/13 dmb Add GetOIEditTable and GetSRPEditTable services. This were added to make it easier to
|
|
write logic that relies upon linked SRP EditTables and OpenInsight edit tables. - [SRPFW-9]
|
|
03/20/13 dmb Rename SetSpecialColors to SetDefaultControlColors. - [SRPFW-9]
|
|
03/30/13 dmb Replace direct calls to SRP HashTable routines with Memory_Services. - [SRPFW-9]
|
|
04/05/13 dmb Add GetFormCommuter and GetEventCommuter services. - [SRPFW-9]
|
|
05/30/13 dmb Revise the FindSubclassControl and FindPopupControl services to preserve the multi-instance
|
|
form name for the HashKey rather than the base form name. This fixes event handling problems
|
|
with the Subclass and Popup controls.
|
|
10/03/13 dmb Added the IsMDIChild service. - [SRPFW-18]
|
|
10/06/13 dmb Added the CreateCommandLink and CreateCommandLink2 services. - [SRPFW-17]
|
|
11/05/13 dmb Added the DisplayWaitBanner, SetWaitBanner, and CloseWaitBanner services to provide a
|
|
consistant way to notify users of an active process. - [SRPFW-34]
|
|
11/07/13 dmb Add support for MD0 and table validation in the DisplayValidationError service. - [SRPFW-71]
|
|
11/07/13 dmb Add IsKeyControl service. - [SRPFW-72]
|
|
08/18/15 dmb Add a check in the SetControlThemeColors service to see if a control is managed as an
|
|
SRP Utility. If it is then don't do anything. - [SRPFW-98]
|
|
04/29/16 dmb Add SetOptionButton service borrowed from FrameWorks 16.
|
|
|
|
***********************************************************************************************************************/
|
|
|
|
$insert APP_INSERTS
|
|
$insert SERVICE_SETUP
|
|
|
|
Declare function Utility, Get_Property, Set_Property, Send_Message, Verify_Access, Browse_List_Control, Form_Services
|
|
Declare function Frameworks_Services, SRP_Sort_Array, SRP_HashTable_Create, SRP_HashTable_Contains, SRP_HashTable_Get
|
|
Declare function NameCap, Memory_Services
|
|
Declare subroutine Set_Property, SRP_HashTable_Set, Display_Control_Message, Memory_Services, Create_Dialog, Yield
|
|
Declare subroutine Form_Services
|
|
|
|
Begin Case
|
|
Case Service _EQC 'SetDropDown' ; GoSub SetDropDown
|
|
Case Service _EQC 'SetOptionButton' ; GoSub SetOptionButton
|
|
Case Service _EQC 'SetControlThemeColors' ; GoSub SetControlThemeColors
|
|
Case Service _EQC 'SetRequiredColors' ; GoSub SetRequiredColors
|
|
Case Service _EQC 'SetNonRequiredColors' ; GoSub SetNonRequiredColors
|
|
Case Service _EQC 'SetValidErrColors' ; GoSub SetValidErrColors
|
|
Case Service _EQC 'SetWindowText' ; GoSub SetWindowText
|
|
Case Service _EQC 'RestoreWindowText' ; GoSub RestoreWindowText
|
|
Case Service _EQC 'CheckRequiredControls' ; GoSub CheckRequiredControls
|
|
Case Service _EQC 'GetRequiredControls' ; GoSub GetRequiredControls
|
|
Case Service _EQC 'IsRequiredControl' ; GoSub IsRequiredControl
|
|
Case Service _EQC 'GetNonRequiredControls' ; GoSub GetNonRequiredControls
|
|
Case Service _EQC 'DisplayValidationError' ; GoSub DisplayValidationError
|
|
Case Service _EQC 'HasContextHelpEnabled' ; GoSub HasContextHelpEnabled
|
|
Case Service _EQC 'ContextHelpVisible' ; GoSub ContextHelpVisible
|
|
Case Service _EQC 'DisplayContextHelp' ; GoSub DisplayContextHelp
|
|
Case Service _EQC 'DisplayControlMessage' ; GoSub DisplayControlMessage
|
|
Case Service _EQC 'DisplayStatusMessage' ; GoSub DisplayStatusMessage
|
|
Case Service _EQC 'CloseControlMessage' ; GoSub CloseControlMessage
|
|
Case Service _EQC 'ClearStatusMessage' ; GoSub ClearStatusMessage
|
|
Case Service _EQC 'FindSubclassControl' ; GoSub FindSubclassControl
|
|
Case Service _EQC 'FindPopupControl' ; GoSub FindPopupControl
|
|
Case Service _EQC 'GetMDIFrame' ; GoSub GetMDIFrame
|
|
Case Service _EQC 'IsMDIChild' ; GoSub IsMDIChild
|
|
Case Service _EQC 'SelectOpenWindowsItem' ; GoSub SelectOpenWindowsItem
|
|
Case Service _EQC 'GetOIEditTable' ; GoSub GetOIEditTable
|
|
Case Service _EQC 'GetSRPEditTable' ; GoSub GetSRPEditTable
|
|
Case Service _EQC 'GetFormCommuter' ; GoSub GetFormCommuter
|
|
Case Service _EQC 'GetEventCommuter' ; GoSub GetEventCommuter
|
|
Case Service _EQC 'CreateCommandLink' ; GoSub CreateCommandLink
|
|
Case Service _EQC 'CreateCommandLink2' ; GoSub CreateCommandLink2
|
|
Case Service _EQC 'CreateProgressBar' ; GoSub CreateProgressBar
|
|
Case Service _EQC 'SetProgressBarPercent' ; GoSub SetProgressBarPercent
|
|
Case Service _EQC 'GetProgressBarPercent' ; GoSub GetProgressBarPercent
|
|
Case Service _EQC 'DisplayWaitScreen' ; GoSub DisplayWaitScreen
|
|
Case Service _EQC 'CloseWaitScreen' ; GoSub CloseWaitScreen
|
|
Case Service _EQC 'DisplayWaitBanner' ; GoSub DisplayWaitBanner
|
|
Case Service _EQC 'SetWaitBanner' ; GoSub SetWaitBanner
|
|
Case Service _EQC 'CloseWaitBanner' ; GoSub CloseWaitBanner
|
|
Case Service _EQC 'IsKeyControl' ; GoSub IsKeyControl
|
|
Case Otherwise$ ; Error_Services('Set', Service : ' is not a valid service request within the Form services module.')
|
|
End Case
|
|
|
|
If Assigned(Response) else Response = ''
|
|
|
|
Return Response
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetDropDown
|
|
//
|
|
// Param1 - CtrlEntId. The fully qualified name of the control getting the drop down.
|
|
// Param2 - DropDownType. The type of drop down to use. This is usually based on different table data and data column
|
|
// configuration.
|
|
//
|
|
// @@DEFINE_SERVICE(SetDropDown, CtrlEntId, DropDownType=DropDownTypes)
|
|
//
|
|
// @@DEFINE_QUOTED_OPTIONS DropDownTypes(MOVIES)
|
|
//
|
|
// Creates a dropdown for the control. This service relies on @Window
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetDropDown:
|
|
CtrlEntId = Param1
|
|
DropDownType = Param2
|
|
|
|
Convert @Lower_Case to @Upper_Case in DropDownType
|
|
AtWindow = CtrlEntId[1, '.']
|
|
DropDownRecord = Xlate('APP_INFO', 'DROP_DOWN_' : DropDownType, '', 'X')
|
|
If Len(DropDownRecord) then
|
|
SubclassInfo = Form_Services('FindSubclassControl')
|
|
|
|
If Error_Services('NoError') then
|
|
|
|
Subclass = SubclassInfo<1>
|
|
Handle = Get_Property(CtrlEntId, 'HANDLE')
|
|
rv = Send_Message(Subclass, 'OLE.Subclass', Handle, CtrlEntId)
|
|
Convert '.' to ';' in CtrlEntId
|
|
|
|
ComboArray = ''
|
|
ComboArray<1> = True$
|
|
Headings = DropDownRecord<1>
|
|
Convert @VM to @TM in Headings
|
|
DropDownRecord = Delete(DropDownRecord, 1, 0, 0)
|
|
Justif = DropDownRecord<1>
|
|
Convert @SVM to @STM in Justif
|
|
Convert @VM to @TM in Justif
|
|
DropDownRecord = Delete(DropDownRecord, 1, 0, 0)
|
|
AdditParams = DropDownRecord<1>
|
|
DropDownRecord = Delete(DropDownRecord, 1, 0, 0)
|
|
|
|
ComboArray<2, 1> = Headings
|
|
ComboArray<2, 2> = Justif
|
|
Convert @VM to @STM in DropDownRecord
|
|
Convert @FM to @TM in DropDownRecord
|
|
ComboArray<2, 3> = DropDownRecord
|
|
|
|
NumAdditParams = Count(AdditParams, @VM) + (AdditParams NE '')
|
|
For ParamCnt = 1 to NumAdditParams
|
|
ParamValue = AdditParams<0, ParamCnt>
|
|
If Len(ParamValue) then
|
|
ComboArray<2, ParamCnt + 3> = AdditParams<0, ParamCnt>
|
|
end
|
|
Next ParamCnt
|
|
rv = Set_Property(Subclass, 'OLE.Combo[' : CtrlEntId : ']', ComboArray)
|
|
end
|
|
end else
|
|
Error_Services('Set', Param2 : ' drop down type is not valid.')
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetOptionButton
|
|
//
|
|
// Param1 - CtrlEntId. The fully qualified name of the control getting the drop down.
|
|
// Param2 - Image. Path to an image. You can omit the path to assume "BMPS\FrameWorks\DropDown". Omitting extension will
|
|
// assume ".png"
|
|
// Param3 - Enabled. Default enabled state. If omitted, Yes$ is the default.
|
|
//
|
|
// @@DEFINE_SERVICE(SetOptionButton, CtrlEntId, Image, Enabled)
|
|
//
|
|
// Creates an option for the control. This service relies on @Window
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetOptionButton:
|
|
|
|
CtrlEntId = Param1
|
|
Image = Param2
|
|
Enabled = Param3
|
|
|
|
// If no extension, use the default
|
|
If Index(Image, "\", 1) LE 0 then
|
|
Image := ".png"
|
|
end
|
|
|
|
// If no path, use the default
|
|
If Index(Image, "\", 1) LE 0 then
|
|
Image = "BMPS\FrameWorks\DropDown\":Image
|
|
end
|
|
|
|
// Default enabled
|
|
If Len(Enabled) else Enabled = Yes$
|
|
|
|
// Get the subclass control
|
|
SubclassInfo = Form_Services('FindSubclassControl')
|
|
If Error_Services('NoError') then
|
|
|
|
// Make sure the control is subclassed
|
|
Subclass = SubclassInfo<1>
|
|
Handle = Get_Property(CtrlEntId, 'HANDLE')
|
|
Send_Message(Subclass, 'OLE.Subclass', Handle, CtrlEntId)
|
|
Convert '.' to ';' in CtrlEntId
|
|
|
|
// Add the button
|
|
Set_Property(Subclass, 'OLE.OptionButton[' : CtrlEntId : ']', Yes$)
|
|
Set_Property(Subclass, 'OLE.OptionImage[' : CtrlEntId : ']', Image)
|
|
Set_Property(Subclass, 'OLE.OptionEnabled[' : CtrlEntId : ']', Enabled)
|
|
|
|
end
|
|
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetControlThemeColors
|
|
//
|
|
// Param1 - @FM list of controls to be set to their default theme color settings. If this is null then then all controls
|
|
// will be set. SRP EditTable controls might have a specific column or cell position value. These will be
|
|
// appended to the control name with a colon as the delimiter. If it is a cell position then the column value
|
|
// will be first, then a comma, and then the row position:
|
|
//
|
|
// DBW_SAMPLE4.EDT_EDITTABLE:3
|
|
//
|
|
// DBW_SAMPLE5.EDT_EDITTABLE:2,5
|
|
//
|
|
// Param2 - Form whose controls need theme colors. If the Controls argument is populated then this is ignored.
|
|
//
|
|
// @@DEFINE_SERVICE(SetControlThemeColors, Controls, Form)
|
|
//
|
|
// Sets the color of edit line and edit box borders and SRP EditTable cells/columns/rows to their default colors.
|
|
// The default colors will be based on whether these controls are considered required or not by OpenInsight.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetControlThemeColors:
|
|
Controls = Param1
|
|
Window = Param2
|
|
|
|
If Len(Controls) then
|
|
// A list of controls has been passed in. Each control in the list needs to be checked to see if it is
|
|
// considered required.
|
|
RequiredControls = ''
|
|
NonRequiredControls = ''
|
|
|
|
BytePos = 1
|
|
Flag = ''
|
|
Loop
|
|
Remove CtrlEntId from Controls at BytePos Setting Flag
|
|
SRPUtility = Get_Property(CtrlEntId[1, ':'], '@SRP_UTILITY')
|
|
If Not(SRPUtility) then
|
|
If Form_Services('IsRequiredControl', CtrlEntId) then
|
|
RequiredControls := CtrlEntId : @FM
|
|
end else
|
|
NonRequiredControls := CtrlEntId : @FM
|
|
end
|
|
end
|
|
While Flag
|
|
Repeat
|
|
// Strip off any trailing @FMs.
|
|
RequiredControls[-1, 1] = ''
|
|
NonRequiredControls[-1, 1] = ''
|
|
end else
|
|
NonRequiredControls = Form_Services('GetNonRequiredControls', Window)
|
|
RequiredControls = Form_Services('GetRequiredControls', Window)
|
|
end
|
|
|
|
If Len(NonRequiredControls) then Form_Services('SetNonRequiredColors', NonRequiredControls, Window)
|
|
If Len(RequiredControls) then Form_Services('SetRequiredColors', RequiredControls, Window)
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetRequiredColors
|
|
//
|
|
// Param1 - @FM list of controls to be colored with the Required special color settings. If this is null then then
|
|
// GetRequiredControls service will be used to get controls that are considered required by OpenInsight.
|
|
// Param2 - Form whose required controls need to be set with special colors. Default is @Window
|
|
//
|
|
// @@DEFINE_SERVICE(SetRequiredColors, RequiredCtrls, Window)
|
|
//
|
|
// Sets the color of edit line and edit box borders for required controls.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetRequiredColors:
|
|
RequiredCtrls = Param1
|
|
Window = Param2
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
|
|
If Len(RequiredCtrls) then
|
|
SubclassInfo = Form_Services('FindSubclassControl')
|
|
|
|
If Error_Services('NoError') then
|
|
// Update the edit line and edit box controls using the SRP Subclass CustomColors feature.
|
|
PM_CONTROL_DEFAULT = Memory_Services('GetValue', 'PM_CONTROL_DEFAULT')
|
|
PM_CONTROL_WITH_ATTENTION = Memory_Services('GetValue', 'PM_CONTROL_WITH_ATTENTION')
|
|
PM_REQ_CONTROL_DEFAULT = Memory_Services('GetValue', 'PM_REQ_CONTROL_DEFAULT')
|
|
PM_REQ_CONTROL_WITH_ATTENTION = Memory_Services('GetValue', 'PM_REQ_CONTROL_WITH_ATTENTION')
|
|
ReqCustomColors = PM_REQ_CONTROL_DEFAULT : @VM : 'Window' : @VM : 'Window' : @VM : PM_REQ_CONTROL_DEFAULT : @VM : 2 : @FM
|
|
ReqCustomColors := PM_REQ_CONTROL_WITH_ATTENTION : @VM : PM_REQ_CONTROL_WITH_ATTENTION : @VM : 'Window' : @VM : PM_REQ_CONTROL_WITH_ATTENTION : @VM : 2 : @FM
|
|
ReqCustomColors := PM_REQ_CONTROL_WITH_ATTENTION : @VM : 'Window' : @VM : PM_REQ_CONTROL_WITH_ATTENTION : @VM : 'White' : @VM : 1 : @FM
|
|
|
|
Subclass = SubclassInfo<1>
|
|
|
|
BytePos = 1
|
|
Flag = ''
|
|
Loop
|
|
Remove Ctrl from RequiredCtrls at BytePos Setting Flag
|
|
// Controls can be passed that are not fully qualified (i.e., without a window name.) The window needs
|
|
// to be inserted in order to create a fully qualified control name.
|
|
If Count(Ctrl, '.') else Ctrl = Window : '.' : Ctrl
|
|
// Check to see if there is a column number appended to the control name.
|
|
If Count(Ctrl, ':') then
|
|
ColPos = Ctrl[-1, 'B:']
|
|
If Count(ColPos, ',') then
|
|
RowPos = ColPos[-1, 'B,']
|
|
ColPos = ColPos[1, ',']
|
|
end else
|
|
RowPos = 'All'
|
|
end
|
|
Ctrl = Ctrl[1, ':']
|
|
end else
|
|
ColPos = ''
|
|
RowPos = ''
|
|
end
|
|
Type = Get_Property(Ctrl, 'TYPE')
|
|
Begin Case
|
|
Case Type EQ 'EDITFIELD' OR Type EQ 'EDITBOX'
|
|
Handle = Get_Property(Ctrl, 'HANDLE')
|
|
rv = Send_Message(Subclass, 'OLE.Subclass', Handle, Ctrl)
|
|
Convert '.' to ';' in Ctrl
|
|
rv = Set_Property(Subclass, 'OLE.CustomColors[' : Ctrl : ']', ReqCustomColors)
|
|
|
|
Case Type EQ 'EDITTABLE'
|
|
SRPEditTable = Form_Services('GetSRPEditTable', Ctrl)
|
|
If Len(SRPEditTable) then
|
|
SelectionStyle = ''
|
|
If Form_Services('ContextHelpVisible', Ctrl : ':' : ColPos : ',' : RowPos) then
|
|
SelectionStyle<4> = PM_CONTROL_WITH_ATTENTION
|
|
CellGridLines = PM_CONTROL_WITH_ATTENTION : @FM : PM_CONTROL_WITH_ATTENTION : @FM : PM_CONTROL_WITH_ATTENTION : @FM : PM_CONTROL_WITH_ATTENTION
|
|
end else
|
|
FocusCtrl = Get_Property(Window, 'FOCUS')
|
|
If FocusCtrl EQ Ctrl then
|
|
CurSelPos = Get_Property(FocusCtrl, 'OLE.SelPos')
|
|
If CurSelPos<1> EQ ColPos then
|
|
SelectionStyle<4> = PM_REQ_CONTROL_WITH_ATTENTION
|
|
end else
|
|
SelectionStyle<4> = PM_CONTROL_WITH_ATTENTION
|
|
end
|
|
end
|
|
end
|
|
Set_Property(SRPEditTable, 'OLE.SelectionStyle', SelectionStyle)
|
|
Set_Property(SRPEditTable, 'OLE.CellGridLines[' : ColPos : ';' : RowPos : ']', CellGridLines)
|
|
end
|
|
|
|
Case Type EQ 'OLECONTROL'
|
|
ProgID = Get_Property(Ctrl, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.EditTable.1' then
|
|
SelectionStyle = ''
|
|
If Form_Services('ContextHelpVisible', Ctrl : ':' : ColPos : ',' : RowPos) then
|
|
SelectionStyle<4> = PM_CONTROL_WITH_ATTENTION
|
|
CellGridLines = PM_CONTROL_WITH_ATTENTION : @FM : PM_CONTROL_WITH_ATTENTION : @FM : PM_CONTROL_WITH_ATTENTION : @FM : PM_CONTROL_WITH_ATTENTION
|
|
end else
|
|
FocusCtrl = Get_Property(Window, 'FOCUS')
|
|
If FocusCtrl EQ Ctrl then
|
|
CurSelPos = Get_Property(FocusCtrl, 'OLE.SelPos')
|
|
If CurSelPos<1> EQ ColPos then
|
|
SelectionStyle<4> = PM_REQ_CONTROL_WITH_ATTENTION
|
|
end else
|
|
SelectionStyle<4> = PM_CONTROL_WITH_ATTENTION
|
|
end
|
|
end
|
|
CellGridLines = PM_CONTROL_DEFAULT : @FM : PM_REQ_CONTROL_DEFAULT : @FM : PM_CONTROL_DEFAULT : @FM : PM_REQ_CONTROL_DEFAULT
|
|
end
|
|
Set_Property(Ctrl, 'OLE.SelectionStyle', SelectionStyle)
|
|
Set_Property(Ctrl, 'OLE.CellGridLines[' : ColPos : ';' : RowPos : ']', CellGridLines)
|
|
end
|
|
|
|
End Case
|
|
While Flag
|
|
Repeat
|
|
|
|
// Make sure the form's required field processing will only validate when the record is saved.
|
|
IOOptions = Get_Property(Window, 'IOOPTIONS')
|
|
IOOptions<10> = True$
|
|
Set_Property(Window, 'IOOPTIONS', IOOptions)
|
|
end else
|
|
Error_Services('Add', 'Unable to set required colors due to missing Subclass control.')
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetNonRequiredColors
|
|
//
|
|
// Param1 - @FM list of controls to be colored with the Non Required special color settings. If this is null then then
|
|
// GetNonRequiredControls service will be used to get controls that are not considered required by OpenInsight.
|
|
// Param2 - Form whose required controls need to be set with special colors. Default is @Window
|
|
//
|
|
// @@DEFINE_SERVICE(SetNonRequiredColors, NonRequiredCtrls, Window)
|
|
//
|
|
// Sets the color of edit line and edit box borders for non-required controls.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetNonRequiredColors:
|
|
NonRequiredCtrls = Param1
|
|
Window = Param2
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
|
|
If Len(NonRequiredCtrls) then
|
|
SubclassInfo = Form_Services('FindSubclassControl')
|
|
|
|
If Error_Services('NoError') then
|
|
// Update the edit line and edit box controls using the SRP Subclass CustomColors feature.
|
|
PM_CONTROL_DEFAULT = Memory_Services('GetValue', 'PM_CONTROL_DEFAULT')
|
|
PM_CONTROL_WITH_ATTENTION = Memory_Services('GetValue', 'PM_CONTROL_WITH_ATTENTION')
|
|
PM_REQ_CONTROL_DEFAULT = Memory_Services('GetValue', 'PM_REQ_CONTROL_DEFAULT')
|
|
PM_REQ_CONTROL_WITH_ATTENTION = Memory_Services('GetValue', 'PM_REQ_CONTROL_WITH_ATTENTION')
|
|
CustomColors = PM_CONTROL_DEFAULT : @VM : 'Window' : @VM : 'Window' : @VM : PM_CONTROL_DEFAULT : @VM : 2 : @FM
|
|
CustomColors := PM_CONTROL_WITH_ATTENTION : @VM : PM_CONTROL_WITH_ATTENTION : @VM : 'Window' : @VM : PM_CONTROL_WITH_ATTENTION : @VM : 2 : @FM
|
|
CustomColors := PM_CONTROL_WITH_ATTENTION : @VM : 'Window' : @VM : PM_CONTROL_WITH_ATTENTION : @VM : 'White' : @VM : 1 : @FM
|
|
CellGridLines = Str(PM_CONTROL_DEFAULT : @FM, 4)
|
|
CellGridLines[-1, 1] = ''
|
|
|
|
Subclass = SubclassInfo<1>
|
|
|
|
BytePos = 1
|
|
Flag = ''
|
|
Loop
|
|
Remove Ctrl from NonRequiredCtrls at BytePos Setting Flag
|
|
// Controls can be passed that are not fully qualified (i.e., without a window name.) The window needs
|
|
// to be inserted in order to create a fully qualified control name.
|
|
If Count(Ctrl, '.') else Ctrl = Window : '.' : Ctrl
|
|
// Check to see if there is a column number appended to the control name.
|
|
If Count(Ctrl, ':') then
|
|
ColPos = Ctrl[-1, 'B:']
|
|
If Count(ColPos, ',') then
|
|
RowPos = ColPos[-1, 'B,']
|
|
ColPos = ColPos[1, ',']
|
|
end else
|
|
RowPos = 'All'
|
|
end
|
|
Ctrl = Ctrl[1, ':']
|
|
end else
|
|
ColPos = ''
|
|
RowPos = ''
|
|
end
|
|
Type = Get_Property(Ctrl, 'TYPE')
|
|
Begin Case
|
|
Case Type EQ 'EDITFIELD' OR Type EQ 'EDITBOX'
|
|
Handle = Get_Property(Ctrl, 'HANDLE')
|
|
rv = Send_Message(Subclass, 'OLE.Subclass', Handle, Ctrl)
|
|
Convert '.' to ';' in Ctrl
|
|
rv = Set_Property(Subclass, 'OLE.CustomColors[' : Ctrl : ']', CustomColors)
|
|
|
|
Case Type EQ 'EDITTABLE'
|
|
SRPEditTable = Form_Services('GetSRPEditTable', Ctrl)
|
|
If Len(SRPEditTable) then
|
|
Set_Property(SRPEditTable, 'OLE.CellGridLines[' : ColPos : ';' : RowPos : ']', CellGridLines)
|
|
SelectionStyle = ''
|
|
SelectionStyle<4> = PM_CONTROL_WITH_ATTENTION
|
|
Set_Property(Ctrl, 'OLE.SelectionStyle', SelectionStyle)
|
|
Set_Property(Ctrl, 'OLE.CellGridLines[' : ColPos : ';' : RowPos : ']', CellGridLines)
|
|
end
|
|
|
|
Case Type EQ 'OLECONTROL'
|
|
ProgID = Get_Property(Ctrl, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.EditTable.1' then
|
|
SelectionStyle = ''
|
|
SelectionStyle<4> = PM_CONTROL_WITH_ATTENTION
|
|
Set_Property(Ctrl, 'OLE.SelectionStyle', SelectionStyle)
|
|
Set_Property(Ctrl, 'OLE.CellGridLines[' : ColPos : ';' : RowPos : ']', CellGridLines)
|
|
end
|
|
|
|
End Case
|
|
While Flag
|
|
Repeat
|
|
end else
|
|
Error_Services('Add', 'Unable to set non-required colors due to missing Subclass control.')
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetValidErrColors
|
|
//
|
|
// Param1 - Control to be colored with the Validation Error special color settings. If this is null then the control
|
|
// with focus will be used.
|
|
//
|
|
// @@DEFINE_SERVICE(SetValidErrColors, ValidErrCtrl)
|
|
//
|
|
// Sets the color of edit line and edit box borders and SRP EditTable borders for validation errors.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetValidErrColors:
|
|
ValidErrCtrl = Param1
|
|
If Len(ValidErrCtrl) EQ 0 then ValidErrCtrl = Get_Property(@Window, 'FOCUS')
|
|
|
|
If Len(ValidErrCtrl) then
|
|
SubclassInfo = Form_Services('FindSubclassControl')
|
|
|
|
If Error_Services('NoError') then
|
|
// Update the edit line and edit box controls using the SRP Subclass CustomColors feature.
|
|
PM_VALIDATION_ERROR = Memory_Services('GetValue', 'PM_VALIDATION_ERROR')
|
|
CustomColors = PM_VALIDATION_ERROR : @VM : 'Window' : @VM : 'Window' : @VM : PM_VALIDATION_ERROR : @VM : 2 : @FM
|
|
CustomColors := PM_VALIDATION_ERROR : @VM : PM_VALIDATION_ERROR : @VM : 'Window' : @VM : PM_VALIDATION_ERROR : @VM : 2 : @FM
|
|
CustomColors := PM_VALIDATION_ERROR : @VM : 'Window' : @VM : PM_VALIDATION_ERROR : @VM : 'White' : @VM : 1 : @FM
|
|
CellGridLines = Str(PM_VALIDATION_ERROR : @FM, 4)
|
|
CellGridLines[-1, 1] = ''
|
|
|
|
Subclass = SubclassInfo<1>
|
|
|
|
// Check to see if there is a column number appended to the control name.
|
|
If Count(ValidErrCtrl, ':') then
|
|
ColPos = ValidErrCtrl[-1, 'B:']
|
|
Ctrl = ValidErrCtrl[1, ':']
|
|
end else
|
|
ColPos = ''
|
|
Ctrl = ValidErrCtrl
|
|
end
|
|
Type = Get_Property(Ctrl, 'TYPE')
|
|
Begin Case
|
|
Case Type EQ 'EDITFIELD' OR Type EQ 'EDITBOX'
|
|
Handle = Get_Property(Ctrl, 'HANDLE')
|
|
rv = Send_Message(Subclass, 'OLE.Subclass', Handle, Ctrl)
|
|
Convert '.' to ';' in Ctrl
|
|
rv = Set_Property(Subclass, 'OLE.CustomColors[' : Ctrl : ']', CustomColors)
|
|
|
|
Case Type EQ 'EDITTABLE'
|
|
SRPEditTable = Form_Services('GetSRPEditTable', Ctrl)
|
|
If Len(SRPEditTable) then
|
|
Set_Property(SRPEditTable, 'OLE.CellGridLines[' : ColPos : ';All]', CellGridLines)
|
|
end
|
|
|
|
Case Type EQ 'OLECONTROL'
|
|
ProgID = Get_Property(Ctrl, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.EditTable.1' then
|
|
Set_Property(Ctrl, 'OLE.CellGridLines[' : ColPos : ';All]', CellGridLines)
|
|
end
|
|
|
|
End Case
|
|
end else
|
|
Error_Services('Add', 'Unable to set validation error colors due to missing Subclass control.')
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetWindowText
|
|
//
|
|
// Param1 - Content to be used when updating the window's caption bar. This can be @FM delimited in case the data is
|
|
// coming from different sources, such as a control on the window itself. Controls will be identified with
|
|
// a double tilde. E.g., ~~EDL_NAME means "Get the TEXT property from the EDL_NAME control."
|
|
// Param2 - Window (form) to be updated. Default is @Window.
|
|
//
|
|
// @@DEFINE_SERVICE(SetWindowText, NewText, Window)
|
|
//
|
|
// Updates the caption text of a form with the data being passed in. This is intended to allow forms to have additional
|
|
// information added to the caption bar so that users can more easily identify the form among many others already
|
|
// visible in the workspace.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetWindowText:
|
|
NewText = Param1
|
|
Window = Param2
|
|
|
|
If Len(Window) else Window = @Window
|
|
|
|
Text = Get_Property(Window, 'ORIG_TEXT')
|
|
CurrentText = Get_Property(Window, 'TEXT')
|
|
LockedText = '<Entry Locked, View Only>'
|
|
If Index(CurrentText, LockedText, 1) then
|
|
Text := ' - ' : LockedText
|
|
end
|
|
|
|
NumSources = Count(NewText, @FM) + (NewText NE '')
|
|
AllAddedText = ''
|
|
For SourceCnt = 1 to NumSources
|
|
Source = NewText<SourceCnt>
|
|
If Source[1, 2] EQ '~~' then
|
|
// This is a control name so get its TEXT property.
|
|
SourceCtrl = Source[3, 999]
|
|
AddedText = Get_Property(Window : '.' : SourceCtrl, 'TEXT')
|
|
end else
|
|
// The information as is should be used.
|
|
AddedText = Source
|
|
end
|
|
If Len(AddedText) then AllAddedText := AddedText : ' '
|
|
Next SourceCnt
|
|
|
|
AllAddedText[-1, 1] = '' ; // Remove the trailing space.
|
|
BaseWindow = Field(Window, '.', 1)[1, 'F*']
|
|
FullWrite = Verify_Access(BaseWindow)
|
|
If FullWrite EQ '0' then
|
|
AllAddedText := ' - <Read Only>'
|
|
end
|
|
|
|
If Len(AllAddedText) then
|
|
If Len(Text) then
|
|
Text := ' - ' : AllAddedText
|
|
end else
|
|
Text = AllAddedText
|
|
end
|
|
end
|
|
|
|
// Now check to see if this is a Browse List.
|
|
BrowseListWording = Browse_List_Control(Window, 'Check_List')
|
|
If Len(BrowseListWording) then
|
|
Text := BrowseListWording
|
|
end
|
|
Swap CRLF$ with ' ' in Text
|
|
|
|
If Text NE CurrentText then
|
|
// Only update if there is a change.
|
|
Set_Property(Window, 'TEXT', Text)
|
|
|
|
// If there is a launch bar and an Open Windows group, update item text
|
|
MDIFrame = Get_Property(Window, 'MDIFRAME')
|
|
Launchbar = MDIFrame : '.OLE_TREE_LAUNCHBAR'
|
|
If Get_Property(Launchbar, 'VISIBLE') then
|
|
GroupKey = 'Open Windows*Open Windows'
|
|
ItemKey = 'Open Windows*' : Window
|
|
OpenWinKeys = Get_Property(Launchbar, 'OLE.ItemChildren[' : GroupKey : ']')
|
|
Locate ItemKey in OpenWinKeys Using @FM Setting fPos then
|
|
// Update item description
|
|
Set_Property(Launchbar, 'OLE.ItemData[' : ItemKey : ']', Text)
|
|
end
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RestoreWindowText
|
|
//
|
|
// Param1 - Window (form) to be restored. Default is @Window.
|
|
//
|
|
// @@DEFINE_SERVICE(RestoreWindowText, Window)
|
|
//
|
|
// Restores the caption bar text to the original settings. This would normally be called after the SetWindowText service
|
|
// was used to modify the text.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
RestoreWindowText:
|
|
Window = Param1
|
|
If Len(Window) else Window = @Window
|
|
|
|
Set_Property(Window, 'TEXT', Get_Property(Window, 'ORIG_TEXT'))
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CheckRequiredControls
|
|
//
|
|
// Param1 - Form whose required controls need to be checked. Default is @Window
|
|
//
|
|
// @@DEFINE_SERVICE(CheckRequiredControls, Window)
|
|
//
|
|
// Checks to see if the current form has all required controls populated. If not, then the appropriate message display
|
|
// is used. If the Apply Special Colors flag from the Preferences Manager is set then this will use the custom colors
|
|
// property and SRP Popup control. Otherwise a message box will appear. This service replaces the
|
|
// Win_Check_Req_Fields function, which called by the Promoted_Write_Event function.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CheckRequiredControls:
|
|
Window = Param1
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
|
|
Response = 1 ; // Default response is 1, which means all of the required controls are populated.
|
|
|
|
RequiredCtrls = Form_Services('GetRequiredControls', Window)
|
|
If Len(RequiredCtrls) then
|
|
RequiredCtrls = @FM : RequiredCtrls
|
|
Swap @FM with @FM : Window : '.' in RequiredCtrls
|
|
RequiredCtrls[1, 1] = ''
|
|
|
|
BytePos = 1
|
|
Flag = ''
|
|
MissingCtrl = ''
|
|
Loop
|
|
Until Len(MissingCtrl)
|
|
Remove Ctrl from RequiredCtrls at BytePos Setting Flag
|
|
If Count(Ctrl, ':') then
|
|
// This is an SRP EditTable or edit table column.
|
|
ColPos = Ctrl[-1, 'B:']
|
|
Ctrl = Ctrl[1, ':']
|
|
ControlType = Get_Property(Ctrl, 'TYPE')
|
|
If ControlType EQ 'EDITTABLE' then
|
|
Data = Get_Property(Ctrl, 'DEFPROP')<ColPos>
|
|
end else
|
|
Data = Get_Property(Ctrl, 'OLE.CellText[' : ColPos : '; 1]')
|
|
end
|
|
end else
|
|
// This is a non-edit table control.
|
|
ColPos = ''
|
|
Data = Get_Property(Ctrl, 'DEFPROP')
|
|
end
|
|
If Len(Data) EQ 0 then MissingCtrl = Ctrl
|
|
While Flag
|
|
Repeat
|
|
|
|
If Len(MissingCtrl) then
|
|
// Create a title for the Popup help
|
|
ControlType = Get_Property(MissingCtrl, 'TYPE')
|
|
|
|
// Replace OLECONTROL with the ProgID if applicable.
|
|
If ControlType EQ 'OLECONTROL' then
|
|
ControlType = Get_Property(MissingCtrl, 'OLE.ProgId')
|
|
end
|
|
|
|
// If the missing control is an OpenInsight edit table, check to see if there is a linked SRP EditTable.
|
|
// If so, then the SRP EditTable will be the missing control.
|
|
If ControlType _EQC 'EDITTABLE' then
|
|
SRPEditTable = Form_Services('GetSRPEditTable', MissingCtrl)
|
|
If Len(SRPEditTable) then
|
|
MissingCtrl = SRPEditTable
|
|
ControlType = 'SRP.EditTable.1'
|
|
end
|
|
end
|
|
Window = MissingCtrl[1, '.']
|
|
ControlID = MissingCtrl[Col2() + 1, '.'] ; // Only need the actual control name without the window now.
|
|
If (ControlType _EQC 'EDITTABLE' OR ControlType _EQC 'SRP.EditTable.1') then
|
|
// Show column name in popup title
|
|
If ControlType _EQC 'SRP.EditTable.1' then
|
|
ColHead = Get_Property(MissingCtrl, 'OLE.HeaderText[':ColPos + 1 : ';1]')
|
|
end else
|
|
ColHead = Send_Message(MissingCtrl, 'COLLABEL', ColPos, '')
|
|
end
|
|
Title = 'Missing Data - ' : ColHead
|
|
end else
|
|
ControlID = ControlID[5, Len(ControlID) - 4] ; // Remove XXX_ prefix
|
|
Convert '_' to ' ' in ControlID ; // Convert remaining underscores to spaces
|
|
Title = 'Missing Data - ' : NameCap(ControlID) ; // Capitalize all words
|
|
end
|
|
|
|
// Set special colors for controls in the application that support custom borders and other visual clues
|
|
// to help the end user. See PREFERENCE_MANAGER_EQUATES for more information.
|
|
FocusCtrl = Get_Property(Window, 'FOCUS')
|
|
FocusYPos = Get_Property(FocusCtrl, 'ORIG_Y')
|
|
FocusPageNo = Field(FocusYPos, ':', 2) + 1
|
|
MissingYPos = Get_Property(MissingCtrl, 'ORIG_Y')
|
|
MissingPageNo = Field(MissingYPos, ':', 2) + 1
|
|
// If the control with focus is not the required control then move the focus to the required control.
|
|
FocusCtrl = Get_Property(Window, 'FOCUS')
|
|
Form_Services('CloseControlMessage', FocusCtrl)
|
|
If MissingCtrl NE FocusCtrl then Set_Property(MissingCtrl, 'FOCUS', True$)
|
|
// If Column has a value then this is a required column in an SRP EditTable control.
|
|
If ColPos then Set_Property(MissingCtrl, 'OLE.SelPos', ColPos : @FM : 1)
|
|
// If the current page is different from the one the required control is on then send a VSCROLL event
|
|
// to the window so any page change logic will fire.
|
|
If MissingPageNo NE FocusPageNo then Send_Event(Window, 'VSCROLL', MissingPageNo)
|
|
MissingCtrl := ':' : ColPos : ',' : 1
|
|
Form_Services('DisplayControlMessage', 'This control must be populated before the data in this window can be saved.', Title, MissingCtrl, 'REQUIRED')
|
|
Response = 0
|
|
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetRequiredControls
|
|
//
|
|
// Param1 - Form whose required controls need to be returned. Default is @Window
|
|
//
|
|
// @@DEFINE_SERVICE(GetRequiredControls, Window)
|
|
//
|
|
// Returns an @FM delimited list of controls that are required for the current form. The default logic used by this
|
|
// service is to rely upon those fields which are set to be Required in the Form Designer. Other methods might be used
|
|
// to track required controls. In which case this logic should be adjusted accordingly. If the control is an edit table,
|
|
// then the required column will be appended to the control name with a colon (:) as the delimiter.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetRequiredControls:
|
|
Window = Param1
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
WindowID = Window[1, '*'] ; // Get the original name of the window.
|
|
|
|
RequiredCtrls = ''
|
|
QueryWindow = True$ ; // Assume the window will need to be searched for required controls for now.
|
|
HashKey = WindowID : '*' : Service
|
|
|
|
// First search the hash table for the required controls.
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
RequiredCtrls = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
AllControls = Utility('OBJECTLIST', Window, '')
|
|
|
|
BytePos = 1
|
|
Flag = ''
|
|
Loop
|
|
Remove Ctrl from AllControls at BytePos Setting Flag
|
|
RequiredFlag = Get_Property(Ctrl, 'REQUIRED')
|
|
If Index(RequiredFlag, @SVM, 1) then
|
|
// This control is an OpenInsight edit table. Each column that is required will be added to the list of
|
|
// required controls with its column number appended. If the edit table control is bound to an SRP
|
|
// EditTable control then the SRP EditTable will be returned.
|
|
SRPEditTable = Form_Services('GetSRPEditTable', Ctrl)
|
|
If Len(SRPEditTable) then
|
|
ETCtrl = SRPEditTable
|
|
end else
|
|
ETCtrl = Ctrl
|
|
end
|
|
NumColumns = Count(RequiredFlag, @SVM) + (RequiredFlag NE '')
|
|
For ColumnCnt = 1 to NumColumns
|
|
If RequiredFlag<0, 0, ColumnCnt> then
|
|
RequiredCtrls := ETCtrl : ':' : ColumnCnt : @FM
|
|
end
|
|
Next ColumnCnt
|
|
end else
|
|
If RequiredFlag then RequiredCtrls := Ctrl : @FM
|
|
end
|
|
While Flag
|
|
Repeat
|
|
RequiredCtrls[-1, 1] = '' ; // Strip off the final @FM.
|
|
|
|
NumReqCtrls = Count(RequiredCtrls, @FM) + (RequiredCtrls NE '')
|
|
If NumReqCtrls GT 0 then
|
|
// Remove all instances of the window name. Only store the control names so that multi-instance windows
|
|
// can be supported.
|
|
Swap Window : '.' with '' in RequiredCtrls
|
|
end
|
|
|
|
// Store the Key and Value pair in the hash table for quick retrieval later.
|
|
Memory_Services('SetValue', HashKey, RequiredCtrls)
|
|
end
|
|
|
|
Response = RequiredCtrls
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// IsRequiredControl
|
|
//
|
|
// Param1 - Fully qualified control entity ID being check to see if it is required. Note, if this is an SRP EditTable
|
|
// or OpenInsight edit table control there might be a column or cell position identifier appended.
|
|
//
|
|
// @@DEFINE_SERVICE(IsRequiredControl, CtrlEntId)
|
|
//
|
|
// Returns a True or False depending on whether the control is required or not.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
IsRequiredControl:
|
|
CtrlEntId = Param1
|
|
|
|
Window = CtrlEntId[1, '.']
|
|
ControlID = CtrlEntId[Col2() + 1, '.'] ; // Only need the actual control name without the window now.
|
|
ColPos = ''
|
|
If Count(ControlID, ':') then
|
|
ColPos = ControlID[-1, 'B:']
|
|
If Count(ColPos, ',') then
|
|
// The cell position was passed, just the ColPos value is needed.
|
|
ColPos = ColPos[1, ',']
|
|
ControlID = ControlID[1, ':']
|
|
ControlID := ':' : ColPos
|
|
end
|
|
end
|
|
WindowID = Window[1, '*'] ; // Get the original name of the window.
|
|
|
|
IsRequired = False$ ; // Assume the control is not required for now.
|
|
HashKey = WindowID : '.' : ControlID : '*' : Service
|
|
|
|
// First search the hash table for the control.
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
IsRequired = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
If Len(ControlID) AND Len(WindowID) then
|
|
// The GetRequiredControls service only returns the control names, not the fully qualified control entity
|
|
// IDs.
|
|
RequiredCtrls = Form_Services('GetRequiredControls', WindowID)
|
|
If Len(RequiredCtrls) then
|
|
Locate ControlID in RequiredCtrls using @FM setting fPos then IsRequired = True$
|
|
|
|
// Store the Key and Value pair in the hash table for quick retrieval later.
|
|
Memory_Services('SetValue', HashKey, IsRequired)
|
|
end
|
|
end else
|
|
Error_Services('Set', 'No control or window was passed to IsRequiredControl service.')
|
|
end
|
|
end
|
|
|
|
Response = IsRequired
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetNonRequiredControls
|
|
//
|
|
// Param1 - Form whose non-required controls need to be returns. Default is @Window
|
|
//
|
|
// @@DEFINE_SERVICE(GetNonRequiredControls, Window)
|
|
//
|
|
// Returns an @FM delimited list of controls that are not required for the current form. The default logic used by this
|
|
// service is to rely upon those fields which are set to be Required in the Form Designer. Other methods might be used
|
|
// to track non-required controls. In which case this logic should be adjusted accordingly. If the control is an edit
|
|
// table, then the required column will be appended to the control name with a colon (:) as the delimiter.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetNonRequiredControls:
|
|
Window = Param1
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
WindowID = Window[1, '*'] ; // Get the original name of the window.
|
|
|
|
NonRequiredCtrls = ''
|
|
HashKey = WindowID : '*' : Service
|
|
|
|
// First search the hash table for the required controls.
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
NonRequiredCtrls = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
AllControls = Utility('OBJECTLIST', Window, '')
|
|
|
|
BytePos = 1
|
|
Flag = ''
|
|
Loop
|
|
Remove Ctrl from AllControls at BytePos Setting Flag
|
|
RequiredFlag = Get_Property(Ctrl, 'REQUIRED')
|
|
If Index(RequiredFlag, @SVM, 1) then
|
|
// This control is an OpenInsight edit table. Each column that is not required will be added to the list
|
|
// of non required controls with its column number appended.
|
|
NumColumns = Count(RequiredFlag, @SVM) + (RequiredFlag NE '')
|
|
For ColumnCnt = 1 to NumColumns
|
|
If Not(RequiredFlag<0, 0, ColumnCnt>) then NonRequiredCtrls := Ctrl : ':' : ColumnCnt : @FM
|
|
Next ColumnCnt
|
|
end else
|
|
If Not(RequiredFlag) then NonRequiredCtrls := Ctrl : @FM
|
|
end
|
|
While Flag
|
|
Repeat
|
|
NonRequiredCtrls[-1, 1] = '' ; // Strip off the final @FM.
|
|
|
|
NumNonReqCtrls = Count(NonRequiredCtrls, @FM) + (NonRequiredCtrls NE '')
|
|
If NumNonReqCtrls GT 0 then
|
|
// Remove all instances of the window name. Only store the control names so that multi-instance windows
|
|
// can be supported.
|
|
Swap Window : '.' with '' in NonRequiredCtrls
|
|
end
|
|
|
|
// Store the Key and Value pair in the hash table for quick retrieval later.
|
|
Memory_Services('SetValue', HashKey, NonRequiredCtrls)
|
|
end
|
|
|
|
Response = NonRequiredCtrls
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DisplayValidationError
|
|
//
|
|
// Param1 - Fully qualified control entity ID to see if help is available. If null then the current control with FOCUS
|
|
// will be used.
|
|
// Param2 - Data being validated.
|
|
// Param3 - Validation pattern that was used.
|
|
// Param4 - Validation message to display. Default will dependon the validation pattern being used.
|
|
//
|
|
// @@DEFINE_SERVICE(DisplayValidationError, CtrlEntId, Data, ValidationPattern, ValidationMessage)
|
|
//
|
|
// Display validation error message for the current control.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
DisplayValidationError:
|
|
CtrlEntId = Param1
|
|
If Len(CtrlEntId) EQ 0 then CtrlEntId = Get_Property(@Window, '@LOSTFOCUSCONTROL')
|
|
Data = Param2
|
|
ValidationPattern = Param3
|
|
ValidationMessage = Param4
|
|
SystemFocus = Get_Property('SYSTEM', 'FOCUS')
|
|
|
|
Begin Case
|
|
Case Data EQ ''
|
|
Case ValidationPattern EQ ''
|
|
Case CtrlEntId EQ ''
|
|
Case SystemFocus EQ '' ; // A null system focus means a non-OpenInsight window has focus. Do not show
|
|
; // the SRP Popup display.
|
|
Case Otherwise$
|
|
Begin Case
|
|
Case Len(ValidationMessage) ; // Do nothing, message was passed in.
|
|
Case ValidationPattern[1, 1] EQ '<' ; ValidationMessage = Data : ' is not a valid item in the ' : ValidationPattern[2, '>'] : ' table.'
|
|
Case ValidationPattern[2, 3] EQ 'MD0' ; ValidationMessage = Data : ' is not a valid integer. Please correct.'
|
|
Case ValidationPattern[2, 2] EQ 'MD' ; ValidationMessage = Data : ' is not a valid decimal number. Please correct.'
|
|
Case ValidationPattern[2, 2] EQ 'DT' ; ValidationMessage = Data : ' is not a valid date and time entry. Please correct.'
|
|
Case ValidationPattern[2, 2] EQ 'MT' ; ValidationMessage = Data : ' is not a valid time entry. Please correct.'
|
|
Case ValidationPattern[2, 1] EQ 'B' ; ValidationMessage = Data : ' is not a valid boolean entry. Please correct.'
|
|
Case ValidationPattern[2, 1] EQ 'D' ; ValidationMessage = Data : ' is not a valid date entry. Please correct.'
|
|
End Case
|
|
|
|
Form_Services('DisplayControlMessage', ValidationMessage , 'Data Validation Error', CtrlEntId, 'VALIDATION')
|
|
End Case
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// HasContextHelpEnabled
|
|
//
|
|
// @@DEFINE_SERVICE(HasContextHelpEnabled)
|
|
//
|
|
// Returns a True or False depending on whether context help is currently enabled.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
HasContextHelpEnabled:
|
|
MDIFrame = Form_Services('GetMDIFrame')
|
|
If Get_Property(MDIFrame : '.MENU.HELP.CONTEXT_HELP', 'CHECK') then
|
|
Response = True$
|
|
end else
|
|
Response = False$
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ContextHelpVisible
|
|
//
|
|
// Param1 - Fully qualified control entity ID to see if help is available. This supports the extended format with
|
|
// the cell position being appended to the original control entity ID.
|
|
//
|
|
// @@DEFINE_SERVICE(ContextHelpVisible, CtrlEntId)
|
|
//
|
|
// Returns a True or False depending on whether the control has context help being displayed.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
ContextHelpVisible:
|
|
CtrlEntId = Param1
|
|
|
|
Window = CtrlEntId[1, '.']
|
|
|
|
UseTooltip = Memory_Services('GetValue', 'PM_USE_TOOLTIP_MESSAGES')
|
|
|
|
ContextHelpCtrl = Get_Property(Window, '@CONTEXTHELPCTRL')
|
|
|
|
If UseTooltip then
|
|
// There is no way to determine if a balloon tooltip is visible so always assume it is.
|
|
Response = True$
|
|
end else
|
|
PopupInfo = Form_Services('FindPopupControl', Window)
|
|
PopupCtrl = PopupInfo<1>
|
|
If (ContextHelpCtrl EQ CtrlEntId) AND Get_Property(PopupCtrl, 'OLE.Visible') then
|
|
Response = True$
|
|
end else
|
|
Response = False$
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DisplayContextHelp
|
|
//
|
|
// Param1 - Fully qualified control entity ID to see if help is available. If null then the current control with FOCUS
|
|
// will be used.
|
|
//
|
|
// @@DEFINE_SERVICE(DisplayContextHelp, CtrlEntId)
|
|
//
|
|
// Display context specific help for the current control if it is available.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
DisplayContextHelp:
|
|
CtrlEntId = Param1
|
|
|
|
SelPos = '' ; // Assume SelPos is unknown for now.
|
|
If Len(CtrlEntId) then
|
|
If Count(CtrlEntId, ':') then
|
|
SelPos = CtrlEntId[-1, 'B:']
|
|
If Count(SelPos, ',') then
|
|
Convert ',' to @FM in SelPos
|
|
end else
|
|
SelPos = ''
|
|
end
|
|
CtrlEntId = CtrlEntId[1, ':']
|
|
end
|
|
end else
|
|
CtrlEntId = Get_Property(@Window, 'FOCUS')
|
|
end
|
|
|
|
Window = CtrlEntId[1, '.']
|
|
If Window EQ '' then Window = @Window
|
|
ControlId = CtrlEntId[Col2() + 1, '.'] ; // Only need the actual control name without the window now.
|
|
WindowId = Window[1, '*'] ; // Get the original name of the window in case of multiple instances.
|
|
|
|
StatusHelp = ''
|
|
PopupHelp = ''
|
|
HashKey = WindowId : '*' : Service
|
|
HelpRec = ''
|
|
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
HelpRec = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
Open 'HELP' to hHelp then
|
|
Read HelpRec from hHelp, WindowId then
|
|
Memory_Services('SetValue', HashKey, HelpRec)
|
|
end
|
|
end else
|
|
Error_Services('Add', 'Unable to open the HELP table.')
|
|
Error_Services('DisplayError')
|
|
end
|
|
end
|
|
|
|
If Len(HelpRec) then
|
|
ControlIDs = HelpRec<4>
|
|
|
|
Locate ControlId in ControlIDs using @VM setting vPos then
|
|
ControlType = Get_Property(CtrlEntId, 'TYPE')
|
|
|
|
// Replace OLECONTROL with the ProgID if applicable.
|
|
If ControlType EQ 'OLECONTROL' then
|
|
ControlType = Get_Property(CtrlEntId, 'OLE.ProgId')
|
|
end
|
|
|
|
Begin Case
|
|
Case ControlType _EQC 'SRP.EditTable.1'
|
|
If Len(SelPos) EQ 0 then SelPos = Get_Property(CtrlEntId, 'OLE.SelPos')
|
|
ColPos = SelPos<1>
|
|
ControlId := '.' : ColPos
|
|
|
|
Case ControlType _EQC 'EDITTABLE'
|
|
If Len(SelPos) EQ 0 then SelPos = Get_Property(CtrlEntId, 'SELPOS')
|
|
ColPos = SelPos<1>
|
|
ControlId := '.' : ColPos
|
|
|
|
Case Otherwise$
|
|
ColPos = ''
|
|
End Case
|
|
|
|
// Get the StatusBar help, Popup help, and Help Title for the current control.
|
|
HashKey = WindowId : '.' : ControlId : '*' : Service
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
StatusHelp = Memory_Services('GetValue', WindowId : '.' : ControlId : '*' : Service : '*' : 'StatusHelp')
|
|
PopupHelp = Memory_Services('GetValue', WindowId : '.' : ControlId : '*' : Service : '*' : 'PopupHelp')
|
|
HelpTitle = Memory_Services('GetValue', WindowId : '.' : ControlId : '*' : Service : '*' : 'HelpTitle')
|
|
end else
|
|
// Create a base hash key to indicate that this control (and related column number, if applicable) has
|
|
// already been set.
|
|
Memory_Services('SetValue', HashKey, '')
|
|
|
|
StatusLineHelp = HelpRec<5>
|
|
WindowHelp = HelpRec<6>
|
|
ColStatusHelp = HelpRec<10>
|
|
ColWindowHelp = HelpRec<11>
|
|
|
|
// Retrieve and statusbar help.
|
|
If ColPos AND ColStatusHelp<0, vPos, ColPos> then
|
|
StatusHelp = ColStatusHelp<0, vPos, ColPos>
|
|
end else
|
|
StatusHelp = StatusLineHelp<0, vPos>
|
|
end
|
|
Memory_Services('SetValue', WindowId : '.' : ControlId : '*' : Service : '*' : 'StatusHelp', StatusHelp)
|
|
|
|
// Retrieve any context help.
|
|
If ColPos AND ColWindowHelp<0, vPos, ColPos> then
|
|
PopupHelp = ColWindowHelp<0, vPos, ColPos>
|
|
ColumnHelp = True$
|
|
end else
|
|
PopupHelp = WindowHelp<0, vPos>
|
|
ColumnHelp = False$
|
|
end
|
|
Memory_Services('SetValue', WindowId : '.' : ControlId : '*' : Service : '*' : 'PopupHelp', PopupHelp)
|
|
|
|
// Create a title for the Popup help
|
|
If ColumnHelp AND (ControlType EQ 'EDITTABLE' OR ControlType _EQC 'SRP.EditTable.1') then
|
|
// Show column name in popup title
|
|
If ControlType _EQC 'SRP.EditTable.1' then
|
|
ColHead = Get_Property(CtrlEntId, 'OLE.HeaderText[':ColPos + 1 : ';1]')
|
|
end else
|
|
ColHead = Send_Message(CtrlEntId, 'COLLABEL', ColPos, '')
|
|
end
|
|
HelpTitle = 'Context Help - ' : ColHead
|
|
end else
|
|
ControlName = ControlID[5, Len(ControlID) - 4] ; // Remove XXX_ prefix
|
|
Convert '_' to ' ' in ControlName ; // Convert remaining underscores to spaces
|
|
HelpTitle = 'Context Help - ' : NameCap(ControlName) ; // Capitalize all words
|
|
end
|
|
Memory_Services('SetValue', WindowId : '.' : ControlId : '*' : Service : '*' : 'HelpTitle', HelpTitle)
|
|
end
|
|
|
|
If Len(PopupHelp) AND Form_Services('HasContextHelpEnabled') then
|
|
// Convert the SelPos value to one that the Form_Services normally uses.
|
|
Convert @FM to ',' in SelPos
|
|
If Len(SelPos) then CtrlEntId := ':' : SelPos
|
|
Set_Property(Window, '@CONTEXTHELPCTRL', CtrlEntId)
|
|
Form_Services('DisplayControlMessage', PopupHelp, HelpTitle, CtrlEntId, 'HELP')
|
|
end else
|
|
Set_Property(Window, '@CONTEXTHELPCTRL', '')
|
|
end
|
|
Form_Services('DisplayStatusMessage', StatusHelp)
|
|
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DisplayControlMessage
|
|
//
|
|
// Param1 - Message that should be displayed for the current control.
|
|
// Param2 - Title that should be displayed for the control message.
|
|
// Param3 - Fully qualified control entity ID that is tied to the message.
|
|
// Param4 - Type of message being displayed. For example: HELP, VALIDATION, REQUIRED. This will determine the color
|
|
// scheme for the message display as defined by the Preferences Manager. Default is HELP.
|
|
// Param5 - Special color theme values to use for the message display. This will override the MessageType scheme.
|
|
//
|
|
// @@DEFINE_SERVICE(DisplayControlMessage, Message, Title, CtrlEntId, MessageType=MESSAGE_TYPE, Theme)
|
|
//
|
|
// Displays a special message below the control (or SRP EditTable cell) specified.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
DisplayControlMessage:
|
|
Message = Param1
|
|
Title = Param2
|
|
CtrlEntId = Param3
|
|
MessageType = Param4
|
|
Theme = Param5
|
|
UseTooltip = Memory_Services('GetValue', 'PM_USE_TOOLTIP_MESSAGES')
|
|
|
|
Display_Control_Message(Message, Title, CtrlEntId, MessageType, Theme, UseTooltip)
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DisplayStatusMessage
|
|
//
|
|
// Param1 - Message that should be displayed in the StatusBar control.
|
|
//
|
|
// @@DEFINE_SERVICE(DisplayStatusMessage, Message)
|
|
//
|
|
// Displays a message in the SRP StatusBar control on the MDI Frame.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
DisplayStatusMessage:
|
|
Message = Param1
|
|
|
|
Send_Info(' ' : Message)
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CloseControlMessage
|
|
//
|
|
// Param1 - Fully qualified control entity ID that is tied to the message. Default is control with focus.
|
|
//
|
|
// @@DEFINE_SERVICE(CloseControlMessage, CtrlEntId)
|
|
//
|
|
// Closes the special message below the control (or SRP EditTable cell) that was created with the DisplayControlMessage
|
|
// service.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CloseControlMessage:
|
|
CtrlEntId = Param1
|
|
If Len(CtrlEntId) EQ 0 then
|
|
CtrlEntId = Get_Property(@Window, 'FOCUS')
|
|
end
|
|
Window = CtrlEntId[1, '.']
|
|
|
|
Form_Services('SetControlThemeColors', CtrlEntId, Window)
|
|
|
|
UseTooltip = Memory_Services('GetValue', 'PM_USE_TOOLTIP_MESSAGES')
|
|
If UseTooltip then
|
|
ControlType = Get_Property(CtrlEntId, 'TYPE')
|
|
If ControlType EQ 'OLECONTROL' then
|
|
ControlType = Get_Property(CtrlEntId, 'OLE.ProgId')
|
|
end
|
|
Begin Case
|
|
Case ControlType _EQC 'SRP.EditTable.1'
|
|
Send_Message(CtrlEntId, 'OLE.HideBalloonTooltip')
|
|
|
|
Case ControlType _EQC 'EDITFIELD' OR ControlType _EQC 'EDITBOX'
|
|
SubclassInfo = Form_Services('FindSubclassControl', Window)
|
|
If Error_Services('NoError') then
|
|
Subclass = SubclassInfo<1>
|
|
Send_Message(Subclass, 'OLE.HideBalloonTooltip', CtrlEntId)
|
|
end
|
|
|
|
End Case
|
|
|
|
end else
|
|
PopupInfo = Form_Services('FindPopupControl', Window)
|
|
If Error_Services('NoError') then
|
|
PopupCtrl = PopupInfo<1>
|
|
If Get_Property(PopupCtrl, 'OLE.Visible') then
|
|
Send_Message(PopupCtrl, 'OLE.Close')
|
|
end
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ClearStatusMessage
|
|
//
|
|
// @@DEFINE_SERVICE(ClearStatusMessage)
|
|
//
|
|
// Clears the primary status pane of the SRP StatusBar control on the MDI Frame.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
ClearStatusMessage:
|
|
Send_Info(' ')
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// FindSubclassControl
|
|
//
|
|
// Param1 - Starting window to use for locating the SRP Subclass control. This is necessary if the calling routine
|
|
// originated from a different window than the one needing the SRP Subclass control features. @Window will be
|
|
// used as the default.
|
|
//
|
|
// @@DEFINE_SERVICE(FindSubclassControl, Window)
|
|
//
|
|
// Returns the full control name and handle of an SRP Subclass control. An attempt to find one is done first on the
|
|
// current window, then MDI Frame (if applicable), and finally the Parent window. It assumes that the SRP Subclass
|
|
// control will be named OLE_SUBCLASS. Used mostly for internal purposes (such as the SetFocusBorders and
|
|
// DisplayValidationError services).
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
FindSubclassControl:
|
|
Window = Param1
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
AtWindow = Window ; // Save the original window.
|
|
|
|
SubclassInfo = ''
|
|
HashKey = Window : '*' : Service
|
|
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
SubclassInfo = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
Handle = ''
|
|
For Location = 1 to 3
|
|
Begin Case
|
|
Case Location EQ 1 ; // Use the value already in Window
|
|
Case Location EQ 2 ; Window = Get_Property(AtWindow, 'MDIFRAME')
|
|
Case Location EQ 3 ; Window = Get_Property(AtWindow, 'PARENT')[1, '.']
|
|
End Case
|
|
If Len(Window) then
|
|
Subclass = Window : '.OLE_SUBCLASS'
|
|
Handle = Get_Property(Subclass, 'HANDLE')
|
|
end
|
|
Until Len(Handle)
|
|
Next Location
|
|
|
|
If Len(Handle) then
|
|
SubclassInfo = Subclass : @FM : Handle
|
|
|
|
// Store the Key and Value pair in the hash table for quick retrieval later.
|
|
Memory_Services('SetValue', HashKey, SubclassInfo)
|
|
end else
|
|
Error_Services('Set', AtWindow : ' is missing the Subclass control.')
|
|
end
|
|
end
|
|
|
|
Response = SubclassInfo
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// FindPopupControl
|
|
//
|
|
// Param1 - Starting window to use for locating the SRP Popup control. This is necessary if the calling routine
|
|
// originated from a different window than the one needing the SRP Popup control features. @Window will be
|
|
// used as the default.
|
|
//
|
|
// @@DEFINE_SERVICE(FindPopupControl, Window)
|
|
//
|
|
// Returns the full control name and handle of an SRP Popup control. An attempt to find one is done first on @Window,
|
|
// then MDI Frame (if applicable), and finally the Parent window. It assumes that the SRP Popup control will be named
|
|
// OLE_POPUP. Used mostly for internal purposes (such as the DisplayHelp function).
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
FindPopupControl:
|
|
Window = Param1
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
AtWindow = Window ; // Save the original window.
|
|
|
|
PopupInfo = ''
|
|
HashKey = Window : '*' : Service
|
|
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
PopupInfo = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
Handle = ''
|
|
For Location = 1 to 3
|
|
Begin Case
|
|
Case Location EQ 1 ; // Use the value already in Window
|
|
Case Location EQ 2 ; Window = Get_Property(AtWindow, 'MDIFRAME')
|
|
Case Location EQ 3 ; Window = Get_Property(AtWindow, 'PARENT')[1, '.']
|
|
End Case
|
|
If Len(Window) then
|
|
Popup = Window : '.OLE_POPUP'
|
|
Handle = Get_Property(Popup, 'HANDLE')
|
|
end
|
|
Until Len(Handle)
|
|
Next Location
|
|
|
|
If Len(Handle) then
|
|
PopupInfo = Popup : @FM : Handle
|
|
|
|
// Store the Key and Value pair in the hash table for quick retrieval later.
|
|
Memory_Services('SetValue', HashKey, PopupInfo)
|
|
end else
|
|
Error_Services('Set', AtWindow : ' is missing the Popup control.')
|
|
end
|
|
end
|
|
|
|
Response = PopupInfo
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetMDIFrame
|
|
//
|
|
// @@DEFINE_SERVICE(GetMDIFrame)
|
|
//
|
|
// Returns the MDI Frame used in this SRP FrameWorks application. Default is FRW_MAIN, but the developer might change
|
|
// this.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetMDIFrame:
|
|
MDIFrame = ''
|
|
|
|
HashKey = Service
|
|
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
MDIFrame = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
If Get_Property('FRW_MAIN', 'HANDLE') then
|
|
MDIFrame = 'FRW_MAIN'
|
|
end else
|
|
If @Window[1, 3] EQ 'FRW' then
|
|
// The MDI Frame should at least start with 'FRW'. If @Window has this prefix then just return @Window.
|
|
MDIFrame = @Window
|
|
end else
|
|
// The first two obvious checks failed. Now check @Window's MDIFRAME property. If it comes back with a value
|
|
// then @Window is an MDI Child window *or* it is an MDI Frame. Both return a value in the MDIFRAME property.
|
|
If Get_Property(@Window, 'MDIFRAME') then
|
|
MDIFrame = Get_Property(@Window, 'MDIFRAME')
|
|
end else
|
|
// @Window does not have an MDI Frame so it might be a dialog box with the MDI Frame as the parent.
|
|
// Get @Window's PARENT property and confirm if it is an MDI Frame window.
|
|
If Get_Property(@Window, 'PARENT') then
|
|
Parent = Get_Property(@Window, 'PARENT')
|
|
If Get_Property(Parent, 'MDIFRAME') then
|
|
MDIFrame = Get_Property(Parent, 'MDIFRAME')
|
|
end
|
|
end
|
|
end
|
|
end
|
|
end
|
|
end
|
|
|
|
If Len(MDIFrame) then
|
|
Memory_Services('SetValue', HashKey, MDIFrame)
|
|
end else
|
|
Error_Services('Set', 'Unable to find the MDI Frame for this application.')
|
|
end
|
|
|
|
Response = MDIFrame
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// IsMDIChild
|
|
//
|
|
// Param1 - Window that is being examined to see if it is an MDI Child. Default is @Window.
|
|
//
|
|
// @@DEFINE_SERVICE(IsMDIChild, Window)
|
|
//
|
|
// Returns a True or False depending on whether the window is an MDI Child or not.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
IsMDIChild:
|
|
Window = Param1
|
|
If Len(Window) else Window = @Window
|
|
IsMDIChild = False$ ; // Assume false until proven otherwise.
|
|
|
|
MDIFrame = Form_Services('GetMDIFrame')
|
|
If Error_Services('NoError') then
|
|
IsMDIChild = (Get_Property(Window, 'MDIFRAME') EQ MDIFrame)
|
|
end
|
|
|
|
Response = IsMDIChild
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SelectOpenWindowsItem
|
|
//
|
|
// Param1 - Window whose launchbar item should get selected.
|
|
//
|
|
// @@DEFINE_SERVICE(SelectOpenWindowsItem, Window)
|
|
//
|
|
// Selects the LaunchBar Open Windows item according to the window being passed in.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SelectOpenWindowsItem:
|
|
Window = Param1
|
|
|
|
If Len(Window) then
|
|
GroupKey = 'Open Windows*Open Windows'
|
|
MDIFrame = Form_Services('GetMDIFrame')
|
|
If Error_Services('NoError') then
|
|
LaunchBar = MDIFrame : '.OLE_TREE_LAUNCHBAR'
|
|
RootKeys = Get_Property(LaunchBar, 'OLE.RootChildren')
|
|
Locate GroupKey in RootKeys Using @FM Setting fPos then
|
|
ItemKey = 'Open Windows*' : Window
|
|
OpenWinKeys = Get_Property(LaunchBar, 'OLE.ItemChildren[' : GroupKey : ']')
|
|
Locate ItemKey in OpenWinKeys Using @FM Setting fPos then
|
|
// Select Open Windows launchbar item
|
|
Set_Property(LaunchBar, 'OLE.FocusItem', '')
|
|
Set_Property(LaunchBar, 'OLE.SelectedItems', Itemkey)
|
|
end
|
|
end
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetOIEditTable
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the SRP EditTable.
|
|
//
|
|
// @@DEFINE_SERVICE(GetOIEditTable, SRPEditTable)
|
|
//
|
|
// Returns the fully qualified control entity ID of the OpenInsight edit table control that is linked to the indicated
|
|
// SRP EditTable control.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetOIEditTable:
|
|
SRPEditTable = Param1
|
|
|
|
If Len(SRPEditTable) then
|
|
// First check to see if the @OIEDITTABLE UDP has already been set. If so, then assume this is valid. The
|
|
// SRP_EditTable_Manager utility will automatically update this.
|
|
OIEditTable = Get_Property(SRPEditTable, '@OIEDITTABLE')
|
|
If Len(OIEditTable) then
|
|
Response = OIEditTable
|
|
end else
|
|
// Take an educated guess at the OpenInsight edit table name based on standard naming conventions.
|
|
OIEditTable = SRPEditTable
|
|
Swap 'OLE_EDT' with 'EDT' in OIEditTable
|
|
If Get_Property(OIEditTable, 'HANDLE') then
|
|
Set_Property(SRPEditTable, '@OIEDITTABLE', OIEditTable)
|
|
Response = OIEditTable
|
|
end else
|
|
OIEditTable = SRPEditTable
|
|
Swap 'SRP_EDT' with 'EDT' in OIEditTable
|
|
If Get_Property(OIEditTable, 'HANDLE') then
|
|
Set_Property(SRPEditTable, '@OIEDITTABLE', OIEditTable)
|
|
Response = OIEditTable
|
|
end
|
|
end
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSRPEditTable
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the OpenInsight edit table.
|
|
//
|
|
// @@DEFINE_SERVICE(GetSRPEditTable, OIEditTable)
|
|
//
|
|
// Returns the fully qualified control entity ID of the SRP EditTable control that is linked to the indicated
|
|
// OpenInsight edit table.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetSRPEditTable:
|
|
OIEditTable = Param1
|
|
|
|
If Len(OIEditTable) then
|
|
// First check to see if the @SRPEDITTABLE UDP has already been set. If so, then assume this is valid. The
|
|
// SRP_EditTable_Manager utility will automatically update this.
|
|
SRPEditTable = Get_Property(OIEditTable, '@SRPEDITTABLE')
|
|
If Len(SRPEditTable) then
|
|
Response = SRPEditTable
|
|
end else
|
|
// Take an educated guess at the SRP EditTable name based on standard naming conventions.
|
|
SRPEditTable = OIEditTable
|
|
Swap 'EDT' with 'OLE_EDT' in SRPEditTable
|
|
If Get_Property(SRPEditTable, 'HANDLE') then
|
|
Set_Property(OIEditTable, '@SRPEDITTABLE', SRPEditTable)
|
|
Response = SRPEditTable
|
|
end else
|
|
SRPEditTable = OIEditTable
|
|
Swap 'EDT' with 'SRP_EDT' in SRPEditTable
|
|
If Get_Property(SRPEditTable, 'HANDLE') then
|
|
Set_Property(OIEditTable, '@SRPEDITTABLE', SRPEditTable)
|
|
Response = SRPEditTable
|
|
end
|
|
end
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetFormCommuter
|
|
//
|
|
// Param1 - The name of the window (form) whose commuter is being retrieved.
|
|
//
|
|
// @@DEFINE_SERVICE(GetFormCommuter, Window)
|
|
//
|
|
// Returns the name of the current window's commuter module if it exists. If it does not exist then a null response will
|
|
// be returned.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetFormCommuter:
|
|
Window = Param1
|
|
|
|
If Len(Window) EQ 0 then Window = @Window
|
|
WindowID = Window[1, '*'] ; // Get the original name of the window.
|
|
HashKey = WindowID : '*' : Service
|
|
Commuter = ''
|
|
|
|
// First search the hash table for the form commuter.
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
Commuter = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
NumApps = Count(@APPID, @FM) + (@APPID NE '')
|
|
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SysObjKey = '$' : Window : '_EVENTS'
|
|
end else
|
|
SysObjKey = '$' : Window : '_EVENTS' : '*' : AppID
|
|
end
|
|
ObjExists = (Xlate('SYSOBJ', SysObjKey, 0, 'X') GT '')
|
|
Until ObjExists
|
|
Next AppCnt
|
|
|
|
If ObjExists then Commuter = Window : '_EVENTS'
|
|
Memory_Services('SetValue', HashKey, Commuter)
|
|
end
|
|
|
|
Response = Commuter
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetEventCommuter
|
|
//
|
|
// Param1 - The name of the event type whose commuter is being retrieved.
|
|
//
|
|
// @@DEFINE_SERVICE(GetEventCommuter, EventType)
|
|
//
|
|
// Returns the name of the current event's commuter module if it exists. If it does not exist then a null response will
|
|
// be returned.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetEventCommuter:
|
|
EventType = Param1
|
|
|
|
Commuter = ''
|
|
|
|
If Len(EventType) then
|
|
HashKey = EventType : '*' : Service
|
|
|
|
// First search the hash table for the form commuter.
|
|
If Memory_Services('KeyExists', HashKey) then
|
|
Commuter = Memory_Services('GetValue', HashKey)
|
|
end else
|
|
NumApps = Count(@APPID, @FM) + (@APPID NE '')
|
|
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SysObjKey = '$PROMOTED_' : EventType : '_EVENT'
|
|
end else
|
|
SysObjKey = '$PROMOTED_' : EventType : '_EVENT' : '*' : @APPID<AppCnt>
|
|
end
|
|
ObjExists = (Xlate('SYSOBJ', SysObjKey, 0, 'X') GT '')
|
|
Until ObjExists
|
|
Next AppCnt
|
|
|
|
If ObjExists then Commuter = 'PROMOTED_' : EventType : '_EVENT'
|
|
Memory_Services('SetValue', HashKey, Commuter)
|
|
end
|
|
end
|
|
|
|
Response = Commuter
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CreateCommandLink
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the SRP Button control.
|
|
// Param2 - Text to show in the primary label for the command link.
|
|
// Param3 - Icon that should appear to the left of the label. Default is CommandLink.png.
|
|
//
|
|
// @@DEFINE_SERVICE(CreateCommandLink2, CtrlEntId, Label, Icon)
|
|
//
|
|
// Styles the SRP Button control to visually resemble a Windows 8 command link. This does not yet support multiple lines
|
|
// of an explantion.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CreateCommandLink:
|
|
CtrlEntId = Param1
|
|
Label = Param2
|
|
Icon = Param3
|
|
|
|
If Len(Icon) else Icon = ImagePath$ : 'CommandLink.png'
|
|
|
|
// Get the measurments of the icon image so that it can be positioned properly in the command link.
|
|
objPicture = Utility('LOAD_PICTURE', Icon)
|
|
PictureInfo = Utility('PICTURE_PROPS', objPicture)
|
|
rv = Utility('IUNKNOWN_RELEASE', objPicture)
|
|
HimWidth = PictureInfo<4>
|
|
HimHeight = PictureInfo<5>
|
|
ImageWidth = Int(HimWidth * 96 / 2540 + .5)
|
|
ImageHeight = Int(HimHeight * 96 / 2540 + .5)
|
|
HeightAdj = 0
|
|
WidthAdj = 0
|
|
|
|
If ImageHeight GT 18 then HeightAdj += ImageHeight - 18
|
|
If ImageWidth GT 18 then WidthAdj += ImageWidth - 18
|
|
|
|
ProgID = Get_Property(CtrlEntId, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.Button.1' then
|
|
Set_Property(CtrlEntId, 'OLE.Style', 'Standard')
|
|
Background = ''
|
|
Background<2> = 'Vertical(Gradient(RGB(229, 243, 251), RGB(229, 243, 251)), Border(RGB(112, 192, 231)))'
|
|
Background<3> = 'Vertical(Gradient(RGB(209, 232, 255), RGB(209, 232, 255)), Border(RGB(102, 167, 232)))'
|
|
Background<5> = 'Vertical(Gradient(RGB(209, 232, 255), RGB(209, 232, 255)), Border(RGB(102, 167, 232)))'
|
|
Set_Property(CtrlEntId, 'OLE.Background', Background)
|
|
Set_Property(CtrlEntId, 'OLE.BackVisible', False$)
|
|
IconList = Icon : @VM : 'L9' : @VM : 'C'
|
|
Set_Property(CtrlEntId, 'OLE.IconList', IconList)
|
|
CaptionList = Label : @VM : 'L' : 31 + WidthAdj : @VM : 'C' : @VM : SystemTypeface$ : @SVM : 11 : @VM : 'RGB(21,28,85)'
|
|
Set_Property(CtrlEntId, 'OLE.CaptionList', CaptionList)
|
|
end else
|
|
Error_Services('Add', 'No valid SRP Button control was passed into the ' : Service : '.')
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CreateCommandLink2
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the SRP Button control.
|
|
// Param2 - Text to show in the primary label for the command link.
|
|
// Param3 - Icon that should appear to the left of the label. Default is CommandLink.png.
|
|
// Param4 - Supplemental explanation that describes the purpose for this command link.
|
|
//
|
|
// @@DEFINE_SERVICE(CreateCommandLink2, CtrlEntId, Label, Icon, Explanation)
|
|
//
|
|
// Styles the SRP Button control to visually resemble a standard command link. This does not yet support multiple lines
|
|
// of an explantion.
|
|
// (see http://msdn.microsoft.com/en-us/library/windows/desktop/aa511455.aspx)
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CreateCommandLink2:
|
|
CtrlEntId = Param1
|
|
Label = Param2
|
|
Icon = Param3
|
|
Explanation = Param4
|
|
|
|
If Len(Icon) else Icon = ImagePath$ : 'CommandLink.png'
|
|
|
|
// Get the measurments of the icon image so that it can be positioned properly in the command link.
|
|
objPicture = Utility('LOAD_PICTURE', Icon)
|
|
PictureInfo = Utility('PICTURE_PROPS', objPicture)
|
|
rv = Utility('IUNKNOWN_RELEASE', objPicture)
|
|
HimWidth = PictureInfo<4>
|
|
HimHeight = PictureInfo<5>
|
|
ImageWidth = Int(HimWidth * 96 / 2540 + .5)
|
|
ImageHeight = Int(HimHeight * 96 / 2540 + .5)
|
|
HeightAdj = 0
|
|
WidthAdj = 0
|
|
|
|
If ImageHeight GT 18 then HeightAdj += ImageHeight - 18
|
|
If ImageWidth GT 18 then WidthAdj += ImageWidth - 18
|
|
|
|
ProgID = Get_Property(CtrlEntId, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.Button.1' then
|
|
Set_Property(CtrlEntId, 'OLE.Style', 'Standard')
|
|
Background = ''
|
|
Background<2> = 'Vertical(Gradient(White, RGB(248, 248, 248), 30%), Gradient(RGB(248, 248, 248), RGB(246, 246, 246)), Border(RGB(198, 198, 198)), Rounded(2))'
|
|
Background<5> = 'Vertical(Gradient(White, White), Border(RGB(204, 245, 255)), Rounded(2))'
|
|
Set_Property(CtrlEntId, 'OLE.Background', Background)
|
|
Set_Property(CtrlEntId, 'OLE.BackVisible', False$)
|
|
IconList = Icon : @VM : 'L9' : @VM : 'T15'
|
|
Set_Property(CtrlEntId, 'OLE.IconList', IconList)
|
|
CaptionList = Label : @VM : 'L' : 31 + WidthAdj : @VM : 'T11' : @VM : SystemTypeface$ : @SVM : 11 : @VM : 'RGB(7,74,229)'
|
|
If Len(Explanation) then
|
|
CaptionList := @FM : Explanation : @VM : 'L' : 31 + WidthAdj : @VM : 'T32' : @VM : SystemFont$ : @VM : 'RGB(21,28,85)'
|
|
end
|
|
Set_Property(CtrlEntId, 'OLE.CaptionList', CaptionList)
|
|
end else
|
|
Error_Services('Add', 'No valid SRP Button control was passed into the ' : Service : '.')
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CreateProgressBar
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the SRP StatusBar control.
|
|
// Param2 - Type of progress bar to display. Default is Progress Caption.
|
|
//
|
|
// @@DEFINE_SERVICE(CreateProgressBar, CtrlEntId, Type=PaneType)
|
|
//
|
|
// @@DEFINE_QUOTED_OPTIONS PaneType(Percent, Blocks, Marquee)
|
|
//
|
|
// Styles the SRP StatusBar control to visually resemble a standard progress bar.
|
|
// (http://msdn.microsoft.com/en-us/library/windows/desktop/aa511486.aspx)
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CreateProgressBar:
|
|
CtrlEntId = Param1
|
|
Type = Param2
|
|
|
|
ProgID = Get_Property(CtrlEntId, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.StatusBar.1' then
|
|
Set_Property(CtrlEntId, 'OLE.PaneCount', 1)
|
|
Set_Property(CtrlEntId, 'OLE.Resizable', False$)
|
|
Set_Property(CtrlEntId, 'OLE.PaneAlignment[1]', 'Center')
|
|
Set_Property(CtrlEntId, 'OLE.PanePercent[1]', 0)
|
|
|
|
Begin Case
|
|
Case Type _EQC 'Caption' ; Type = 'PC'
|
|
Case Type _EQC 'Blocks' ; Type = 'PB'
|
|
Case Type _EQC 'Marquee' ; Type = 'PM'
|
|
Case Otherwise$ ; Type = 'PC'
|
|
End Case
|
|
Set_Property(CtrlEntId, 'OLE.PaneType[1]', Type)
|
|
|
|
Border = 'Thin Sunken'
|
|
PaneColors = ''
|
|
PaneColors<1> = 'MenuText'
|
|
PaneColors<2> = 'XP'
|
|
PaneColors<3> = 'SelectText'
|
|
PaneColors<4> = 'XP'
|
|
PaneColors<5> = '0'
|
|
PaneColors<6> = '0'
|
|
Set_Property(CtrlEntId, 'OLE.PaneBorder[1]', Border)
|
|
Set_Property(CtrlEntId, 'OLE.PaneColors[1]', PaneColors)
|
|
end else
|
|
Error_Services('Add', 'No valid SRP StatusBar control was passed into the ' : Service : '.')
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetProgressBarPercent
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the SRP StatusBar control.
|
|
// Param2 - Percent to set in the progress bar.
|
|
//
|
|
// @@DEFINE_SERVICE(SetProgressBarPercent, CtrlEntId, Percent)
|
|
//
|
|
// Updates the percent of the progress bar. A value of 1 to 100 is expected.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetProgressBarPercent:
|
|
CtrlEntId = Param1
|
|
Percent = Param2
|
|
|
|
ProgID = Get_Property(CtrlEntId, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.StatusBar.1' then
|
|
Set_Property(CtrlEntId, 'OLE.PanePercent[1]', Percent)
|
|
end else
|
|
Error_Services('Add', 'No valid SRP StatusBar control was passed into the ' : Service : '.')
|
|
end
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetProgressBarPercent
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the SRP StatusBar control.
|
|
//
|
|
// @@DEFINE_SERVICE(GetProgressBarPercent, CtrlEntId)
|
|
//
|
|
// Returns the percent of the progress bar. A value of 1 to 100 is expected.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
GetProgressBarPercent:
|
|
CtrlEntId = Param1
|
|
|
|
Percent = ''
|
|
|
|
ProgID = Get_Property(CtrlEntId, 'OLE.ProgID')
|
|
If ProgID _EQC 'SRP.StatusBar.1' then
|
|
Percent = Get_Property(CtrlEntId, 'OLE.PanePercent[1]')
|
|
end else
|
|
Error_Services('Add', 'No valid SRP StatusBar control was passed into the ' : Service : '.')
|
|
end
|
|
|
|
Response = Percent
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DisplayWaitScreen
|
|
//
|
|
// Param1 - Window (form) to be restored. Default is @Window. - [Optional]
|
|
// Param2 - Caption. Caption to display on the wait screen. - [Optional]
|
|
//
|
|
// @@DEFINE_SERVICE(DisplayWaitScreen, Window, Caption)
|
|
//
|
|
// Displays a banner that alerts the user to wait.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
DisplayWaitScreen:
|
|
Window = Param1
|
|
If Len(Window) else Window = @Window
|
|
Caption = Param2
|
|
|
|
Utility('CURSOR', 'H')
|
|
Declare subroutine GetCursorPos, ScreenToClient
|
|
Declare function Blank_Struct, Struct_To_Var, SRP_Get_Window_Rect
|
|
WinSize = SRP_Get_Window_Rect(Window)
|
|
|
|
PopupInfo = Form_Services('FindPopupControl', Window)
|
|
PopupCtrl = PopupInfo<1>
|
|
Set_Property(PopupCtrl, 'OLE.Size', WinSize)
|
|
Set_Property(PopupCtrl, 'OLE.Theme', 'Custom')
|
|
ItemList = ''
|
|
ItemList<0, 1> = 0 : @SVM : 0 : @SVM : WinSize<3> : @SVM : WinSize<4>
|
|
ItemList<0, 2> = Caption
|
|
ItemList<0, 3> = 'Black'
|
|
ItemList<0, 4> = SystemTypeface$ : @SVM : 30 : @SVM : 700
|
|
ItemList<0, 5> = 'Center' : @SVM : 'Center'
|
|
Set_Property(PopupCtrl, 'OLE.ItemList', ItemList)
|
|
Set_Property(PopupCtrl, 'OLE.Background', 'Silver' : @FM : 'Silver' : @FM : 'Silver')
|
|
Set_Property(PopupCtrl, 'OLE.Opacity', 90)
|
|
Send_Message(PopupCtrl, 'OLE.ShowAt', WinSize<1>, WinSize<2>)
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CloseWaitScreen
|
|
//
|
|
// Param1 - Window (form) to be restored. Default is @Window. - [Optional]
|
|
//
|
|
// @@DEFINE_SERVICE(CloseWaitScreen, Window)
|
|
//
|
|
// Closes the wait banner.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CloseWaitScreen:
|
|
Window = Param1
|
|
If Len(Window) else Window = @Window
|
|
|
|
PopupInfo = Form_Services('FindPopupControl', Window)
|
|
PopupCtrl = PopupInfo<1>
|
|
Send_Message(PopupCtrl, 'OLE.Close')
|
|
Utility('CURSOR', 'A')
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DisplayWaitBanner
|
|
//
|
|
// Param1 - Caption to display in the NDW_WAIT form.
|
|
// Param2 - Text to display in the NDW_WAIT form above the progress bar.
|
|
// Param3 - Object to center NDW_WAIT over. Default is SYSTEM (i.e., desktop).
|
|
// Param4 - Initial percentage value to set the progress bar to.
|
|
//
|
|
// @@DEFINE_SERVICE(DisplayWaitBanner, BannerCaption, BannerText, CenterObject, InitialPercent)
|
|
//
|
|
// Displays the NDW_WAIT form with predefined values. This form is launched modeless so processing from the parent
|
|
// object can continue.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
DisplayWaitBanner:
|
|
BannerCaption = Param1
|
|
BannerText = Param2
|
|
CenterObject = Param3
|
|
InitialPercent = Param4
|
|
|
|
If Len(BannerCaption) else BannerCaption = FrameWorks_Services('GetAppInfoRow', 'ABOUT', 1)
|
|
If Len(BannerText) else BannerText = 'Please wait...'
|
|
If Len(CenterObject) else CenterObject = 'SYSTEM'
|
|
If Not(Num(InitialPercent)) then InitialPercent = 0
|
|
If InitialPercent LT 0 OR InitialPercent GT 100 then InitialPercent = 0
|
|
|
|
MDIFrame = Form_Services('GetMDIFrame')
|
|
|
|
Create_Dialog('NDW_WAIT', MDIFrame, True$, BannerCaption : @FM : BannerText : @FM : CenterObject : @FM : InitialPercent)
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetWaitBanner
|
|
//
|
|
// Param1 - Fully qualified control entity ID of the SRP StatusBar control.
|
|
// Param2 - Type of progress bar to display. Default is Progress Caption.
|
|
//
|
|
// @@DEFINE_SERVICE(SetWaitBanner, BannerText, Percent)
|
|
//
|
|
// Sets the NDW_WAIT form with with new banner text and new progress bar values.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
SetWaitBanner:
|
|
BannerText = Param1
|
|
Percent = Param2
|
|
|
|
If Not(Num(Percent)) then Percent = 0
|
|
If Percent LT 0 OR Percent GT 100 then Percent = 0
|
|
|
|
If Len(BannerText) then
|
|
Set_Property('NDW_WAIT.STA_TEXT', 'TEXT', BannerText)
|
|
end
|
|
|
|
If Percent GT 0 then
|
|
Form_Services('SetProgressBarPercent', 'NDW_WAIT.OLE_STATUS', Percent)
|
|
end
|
|
|
|
// Call Yield to allow the engine an opertunity to process the UI changes.
|
|
Yield();Yield();Yield();Yield();Yield();Yield();Yield();Yield();Yield();Yield()
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CloseWaitBanner
|
|
//
|
|
// @@DEFINE_SERVICE(CloseWaitBanner)
|
|
//
|
|
// Closes the NDW_WAIT form.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CloseWaitBanner:
|
|
Send_Event('NDW_WAIT', 'CLOSE')
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// IsKeyControl
|
|
//
|
|
// Param1 - Fully qualified control. If null, then default will be the control that has focus.
|
|
//
|
|
// @@DEFINE_SERVICE(IsKeyControl, CtrlEntId)
|
|
//
|
|
// Determines if the passed in control is bound to a Key ID column. It returns a True if so or a False is not.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
IsKeyControl:
|
|
CtrlEntId = Param1
|
|
|
|
If Len(CtrlEntId) else
|
|
CtrlEntId = Get_Property(@Window, 'FOCUS')
|
|
end
|
|
|
|
Pos = Get_Property(CtrlEntId, 'POS')
|
|
If Pos EQ 0 then
|
|
IsKey = True$
|
|
end else
|
|
IsKey = False$
|
|
end
|
|
|
|
Response = IsKey
|
|
return
|