Subroutine Display_Control_Message(Message, Title, CtrlEntId, MessageType, Theme, UseTooltip) /*********************************************************************************************************************** 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 : Display_Control_Message Description : Display status line and/or context help if available for the current control with focus. Context help is displaying using the SRP Popup control as located by the FindPopupControl service request. Ordinarily this will be on the MDI Frame but if one exists on the active window it will be used instead. Notes : Parameters : Message [in] -- Message that should be displayed for the current control. Title [in] -- Title that should be displayed for the control message. CtrlEntId [in] -- Fully qualified control entity ID that is tied to the message. MessageType [in] -- 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. Theme [in] -- Special color theme values to use for the message display. This will override the MessageType scheme. UseTooltip [in] -- Use the balloon tooltip to display the control message instead of the SRP Popup control. Default is False. History : (Date, Initials, Notes) 03/13/13 dmb Original developer. - [SRPFW-9] 03/18/13 dmb Use the MDIACTIVE property to bring the window in focus if needed. This will help avoid the appearance of orphaned message displays. - [SRPFW-9] 03/18/13 dmb Set the Theme property to 'Custom' to make sure the special background colors will be seen property. - [SRPFW-9] 03/19/13 dmb Refactor code. Make minor adjustments so the width of the SRP Popup will never be any narrower than the control or cell it is underneath. - [SRPFW-9] 03/25/13 dmb Use the GetAppInfoRow service to replace hard-coded colors with the Preference Manager colors. - [SRPFW-9] ***********************************************************************************************************************/ $insert APP_INSERTS Equ DTM_READCELLRECT$ to 1079 Equ DTM_GETCELLLEFTBOTTOM$ to 1160 Equ DTA_CURRENT$ to 1 Declare function NameCap, SendMessage, SRP_Get_Window_Rect, Struct_To_Var Done = False$ ProcessCnt = 0 Loop ProcessCnt += 1 Until Done OR Error_Services('HasError') On ProcessCnt GoSub Init_Vars, Find_Popup_Ctrl, Display_Message Repeat Return Init_Vars: If Assigned(Message) else Message = '' If Len(Message) EQ 0 then Error_Services('Add', 'Message argument was not assigned a value') If Assigned(Title) else Title = '' If Assigned(CtrlEntId) else CtrlEntId = '' If Len(CtrlEntId) EQ 0 then CtrlEntId = Get_Property(@Window, 'FOCUS') If Count(CtrlEntId, ':') then ColPos = CtrlEntId[-1, 'B:'] If Count(ColPos, ',') then RowPos = ColPos[-1, 'B,'] ColPos = ColPos[1, ','] end else RowPos = 1 end CtrlEntId = CtrlEntId[1, ':'] end else ColPos = '' RowPos = '' end If Assigned(MessageType) else MessageType = '' If Len(MessageType) EQ 0 then MessageType = 'HELP' If Assigned(Theme) else Theme = '' If Assigned(UseTooltip) else UseTooltip = False$ Begin Case Case Len(Theme) BackColor = Theme Icon = 0 Case MessageType _EQC 'HELP' BackColor = Memory_Services('GetValue', 'PM_CONTROL_WITH_ATTENTION') Icon = 1 Case MessageType _EQC 'VALIDATION' BackColor = Memory_Services('GetValue', 'PM_VALIDATION_ERROR') Icon = 3 Case MessageType _EQC 'REQUIRED' BackColor = Memory_Services('GetValue', 'PM_REQ_CONTROL_WITH_ATTENTION') Icon = 2 Case Otherwise$ BackColor = 'Select L=30' Icon = 0 End Case TextColor = 'White' Window = CtrlEntId[1, '.'] SubclassInfo = Form_Services('FindSubclassControl', Window) If Error_Services('NoError') then Subclass = SubclassInfo<1> end return Find_Popup_Ctrl: PopupInfo = Form_Services('FindPopupControl', Window) If Error_Services('NoError') then PopupCtrl = PopupInfo<1> end else Done = True$ end return Display_Message: If UseTooltip then Config = Message : @FM : Title : @FM : Icon : @FM : 0 If Len(ColPos) then // This is an SRP EditTable control. Use the internal ShowBalloonTooltip method. Send_Message(CtrlEntId, 'OLE.ShowBalloonTooltip', ColPos : @FM : RowPos, Config) end else // This is a regular control. Use the SRP Subclass control. Send_Message(Subclass, 'OLE.ShowBalloonTooltip', CtrlEntId, Config) end end else // Using the title and message content, calculate the values needed to determine the property width and height of // the SRP Popup control. Convert @TM to @FM in Message NumLines = Count(Message, @FM) + (Message NE '') // First loop through to find longest line. TitleLen = Len(Title) // 51 = 300 pixels divided by 5.9 multiplier. If TitleLen LT 51 then MaxLen = 59 ; // 300 pixels divided by 5.1 multiplier end else MaxLen = TitleLen end LongLen = TitleLen ; // Longest length will be used later to calculate ItemCX. For ItemNo = NumLines To 1 Step -1 TextLen = Len(Message) If TextLen GT MaxLen then // Wrap long text lines LongLen = MaxLen ItemAdd = 0 TextLine = Message Loop While TextLen GT MaxLen // Split line at previous space. TempLine = TextLine[1, MaxLen] TempText = TempLine[-1, 'B '] Message = Insert(Message, ItemNo + ItemAdd, 0, 0, TextLine[1, Col1() - 1]) // Reset remaining text and recalculate length. TextLine = TempText : TextLine[MaxLen + 1, TextLen - MaxLen] TextLen = Len(TextLine) ItemAdd += 1 Repeat Message = TextLine[1, MaxLen] ; // Add additional item text. end else If TextLen GT LongLen then LongLen = TextLen end Next ItemNo NumLines = Count(Message, @FM) + (Message NE '') ; // Recalculate this for popup display. // Determine multiplier to calculate number of pixels. If LongLen EQ TitleLen then PixMult = 5.9 ; // Title is bold so it requires more pixels end else PixMult = 6 ; // 5.2 wasn't quite enough for some lines end ItemWidth = PixMult * LongLen FullWidth = ItemWidth + 20 ; // Add 10 to each side for margins. ItemCnt = 0 LeftMarg = 11 ItemHeight = 13 ; // Standard height for a non-bold item. TitleHeight = 15 ; // Standard height for a bold item. VertPos = 5 ; // The first item will be 5 pixels from the top of the SRP Popup display. // Begin calculation the specific x and y coordinates for the SRP Popup display based on the control's // information and control type. This will be used in the ShowAt method. CtrlSize = SRP_Get_Window_Rect(CtrlEntId) CtrlWidth = CtrlSize<3> CtrlHeight = CtrlSize<4> CtrlXpos = CtrlSize<1> CtrlYpos = CtrlSize<2> 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' CellSize = Send_Message(CtrlEntId, 'OLE.GetCellRect', ColPos : @FM : RowPos) CellWidth = CellSize<3> CellHeight = CellSize<4> ShowAtX = CtrlXpos + CellSize<1> + 1 CtrlYpos += CellSize<2> ShowAtY = CtrlYpos + CellHeight + 3 // The SRP Popup display should be at least as wide as the cell for visual purposes. Add an extra pixel of // width to account for the cell border. If CellWidth GT FullWidth then FullWidth = CellWidth + 1 If Get_Property(CtrlEntId, 'OLE.ComboDropDown') then Set_Property(CtrlEntId, 'OLE.ComboDropDown', False$) Case ControlType _EQC 'EDITTABLE' Rect = Str(\00\, 16) hCtrl = Get_Property(CtrlEntId, 'HANDLE') LeftBtm = SendMessage(hCtrl, DTM_GETCELLLEFTBOTTOM$, DTA_CURRENT$, 0) ShowAtX = CtrlXpos + Mod(LeftBtm, 65536) // Get y position with different SendMessage call SendMessage(hCtrl, DTM_READCELLRECT$, DTA_CURRENT$, GetPointer(Rect)) ShowAtY = CtrlYpos + seq(Rect [5,1]) + (seq(Rect [6,1]) * 256) Case Otherwise$ // Get x and y+h of control for x & y of popup * ShowAtX = CtrlXpos ShowAtX = CtrlXpos + CtrlWidth // Check to see if the control is displaying a combobox drop down. If so, then close the combobox. If Len(Subclass) then CtrlEntIdSub = CtrlEntId Convert '.' to ';' in CtrlEntIdSub ComboVisible = Get_Property(Subclass, 'OLE.ComboDropDown[' : CtrlEntIdSub : ']') If ComboVisible then Set_Property(Subclass, 'OLE.ComboDropDown[' : CtrlEntIdSub : ']', False$) end * ShowAtY = CtrlYpos + CtrlHeight ShowAtY = CtrlYpos + 2 // The SRP Popup display should be at least as wide as the control for visual purposes. Add an extra pixel of // width to account for the cell border. If CtrlWidth GT FullWidth then FullWidth = CtrlWidth End Case // Raise the SRP Popup display by two pixels so that the top border lines itself with the inner border. ShowAtY -= 2 // Create the items to be displayed in the SRP Popup control. ItemList = '' // Add a title if there is one. If Len(Title) then ItemCnt += 1 ItemList = '0' : @SVM : VertPos : @SVM : FullWidth : @SVM : TitleHeight ItemList = Title ItemList = TextColor ItemList = '' : @SVM : '' : @SVM : '700' : @SVM : '0' : @SVM : '0' ItemList = 'Center' : @SVM : 'Center' VertPos += 22 ; // Give enough room before adding the first message line. end else // If there is no title then add another 4 pixels to the vertical position to give the first line a better top margin. VertPos += 4 end // Add the message lines. For LineNo = 1 to NumLines ItemCnt += 1 TextLine = Message // Add the next line to the ItemList. ItemList = LeftMarg : @SVM : VertPos : @SVM : ItemWidth : @SVM : ItemHeight ItemList = TextLine ItemList = TextColor ItemList = 'Left' : @SVM : 'Top' VertPos += ItemHeight ; // Add for height for the next item. Next ItemNo // Create the button that will occupy the entire SRP Popup display so the user can click anywhere to close it. ItemCnt += 1 VertPos += 11 ; // Increase the height of the button and the entire SRP Popup to create a bottom margin. ItemList = 0 : @SVM : 0 : @SVM : FullWidth : @SVM : VertPos ItemList = 'Center' : @SVM : 'Center' ItemList = True$ // Set the Theme property to Custom so the special background settings will work as expected. Set_Property(PopupCtrl, 'OLE.Theme', 'Custom') Set_Property(PopupCtrl, 'OLE.Background', BackColor : @FM : 'None' : @FM : 'None') // Set the ItemList property. Set_Property(PopupCtrl, 'OLE.ItemList', ItemList) // Keep the SRP Popup display up indefinitely. This will be removed through another service. Set_Property(PopupCtrl, 'OLE.ShowDelay', 0) // If the window with focus is not the same as the window that needs the message then make sure it is the active // window. FocusWindow = Get_Property('SYSTEM', 'FOCUS')[1, '.'] If Window NE FocusWindow then MDIFrame = Form_Services('GetMDIFrame') Form_Services('SelectOpenWindowsItem', Window) Set_Property(MDIFrame, 'MDIACTIVE', Window) end PopupVisible = Get_Property(PopupCtrl, 'OLE.Visible') PrevPopupSize = Get_Property(PopupCtrl, '@PREV_POPUP_SIZE') If PopupVisible then PrevShowAtX = PrevPopupSize<1> PrevShowAtY = PrevPopupSize<2> PrevFullWidth = PrevPopupSize<3> PrevVertPos = PrevPopupSize<4> If (PrevShowAtX NE ShowAtX) OR (PrevShowAtY NE ShowAtY) OR (PrevFullWidth NE FullWidth) OR (PrevVertPos NE VertPos) then Send_Message(PopupCtrl, 'OLE.Close') DisplayPopup = True$ end else DisplayPopup = False$ end end else DisplayPopup = True$ end If DisplayPopup then // Make sure the control's borders (or cell border) matches the SRP Popup background. Begin Case Case ControlType EQ 'EDITFIELD' OR ControlType EQ 'EDITBOX' Handle = Get_Property(CtrlEntId, 'HANDLE') rv = Send_Message(Subclass, 'OLE.Subclass', Handle, CtrlEntId) Convert '.' to ';' in CtrlEntId CustomColors = Get_Property(Subclass, 'OLE.CustomColors[' : CtrlEntId : ']') CustomColors<2> = BackColor : @VM : BackColor : @VM : 'Window' : @VM : BackColor : @VM : 2 Set_Property(Subclass, 'OLE.CustomColors[' : CtrlEntId : ']', CustomColors) Case ControlType _EQC 'SRP.EditTable.1' SelectionStyle = '' SelectionStyle<4> = BackColor Set_Property(CtrlEntId, 'OLE.SelectionStyle', SelectionStyle) End Case // Set the Size of the SRP Popup display to be the full width and height needed to contain all items. Set_Property(PopupCtrl, 'OLE.Size', 0 : @FM : 0 : @FM : FullWidth : @FM : VertPos) // Finally, display the SRP Popup control. Send_Message(PopupCtrl, 'OLE.ShowAt', ShowAtX, ShowAtY) Set_Property(PopupCtrl, '@PREV_POPUP_SIZE', ShowAtX : @FM : ShowAtY : @FM : FullWidth : @FM : VertPos) end end Done = True$ return