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 = '' If Index(CurrentText, LockedText, 1) then Text := ' - ' : LockedText end NumSources = Count(NewText, @FM) + (NewText NE '') AllAddedText = '' For SourceCnt = 1 to NumSources Source = NewText 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 := ' - ' 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') 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 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 If AppID _EQC 'SYSPROG' then SysObjKey = '$PROMOTED_' : EventType : '_EVENT' end else SysObjKey = '$PROMOTED_' : EventType : '_EVENT' : '*' : @APPID 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