360 lines
16 KiB
Plaintext
360 lines
16 KiB
Plaintext
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<ItemNo>)
|
|
If TextLen GT MaxLen then
|
|
// Wrap long text lines
|
|
LongLen = MaxLen
|
|
ItemAdd = 0
|
|
TextLine = Message<ItemNo>
|
|
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<ItemNo + ItemAdd> = 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<ItemCnt, 1> = '0' : @SVM : VertPos : @SVM : FullWidth : @SVM : TitleHeight
|
|
ItemList<ItemCnt, 2> = Title
|
|
ItemList<ItemCnt, 3> = TextColor
|
|
ItemList<ItemCnt, 4> = '' : @SVM : '' : @SVM : '700' : @SVM : '0' : @SVM : '0'
|
|
ItemList<ItemCnt, 5> = '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<LineNo>
|
|
|
|
// Add the next line to the ItemList.
|
|
ItemList<ItemCnt, 1> = LeftMarg : @SVM : VertPos : @SVM : ItemWidth : @SVM : ItemHeight
|
|
ItemList<ItemCnt, 2> = TextLine
|
|
ItemList<ItemCnt, 3> = TextColor
|
|
ItemList<ItemCnt, 5> = '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<ItemCnt, 1> = 0 : @SVM : 0 : @SVM : FullWidth : @SVM : VertPos
|
|
ItemList<ItemCnt, 5> = 'Center' : @SVM : 'Center'
|
|
ItemList<ItemCnt, 7> = 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
|
|
|