1034 lines
51 KiB
Plaintext
1034 lines
51 KiB
Plaintext
Function SRP_BreadcrumbBar(CtrlEntId, @Service, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15)
|
|
/***********************************************************************************************************************
|
|
|
|
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 : SRP_BreadcrumbBar
|
|
|
|
Description : Object commuter for the SRP BreadcrumbBar utility.
|
|
|
|
Notes : The SRP BreadcrumbBar is a utility using the SRP EditTable ActiveX control. It is an emulation
|
|
of the Breadcrumb control used in Windows Vista and emulated in XP through third-party components
|
|
(e.g. http://qttabbar.wikidot.com/qtaddressbar)
|
|
|
|
This commuter allows the developer to get and set "properties" of the BreadcrumbBar as well as
|
|
execute internal "methods" using the Message parameter. Generic parameters have been provided that
|
|
will be unique to each Message.
|
|
|
|
There are a few setup conditions for the SRP BreadcrumbBar to work as a complete utility:
|
|
|
|
- The SYSPROG*SRP_UTILITY..OIWIN* custom event handler must exist in SYSREPOSEVENTEXES. The
|
|
source for this is in SYSPROG_SRP_UTILITY_OIWIN and it contains commands for copying the
|
|
appropriate items into SYSREPOSEVENTEXES for convenience, although a restart of OpenInsight
|
|
will be required.
|
|
- The Init method must be called after any other QUALIFY_EVENT messages for the SRP EditTable
|
|
have been submitted. Otherwise, the redirect to the custom event handler will be undone.
|
|
- The RightArrow.png and DownArrow.png image files should be located in an accessible folder
|
|
(e.g., .\BMPS) and then the RightArrow$ and DownArrow$ equates in this routine need to be
|
|
updated as needed.
|
|
|
|
Parameters :
|
|
CtrlEntId [in] -- The fully qualified name of the control (SRP EditTable) being used as a BreadcrumbBar
|
|
Message [in] -- The message to be execute (e.g. Property, Method)
|
|
Param1-15 [in] -- Additional event parameter holders
|
|
Response [out] -- Either a Boolean flag indicating success of the Message or the information the Message
|
|
is supposed to return
|
|
|
|
History : (Date, Initials, Notes)
|
|
12/11/08 dmb v1.0.0 - Original programmer
|
|
01/18/09 dmb v1.0.0 - Add RemoveAllSegments method
|
|
02/03/09 dmb v1.0.0 - Add GetSegmentTree property
|
|
07/31/15 dmb v1.0.0 - Begin adding meta data to the code so the SRP Editor can tooltip the methods.
|
|
07/31/15 dmb v1.0.0 - Replace the OI-based context menu logic with the new SRP EditTable ShowContextMenu
|
|
method. Add OnContextMenuClick as an event hook in the Control_Events gosub.
|
|
07/31/15 dmb v1.0.0 - Change the Send_Event calls to the parent form to just send the SRP BreadcrumbBar
|
|
event rather than the word SRP_UTILITY since this is getting intercepted by the
|
|
promoted SRP_UTILITY event handler. This allows the parent form to manage the event
|
|
handler as a form event.
|
|
07/31/15 dmb v1.0.0 - Add equates for the right arrow and down arrow images. These values can change
|
|
depending on where the images are stored. The default is in the BMPS\FW_Current
|
|
folder (which is where SRP FrameWorks keeps all images.)
|
|
07/31/15 dmb v1.0.0 - Refactor the GetSegmentChildren message so the Root item can now have children and
|
|
a drop-down to change the root child entry.
|
|
07/31/15 dmb v1.0.0 - Change the Send_Event calls from the Parent (i.e., form) to the SRP EditTable
|
|
control. This allows the control to behave like a custom ActiveX control with its
|
|
own custom events.
|
|
07/31/15 dmb v1.0.0 - Fix a minor bug in the AddSegment message that would not allow child segments to be
|
|
added in a non-linear order.
|
|
08/04/15 dmb v1.0.0 - Modify the SetRootImage method so that arguments which are empty will default to
|
|
the current settings.
|
|
08/04/15 dmb v1.0.0 - Add support to store miscellaneous (non-visible to the end user) data with each
|
|
segment.
|
|
08/04/15 dmb v1.0.0 - Use the SRP_Sort_Array function to alway sort the context menu in the
|
|
Create_Child_Dropdown gosub.
|
|
08/05/15 dmb v1.0.0 - Widen the width of the dropdown segments to conform more to Windows 8/10 styles.
|
|
08/05/15 dmb v1.0.0 - Change the default colors and styles to conform to Windows 8/10 theme.
|
|
08/18/15 dmb v1.0.0 - Major refactor of code. Replace most global common variables with SRP HashTable in
|
|
order to allow for Key ID identification of segments.
|
|
08/18/15 dmb v1.0.0 - Remove GetSegmentTree property. No longer needed.
|
|
08/18/15 dmb v1.0.0 - Remove GetSegmentLevel property. No longer needed.
|
|
08/18/15 dmb v1.0.0 - Add SegmentExists property.
|
|
05/15/16 dmb v1.0.0 - Add Enabled property.
|
|
08/04/16 dmb v1.0.0 - Fix GetSegmentChildren property when SegmentKey is passed in as 'Root'.
|
|
04/13/17 dmb v1.0.0 - Add GetPrevActiveSegment property.
|
|
05/07/20 dmb v2.0.0 - Updated with current formatting standards and Enhanced BASIC+.
|
|
05/08/20 dmb v2.0.0 - Update the GetSegmentPath property to support ExcludeRootSegment and
|
|
ExcludeArrowSegments flags so these segments can be excluded from the path.
|
|
05/08/20 dmb v2.0.1 - Fix bug in GetSegmentPath property that wasn't honoring the ExcludeArrowSegments
|
|
flag if the arrow was on the end of the segment.
|
|
06/19/20 dmb v2.1.0 - Add RemoveSegment method.
|
|
06/19/20 dmb v2.1.0 - Add RemoveAllChildrenSegments method
|
|
|
|
***********************************************************************************************************************/
|
|
|
|
#pragma precomp SRP_PreCompiler
|
|
|
|
$insert LOGICAL
|
|
$insert MENU_EQUATES
|
|
$insert PS_EQUATES
|
|
|
|
SRPBreadcrumbBarCommon = 'SBBC_' : CtrlEntId
|
|
Common //SRPBreadcrumbBarCommon// SBBC_Errors@, SBBC_PreviousCell@, SBBC_Colors@(6), SBBC_RootVisible@, SBBC_RootInfo@, SBBC_ActiveSegment@, SBBC_CellFont@, SBBC_Debug@, SBBC_HashTable@, SBBC_PrevActiveSegment@
|
|
|
|
// BreadcrumbBar UI equates
|
|
Equ ColdGridLineBaseColor$ to SBBC_Colors@(1)
|
|
Equ WarmGridLineBaseColor$ to SBBC_Colors@(2)
|
|
Equ HotGridLineBaseColor$ to SBBC_Colors@(3)
|
|
Equ ColdHighlightBaseColor$ to SBBC_Colors@(4)
|
|
Equ WarmHighlightBaseColor$ to SBBC_Colors@(5)
|
|
Equ HotHighlightBaseColor$ to SBBC_Colors@(6)
|
|
|
|
Equ RootSegment$ to SRPBreadcrumbBarCommon : '*Root'
|
|
Equ ChildMarker$ to SRPBreadcrumbBarCommon : '*C'
|
|
|
|
// Adding these to allow for dynamic variables in menu items
|
|
Equ MENUPOS_MSGTYPE$ to 12
|
|
Equ MENUPOS_RECEIPIENT$ to 13
|
|
Equ MENUPOS_MESSAGE$ to 14
|
|
Equ MENUPOS_MSGPARMS$ to 15
|
|
|
|
// Right-button Down Windows Message
|
|
Equ WM_RBUTTONDOWN to 516 ; // 0x0204
|
|
|
|
Equ SRP_Utility$ to 'SRP_BREADCRUMBBAR'
|
|
Equ RightArrow$ to 'BMPS\RightArrow.png'
|
|
Equ DownArrow$ to 'BMPS\DownArrow.png'
|
|
|
|
Declare subroutine SRP_BreadcrumbBar, Set_Property, Send_Message, Utility, Send_Event, PostMessage, GetCursorPos, ScreenToClient, GetWindowRect
|
|
Declare function SRP_BreadcrumbBar, Get_Property, Send_Message, Utility, Struct_To_Var, Blank_Struct, RetStack, SRP_Rotate_Array, SRP_Sort_Array
|
|
|
|
// SRP HashTable declarations.
|
|
Declare function SRP_HashTable_Create, SRP_HashTable_Contains, SRP_HashTable_Count, SRP_HashTable_Get, SRP_HashTable_GetKeys, SRP_HashTable_GetValues, SRP_HashTable_GetKeyValuePairs
|
|
Declare subroutine SRP_HashTable_Set, SRP_HashTable_Release, SRP_HashTable_Remove
|
|
|
|
GoToService else
|
|
// If none of the above, it should be an OpenInsight event to the underlying control.
|
|
GoSub ControlEvents
|
|
end
|
|
|
|
Return Response OR True$
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Service Parameter Options
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
Options BOOLEAN = True$, False$
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Methods, Properties, and Events
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// Init - Method
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service Init(TypeFace, StyleOverride)
|
|
|
|
If TypeFace NE '' then
|
|
SBBC_CellFont@ = TypeFace
|
|
end else
|
|
SBBC_CellFont@ = 'Segoe UI' : @SVM : '-11' : @SVM : 400 : @SVM : 0 : @SVM : 0 : @SVM : 5 : @SVM : 0 : @SVM : 39 : @SVM : 0 : @SVM : 0 : @SVM : 0 : @SVM : 0 : @SVM : 12 : @SVM : 2 : @SVM : 0 : @SVM : 23
|
|
end
|
|
|
|
// Establish the colors for the BreadcrumbBar. If the user didn't pass in any colors then a default color will
|
|
// be used. "Cold" means the segment isn't highlighted, "Warm" means the segment is connected to a "Hot" segment
|
|
// but should be offset by a different color, and "Hot" means the segment is highlighted.
|
|
ColdGridLineBaseColor$ = 'None'
|
|
WarmGridLineBaseColor$ = 'RGB(222,222,222)'
|
|
HotGridLineBaseColor$ = 'RGB(112,192,231)'
|
|
ColdHighlightBaseColor$ = 'None'
|
|
WarmHighlightBaseColor$ = 'RGB(245,245,245)'
|
|
HotHighlightBaseColor$ = 'RGB(229,243,251)'
|
|
|
|
// Set up general properties that affect the entire EditTable.
|
|
Set_Property(CtrlEntId, 'OLE.BorderType', 'XP Flat') ; // XP border when possible.
|
|
Set_Property(CtrlEntId, 'OLE.WorkspaceBkColor', 'Window') ; // Fill in the space with no cells with the current theme's Window color.
|
|
Set_Property(CtrlEntId, 'OLE.Dimension', 1 : @FM : 1) ; // Create a 1 column by 1 row EditTable.
|
|
Set_Property(CtrlEntId, 'OLE.SuppressMouseMoveEvent', False$) ; // Make the mouse move event is triggered.
|
|
Set_Property(CtrlEntId, 'OLE.AllowInserts', False$) ; // Prevent the user from inserting rows using the Insert key.
|
|
Set_Property(CtrlEntId, 'OLE.AllowDeletions', False$) ; // Prevent the user from deleting rows using the Delete key.
|
|
Set_Property(CtrlEntId, 'OLE.NewRowCount', 0) ; // Prevent the user from adding rows using the Enter key
|
|
// Set up properties that affect navigation functional and visual behavior.
|
|
Set_Property(CtrlEntId, 'OLE.QuickTabOut', True$) ; // Force the focus to move to the next control if the user tries to navigate on an empty row (i.e. just like AREV). "Yes" is the default, but it is added here anyway to help explain what the EditTable can do.
|
|
Set_Property(CtrlEntId, 'OLE.CellProtection[All; All]', 'Selectable') ; // All cells should be selectable.
|
|
Set_Property(CtrlEntId, 'OLE.SelectionStyle', @FM : @FM : @FM : @FM : 0) ; // Do not show any border if a cell is selected.
|
|
Set_Property(CtrlEntId, 'OLE.ScrollBarsVisible', 'N' : @FM : 'N') ; // Do not show any scrollbar.
|
|
// Set up the Column and Row headers.
|
|
Set_Property(CtrlEntId, 'OLE.HeaderRow[1]', @FM: False$) ; // Hide the header row.
|
|
Set_Property(CtrlEntId, 'OLE.DataRow[All]', @FM :@FM : @FM : True$) ; // Height of the cell should be autosized to fit the height of the SRP EditTable control.
|
|
Set_Property(CtrlEntId, 'OLE.HeaderColumn[1]', @FM: False$) ; // Hide the header column.
|
|
// Set up the header cells.
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[All; All]', ColdGridLineBaseColor$ : @FM : 'None' : @FM : ColdGridLineBaseColor$ : @FM : 'None')
|
|
Set_Property(CtrlEntId, 'OLE.DataColumn[1]', @FM : @FM : @FM : True$)
|
|
|
|
EventQualifier = True$ : @FM : 12 : '*' : 'SYSPROG*SRP_UTILITY..OIWIN*'
|
|
Send_Message(CtrlEntId, 'QUALIFY_EVENT', 'OLE.OnMouseMove', EventQualifier)
|
|
Send_Message(CtrlEntId, 'QUALIFY_EVENT', 'OLE.OnMouseExit', EventQualifier)
|
|
Send_Message(CtrlEntId, 'QUALIFY_EVENT', 'OLE.OnClick', EventQualifier)
|
|
Send_Message(CtrlEntId, 'QUALIFY_EVENT', 'OLE.OnContextMenuClick', EventQualifier)
|
|
|
|
// Set the SRP_UTILITY UDP so the generic event handler can route the events to the correct handler.
|
|
Set_Property(CtrlEntId, '@SRP_UTILITY', SRP_Utility$)
|
|
|
|
// Clear common variables and initialize the SRP Hash Table.
|
|
SBBC_Errors@ = ''
|
|
SBBC_PreviousCell@ = ''
|
|
SBBC_RootVisible@ = ''
|
|
SBBC_RootInfo@ = ''
|
|
SBBC_ActiveSegment@ = ''
|
|
SBBC_HashTable@ = SRP_HashTable_Create()
|
|
SRP_HashTable_Set(SBBC_HashTable@, RootSegment$, '')
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// AddSegment - Method
|
|
//
|
|
// SegmentInfo - @VM array of Segment information that uses the following format:
|
|
// <0, 1> - Key - The segment's unique key. - [Required]
|
|
// <0, 2> - Data - The segment's display data. - [Required]
|
|
// <0, 3> - Misc - Miscellaneous data as needed by the developer. - [Optional]
|
|
// ParentSegment - Key to the parent segment. Default is the root segment. - [Optional]
|
|
// SetActive - Flag to indicate if this new segment should become the current active segment. Default is
|
|
// true. - [Optional]
|
|
//
|
|
// Adds a new segment to the SRP BreadcrumbBar.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service AddSegment(SegmentInfo, ParentSegment, SetActive=BOOLEAN)
|
|
|
|
// If no valid parent segment was provided then assume the Active Segment.
|
|
If Len(ParentSegment) then
|
|
ParentExists = SRP_HashTable_Contains(SBBC_HashTable@, ParentSegment)
|
|
end else
|
|
ParentExists = False$
|
|
end
|
|
If Not(ParentExists) then ParentSegment = RootSegment$
|
|
|
|
SegmentKey = SegmentInfo[1, @VM]
|
|
SegmentData = SegmentInfo[Col2() + 1, @VM]
|
|
SegmentMisc = SegmentInfo[Col2() + 1, @VM]
|
|
|
|
SegmentExists = SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey)
|
|
|
|
If Not(SegmentExists) then
|
|
If Len(SegmentKey) AND Len(SegmentData) then
|
|
// Add this segment.
|
|
SRP_HashTable_Set(SBBC_HashTable@, SegmentKey, SegmentData : @VM : SegmentMisc)
|
|
|
|
// Add this segment to the list of children belonging to the parent segment.
|
|
ParentChildren = SRP_HashTable_Get(SBBC_HashTable@, ParentSegment : '*Children')
|
|
If Len(ParentChildren) then
|
|
// Add the sibling to the list.
|
|
ParentChildren := @VM : SegmentKey
|
|
end else
|
|
// First child of this segment.
|
|
ParentChildren = SegmentKey
|
|
end
|
|
SRP_HashTable_Set(SBBC_HashTable@, ParentSegment : '*Children', ParentChildren)
|
|
|
|
// Name the parent for this segment.
|
|
SRP_HashTable_Set(SBBC_HashTable@, SegmentKey : '*Parent', ParentSegment)
|
|
|
|
// By default adding a segment will also make it the Active Segment. However, sometimes one needs to be
|
|
// added without making it the Active Segment so a check is made before calling the SetActiveSegment
|
|
// method.
|
|
If SetActive NE False$ then SRP_BreadcrumbBar(CtrlEntId, 'SetActiveSegment', SegmentKey, True$)
|
|
end else
|
|
SBBC_Errors@<-1> = 'No Segment key or data was provided.'
|
|
end
|
|
end else
|
|
SBBC_Errors@<-1> = 'Segment ' : SegmentKey : ' already exists.'
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RemoveSegment - Method
|
|
//
|
|
// SegmentKey - Segment key. - [Required]
|
|
// SetParentActive - Flag to indicate if the parent segment of the one being removed should become the current active
|
|
// segment. Default is true. - [Optional]
|
|
//
|
|
// Removes the indicated segment from the SRP BreadcrumbBar. This will also remove any child segments that exist. If
|
|
// this segment is the only child of a parent segment, the child marker will also be removed.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service RemoveSegment(SegmentKey, SetParentActive=BOOLEAN)
|
|
|
|
If SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey) then
|
|
NoChildren = False$ ; // Assume false for now.
|
|
// First check to see if this segment has children. If so, then recursively call the RemoveSegment method for
|
|
// each child. Eveentually segments will no longer have children which means they can be removed safely.
|
|
Loop
|
|
SegmentChildren = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentChildren', SegmentKey)
|
|
If SegmentChildren NE '' then
|
|
For Each SegmentChild in SegmentChildren using @FM
|
|
SRP_BreadcrumbBar(CtrlEntId, 'RemoveSegment', SegmentChild, False$)
|
|
Next SegmentChild
|
|
end else
|
|
NoChildren = True$
|
|
end
|
|
Until NoChildren EQ True$
|
|
Repeat
|
|
|
|
// This segment has no children. Remove the segment from the hash table, remove the hash table key that
|
|
// identifies the parent for this segment, then remove this segment from the list of children for its original
|
|
// parent.
|
|
SRP_HashTable_Remove(SBBC_HashTable@, SegmentKey)
|
|
ParentSegment = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentParent', SegmentKey)
|
|
SRP_HashTable_Remove(SBBC_HashTable@, SegmentKey : '*Parent')
|
|
ParentChildren = SRP_HashTable_Get(SBBC_HashTable@, ParentSegment : '*Children')
|
|
Locate SegmentKey in ParentChildren using @VM setting Pos then
|
|
ParentChildren = Delete(ParentChildren, 0, Pos, 0)
|
|
SRP_HashTable_Set(SBBC_HashTable@, ParentSegment : '*Children', ParentChildren)
|
|
end
|
|
|
|
// By default removing a segment will also make its parent the Active Segment. However, sometimes one needs to
|
|
// be added without making it the Active Segment so a check is made before calling the SetActiveSegment
|
|
// method.
|
|
If SetParentActive NE False$ then
|
|
SRP_BreadcrumbBar(CtrlEntId, 'SetActiveSegment', ParentSegment, True$)
|
|
end
|
|
end else
|
|
SBBC_Errors@<-1> = 'Segment does not exist.'
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RemoveAllChildrenSegments - Method
|
|
//
|
|
// SegmentKey - Segment key of the parent. - [Required]
|
|
// SetActive - Flag to indicate if the parent segment should become the current active segement. Default is true.
|
|
// - [Optional]
|
|
//
|
|
// Removes all children segments (and their children, etc.) from the indicated parent segment.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service RemoveAllChildrenSegments(SegmentKey, SetActive=BOOLEAN)
|
|
|
|
If SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey) then
|
|
// Check for any children and remove them if they exist.
|
|
SegmentChildren = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentChildren', SegmentKey)
|
|
If SegmentChildren NE '' then
|
|
For Each SegmentChild in SegmentChildren using @FM
|
|
SRP_BreadcrumbBar(CtrlEntId, 'RemoveSegment', SegmentChild, False$)
|
|
Next SegmentChild
|
|
end
|
|
|
|
If SetActive NE False$ then
|
|
SRP_BreadcrumbBar(CtrlEntId, 'SetActiveSegment', SegmentKey, True$)
|
|
end
|
|
end else
|
|
SBBC_Errors@<-1> = 'Segment does not exist.'
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RemoveAllSegments - Method
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service RemoveAllSegments(ClearSegmentTree=BOOLEAN)
|
|
|
|
// Clear existing SRP EditTable cells.
|
|
Dimension = Get_Property(CtrlEntId, 'OLE.Dimension')
|
|
NumColumns = Dimension<1>
|
|
Send_Message(CtrlEntId, 'OLE.DeleteColumns', 1, NumColumns)
|
|
|
|
If ClearSegmentTree NE False$ then
|
|
SBBC_ActiveSegment@ = ''
|
|
SRP_HashTable_Release(SBBC_HashTable@)
|
|
SBBC_HashTable@ = SRP_HashTable_Create()
|
|
SRP_HashTable_Set(SBBC_HashTable@, RootSegment$, '')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DisplaySegmentPath - Method
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service DisplaySegmentPath()
|
|
|
|
// Don't allow any changes to be seen until this is finished.
|
|
Set_Property(CtrlEntId, 'OLE.Redraw', False$)
|
|
|
|
// Clear existing SRP EditTable cells.
|
|
SRP_Breadcrumbbar(CtrlEntId, 'RemoveAllSegments', False$)
|
|
|
|
// Get the current segment path and update the SRP EditTable accordingly.
|
|
SegmentPath = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentPath')
|
|
NumColumns = DCount(SegmentPath, @FM)
|
|
|
|
For ColumnCnt = 1 to NumColumns
|
|
SegmentKey = SegmentPath<ColumnCnt>
|
|
Begin Case
|
|
Case SegmentKey EQ RootSegment$
|
|
SRP_BreadcrumbBar(CtrlEntId, 'SetRootVisible', True$)
|
|
|
|
Case SegmentKey EQ ChildMarker$
|
|
Send_Message(CtrlEntId, 'InsertColumns', -1, 1)
|
|
Set_Property(CtrlEntId, 'OLE.CellPadding[':ColumnCnt:'; All]', 5 : @FM : 2)
|
|
Set_Property(CtrlEntId, 'OLE.CellProtection[':ColumnCnt:'; 1]', 'Selectable')
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':ColumnCnt:'; 1]', ColdGridLineBaseColor$ : @FM : 'None' : @FM : ColdGridLineBaseColor$ : @FM : 'None')
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[':ColumnCnt:'; 1]', RightArrow$ : @FM : 'None')
|
|
Set_Property(CtrlEntId, 'OLE.DataColumn[':ColumnCnt:']', 18 : @FM : @FM : @FM : False$)
|
|
|
|
Case Otherwise$
|
|
Send_Message(CtrlEntId, 'InsertColumns', -1, 1)
|
|
Set_Property(CtrlEntId, 'OLE.CellPadding[':ColumnCnt:'; All]', 5 : @FM : 2)
|
|
Set_Property(CtrlEntId, 'OLE.CellProtection[':ColumnCnt:'; 1]', 'Selectable')
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':ColumnCnt:'; 1]', ColdGridLineBaseColor$ : @FM : 'None' : @FM : ColdGridLineBaseColor$ : @FM : 'None')
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[':ColumnCnt:'; 1]', '')
|
|
Set_Property(CtrlEntId, 'OLE.CellFont[':ColumnCnt:'; All]', SBBC_CellFont@)
|
|
SegmentData = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentData', SegmentKey)
|
|
Set_Property(CtrlEntId, 'OLE.CellText[':ColumnCnt:'; 1]', SegmentData)
|
|
TextRect = Utility('TEXTRECT', '', SegmentData : @FM : (1024 + 32) : @FM : '' : @FM : SBBC_CellFont@)
|
|
TextWidth = TextRect<1> + 30
|
|
Set_Property(CtrlEntId, 'OLE.DataColumn[':ColumnCnt:']', TextWidth : @FM : @FM : @FM : False$)
|
|
|
|
End Case
|
|
Next ColumnCnt
|
|
|
|
// Display all changed.
|
|
Set_Property(CtrlEntId, 'OLE.Redraw', True$)
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ShowHighlight - Method
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service ShowHighlight(CurrentCell, ForceShow=BOOLEAN)
|
|
|
|
CurrentCol = Field(CurrentCell, ';', 1)
|
|
PreviousCol = Field(SBBC_PreviousCell@, ';', 1)
|
|
ShowHighlight = True$ ; // Assume this will be shown unless another condition prohibits this.
|
|
|
|
SegmentPath = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentPath')
|
|
NumSegments = DCount(SegmentPath, @FM)
|
|
|
|
Begin Case
|
|
Case ForceShow EQ True$
|
|
// Regardless of the situation, force the highlight to occur.
|
|
|
|
Case CurrentCol EQ 1 AND SegmentPath<1> EQ RootSegment$
|
|
// Cursor is hovering over the root segment. Do not highlight.
|
|
SRP_BreadcrumbBar(CtrlEntId, 'ClearHighlight')
|
|
ShowHighlight = False$
|
|
|
|
Case CurrentCell EQ SBBC_PreviousCell@
|
|
// Cursor is hovering over the same cell as before. Nothing has changed.
|
|
ShowHighlight = False$
|
|
|
|
Case CurrentCol EQ -1
|
|
// Cursor is hovering over the fill space. Do not highlight.
|
|
SRP_BreadcrumbBar(CtrlEntId, 'ClearHighlight')
|
|
ShowHighlight = False$
|
|
|
|
End Case
|
|
|
|
If ShowHighlight EQ True$ then
|
|
// First, unhighlight the previous segment if previous cell is unassociated with the current cell.
|
|
ClearHighLight = False$
|
|
Begin Case
|
|
Case SegmentPath<CurrentCol> EQ ChildMarker$ AND (CurrentCol LT PreviousCol) ; ClearHighLight = True$
|
|
Case SegmentPath<CurrentCol> NE ChildMarker$ AND (CurrentCol GT PreviousCol) ; ClearHighLight = True$
|
|
Case SegmentPath<CurrentCol> NE ChildMarker$ AND SegmentPath<PreviousCol> NE ChildMarker$ ; ClearHighLight = True$
|
|
End Case
|
|
If ClearHighLight EQ True$ then SRP_BreadcrumbBar(CtrlEntId, 'ClearHighlight')
|
|
|
|
WarmHighlightColor = WarmHighlightBaseColor$
|
|
WarmGridLineColor = WarmGridLineBaseColor$
|
|
HotHighlightColor = HotHighlightBaseColor$
|
|
HotGridLineColor = HotGridLineBaseColor$
|
|
|
|
// Now highlight the current column.
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':CurrentCol:'; 1]', @FM : HotHighlightColor)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':CurrentCol:'; 1]', HotGridLineColor : @FM : 'None' : @FM : HotGridLineColor : @FM : 'None')
|
|
|
|
// Now highlight the associated column, if applicable.
|
|
Begin Case
|
|
Case SegmentPath<CurrentCol> EQ ChildMarker$ AND SegmentPath<CurrentCol - 1> NE RootSegment$
|
|
AssocCol = CurrentCol - 1
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':AssocCol:'; 1]', @FM : WarmHighlightColor)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':AssocCol:'; 1]', WarmGridLineColor : @FM : 'None' : @FM : WarmGridLineColor : @FM : 'None')
|
|
|
|
Case SegmentPath<CurrentCol> NE ChildMarker$ AND SegmentPath<CurrentCol + 1> EQ ChildMarker$
|
|
AssocCol = CurrentCol + 1
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':AssocCol:'; 1]', @FM : HotHighlightColor)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':AssocCol:'; 1]', HotGridLineColor : @FM : 'None' : @FM : HotGridLineColor : @FM : 'None')
|
|
|
|
End Case
|
|
|
|
SBBC_PreviousCell@ = CurrentCell
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ClearHighlight - Method
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service ClearHighlight(CurrentCol)
|
|
|
|
If CurrentCol EQ '' then
|
|
CurrentCol = Field(SBBC_PreviousCell@, ';', 1)
|
|
end
|
|
|
|
SegmentPath = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentPath')
|
|
|
|
// Clear the highlight of the current cell.
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':CurrentCol:';1]', @FM : ColdHighlightBaseColor$)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':CurrentCol:';1]', ColdGridLineBaseColor$ : @FM : 'None' : @FM : ColdGridLineBaseColor$ : @FM : 'None')
|
|
|
|
// Now highlight the associated column, if applicable (which means the mouse is hovering over the droparrow cell)
|
|
Begin Case
|
|
Case SegmentPath<CurrentCol> EQ ChildMarker$
|
|
AssocCol = CurrentCol - 1
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':AssocCol:';1]', @FM : ColdHighlightBaseColor$)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':AssocCol:';1]', ColdGridLineBaseColor$ : @FM : 'None' : @FM : ColdGridLineBaseColor$ : @FM : 'None')
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[':CurrentCol:'; 1]', RightArrow$ : @FM : 'None')
|
|
|
|
Case SegmentPath<CurrentCol> NE ChildMarker$ AND SegmentPath<CurrentCol + 1> EQ ChildMarker$
|
|
AssocCol = CurrentCol + 1
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':AssocCol:';1]', @FM : ColdHighlightBaseColor$)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':AssocCol:';1]', ColdGridLineBaseColor$ : @FM : 'None' : @FM : ColdGridLineBaseColor$ : @FM : 'None')
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[':AssocCol:'; 1]', RightArrow$ : @FM : 'None')
|
|
|
|
End Case
|
|
|
|
SBBC_PreviousCell@ = ''
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// Close - Method
|
|
//
|
|
// Releases the SRP Hash Table to avoid memory leaks.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service Close()
|
|
|
|
If Len(SBBC_HashTable@) then
|
|
SRP_HashTable_Release(SBBC_HashTable@)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetError - Property
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetError()
|
|
|
|
Response = SBBC_Errors@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSegmentPath - Property
|
|
//
|
|
// ExcludeRootSegment - Flag to indicate if the root segemtn should be excluded from the path. Default is Fasle$
|
|
// - [Optional]
|
|
// ExcludeArrowSegments - Flag to indicate if right arrow segments should be excluded from the path. Default is False$.
|
|
// - [Optional]
|
|
//
|
|
// Returns an @FM delimited array of segment keys that comprises the current path displayed in the SRP BreadcrumbBar.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetSegmentPath(ExcludeRootSegment=BOOLEAN, ExcludeArrowSegments=BOOLEAN)
|
|
|
|
If ExcludeRootSegment NE True$ then ExcludeRootSegment = False$
|
|
If ExcludeArrowSegments NE True$ then ExcludeArrowSegments = False$
|
|
|
|
SegmentPath = ''
|
|
|
|
ActiveSegment = SRP_BreadcrumbBar(CtrlEntId, 'GetActiveSegment')
|
|
|
|
If Len(ActiveSegment) then
|
|
SegmentPath = ActiveSegment
|
|
Transfer ActiveSegment to SegmentKey
|
|
SegmentChildren = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentChildren', SegmentKey)
|
|
// If there are children then insert a special place holder.
|
|
If Len(SegmentChildren) AND Not(ExcludeArrowSegments) then SegmentPath := @FM : ChildMarker$
|
|
|
|
Loop
|
|
ParentSegment = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentParent', SegmentKey)
|
|
If Len(ParentSegment) then
|
|
If (ParentSegment NE RootSegment$) OR ((ParentSegment EQ RootSegment$) AND SBBC_RootVisible@ AND Not(ExcludeRootSegment)) then
|
|
SegmentChildren = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentChildren', ParentSegment)
|
|
// If there are children then insert a special place holder.
|
|
If Len(SegmentChildren) AND Not(ExcludeArrowSegments) then SegmentPath = Insert(SegmentPath, 1, 0, 0, ChildMarker$)
|
|
// Insert the parent segment.
|
|
SegmentPath = Insert(SegmentPath, 1, 0, 0, ParentSegment)
|
|
SegmentKey = ParentSegment
|
|
end else
|
|
// There are no more segments so set the parent to empty to end the loop.
|
|
ParentSegment = ''
|
|
end
|
|
end
|
|
Until ParentSegment EQ ''
|
|
Repeat
|
|
end else
|
|
SBBC_Errors@<-1> = 'No active segment could not be located.'
|
|
end
|
|
|
|
Response = SegmentPath
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSegmentChildren - Property
|
|
//
|
|
// SegmentKey - Segment key to get the children for. - [Required]
|
|
//
|
|
// Returns an array of children for the segment key being passed in.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetSegmentChildren(SegmentKey)
|
|
|
|
If SegmentKey EQ 'Root' then SegmentKey = RootSegment$
|
|
|
|
SegmentChildren = ''
|
|
|
|
SegmentExists = SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey)
|
|
|
|
If SegmentExists then
|
|
SegmentChildren = SRP_HashTable_Get(SBBC_HashTable@, SegmentKey : '*Children')
|
|
Convert @VM to @FM in SegmentChildren
|
|
end else
|
|
SBBC_Errors@<-1> = 'Segment does not exist.'
|
|
end
|
|
|
|
Response = SegmentChildren
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSegmentData - Property
|
|
//
|
|
// SegmentKey - Segment key. - [Required]
|
|
//
|
|
// Returns the data associated with the segment.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetSegmentData(SegmentKey)
|
|
|
|
SegmentData = ''
|
|
|
|
If SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey) then
|
|
Segment = SRP_HashTable_Get(SBBC_HashTable@, SegmentKey)
|
|
SegmentData = Segment<0, 1>
|
|
end else
|
|
SBBC_Errors@<-1> = 'Segment does not exist.'
|
|
end
|
|
|
|
Response = SegmentData
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSegmentMisc - Property
|
|
//
|
|
// SegmentKey - Segment key. - [Required]
|
|
//
|
|
// Returns the miscellaneous information associated with the segment.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetSegmentMisc(SegmentKey)
|
|
|
|
SegmentMisc = ''
|
|
|
|
If SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey) then
|
|
Segment = SRP_HashTable_Get(SBBC_HashTable@, SegmentKey)
|
|
SegmentMisc = Segment<0, 2>
|
|
end else
|
|
SBBC_Errors@<-1> = 'Segment does not exist.'
|
|
end
|
|
|
|
Response = SegmentMisc
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSegmentParent - Property
|
|
//
|
|
// SegmentKey - Segment key. - [Required]
|
|
//
|
|
// Returns the parent segment key for the segment key being passed in.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetSegmentParent(SegmentKey)
|
|
|
|
If SegmentKey EQ RootSegment$ then Segment = ''
|
|
|
|
SegmentParent = ''
|
|
|
|
If Len(SegmentKey) then
|
|
SegmentParent = SRP_HashTable_Get(SBBC_HashTable@, SegmentKey : '*Parent')
|
|
end
|
|
|
|
Response = SegmentParent
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetRootVisible - Property
|
|
//
|
|
// Returns the visibility status of the root segment.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetRootVisible()
|
|
|
|
Response = SBBC_RootVisible@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetRootVisible - Property
|
|
//
|
|
// RootVisible - Flag to determine if the root segment is visible. - [Required]
|
|
//
|
|
// Makes the root segment visible.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetRootVisible(RootVisible=BOOLEAN)
|
|
|
|
If RootVisible NE '' then
|
|
SBBC_RootVisible@ = RootVisible
|
|
If SBBC_RootVisible@ then
|
|
Send_Message(CtrlEntId, 'InsertColumns', 1, 1)
|
|
SegmentWidth = Field(SBBC_RootInfo@, @FM, 3, 1)
|
|
Set_Property(CtrlEntId, 'OLE.DataColumn[1]', SegmentWidth : @FM : @FM : @FM : False$)
|
|
Set_Property(CtrlEntId, 'OLE.CellPadding[1; All]', 3 : @FM : 2)
|
|
Set_Property(CtrlEntId, 'OLE.CellProtection[1; 1]', 'Full')
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[1; 1]', ColdGridLineBaseColor$ : @FM : 'None' : @FM : ColdGridLineBaseColor$ : @FM : 'None')
|
|
ImageInfo = Field(SBBC_RootInfo@, @FM, 1, 2)
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[1; 1]', ImageInfo)
|
|
end else
|
|
Send_Message(CtrlEntId, 'DeleteColumns', 1, 1)
|
|
end
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetRootImage - Property
|
|
//
|
|
// Returns the details pertaining to the root segment image. See SetRootImage for details on the layout.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetRootImage()
|
|
|
|
Response = SBBC_RootInfo@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetRootImage - Property
|
|
//
|
|
// RootImage - Path to the graphical image to display in the root segment (assuming it is visible.) - [Optional]
|
|
// TransparentColor - Specify the transparent color of the image. Default is "Auto". - [Optional]
|
|
// SegmentWidth - The width of the root segment. Default is the width of the image. - [Optional]
|
|
// RootVisible - Flag to determine if the root should be visible (assuming it isn't already.) - [Optional]
|
|
//
|
|
// Updates one or more details relating to the root segment image. If the root image is not visible or not told to
|
|
// become visible then any new details are kept in memory only.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetRootImage(RootImage, TransparentColor, SegmentWidth, RootVisible)
|
|
|
|
If Len(RootImage) then SBBC_RootInfo@<1> = RootImage
|
|
If Len(TransparentColor) then SBBC_RootInfo@<2> = TransparentColor
|
|
If Len(SegmentWidth) then SBBC_RootInfo@<3> = SegmentWidth
|
|
|
|
Begin Case
|
|
Case (RootVisible EQ True$) AND (SBBC_RootVisible@ NE True$)
|
|
// The SetRootImage method was called with a request to display the root segment (if it is not already visible.)
|
|
// Since it was not already visible, the SetRootVisible method will be used to display it.
|
|
SRP_BreadcrumbBar(CtrlEntId, 'SetRootVisible', True$)
|
|
|
|
Case RootVisible EQ True$
|
|
// The SetRootImage method was called with a request to display the root segment (if it is not already visible.)
|
|
// Since it is already visible, just set the CellImage of the SRP EditTable.
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[1; 1]', SBBC_RootInfo@)
|
|
SBBC_RootVisible@ = True$
|
|
|
|
Case SBBC_RootVisible@ EQ True$
|
|
// If root segment is already visible, update the image in the SRP EditTable immediately.
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[1; 1]', SBBC_RootInfo@)
|
|
|
|
End Case
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetActiveSegment - Property
|
|
//
|
|
// Returns the key to the currently active segment.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetActiveSegment()
|
|
|
|
Response = SBBC_ActiveSegment@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetActiveSegment - Property
|
|
//
|
|
// SegmentKey - Unique key for the segment to become active. - [Required]
|
|
// DisplaySegment - Flag to determine if the newly active segment should be displayed as such in the SRP
|
|
// BreadcrumbBar. The default is True. This should be set to False if the segment needs to be active
|
|
// (perhaps if the AddSegment method was intended to use the active segment as the default parent)
|
|
// but not immediately refreshed in the UI. - [Optional]
|
|
//
|
|
// Sets the indicated segement as active. Normally this means it is the segment that is the visible end point being
|
|
// displayed in the SRP BreadcrumbBar. However, it can also be active but not visible. See the DisplaySegment notes for
|
|
// further details.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetActiveSegment(SegmentKey, DisplaySegment=BOOLEAN)
|
|
|
|
If DisplaySegment EQ False$ else DisplaySegment = True$
|
|
|
|
SegmentExists = SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey)
|
|
If SegmentExists then
|
|
SBBC_PrevActiveSegment@ = SBBC_ActiveSegment@
|
|
SBBC_ActiveSegment@ = SegmentKey
|
|
If DisplaySegment then SRP_BreadcrumbBar(CtrlEntId, 'DisplaySegmentPath')
|
|
end else
|
|
SBBC_Errors@<-1> = 'Segment does not exist.'
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetPrevActiveSegment - Property
|
|
//
|
|
// Returns the key to the previous active segment.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetPrevActiveSegment()
|
|
|
|
Response = SBBC_PrevActiveSegment@
|
|
|
|
end service
|
|
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SegmentExists - Property
|
|
//
|
|
// SegmentKey - Segment key. - [Required]
|
|
//
|
|
// Returns a flag indicating if the segment exists or not.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SegmentExists(SegmentKey)
|
|
|
|
SegmentExists = SRP_HashTable_Contains(SBBC_HashTable@, SegmentKey)
|
|
|
|
Response = SegmentExists
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// Enabled - Property
|
|
//
|
|
// EnabledFlag - [Required]
|
|
//
|
|
// Enables or disables the SRP BreadcrumbBar, depending on the value of EnabledFlag.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service Enabled(EnabledFlag)
|
|
|
|
If EnabledFlag NE '' then
|
|
CellColors = Get_Property(CtrlEntId, 'OLE.CellColors[1;1]')
|
|
If EnabledFlag EQ False$ then
|
|
Set_Property(CtrlEntId, 'ENABLED', False$)
|
|
EnabledColor = '3DFace'
|
|
end else
|
|
Set_Property(CtrlEntId, 'ENABLED', True$)
|
|
EnabledColor = 'White'
|
|
end
|
|
CellColors<2> = EnabledColor
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[All;All]', CellColors)
|
|
Set_Property(CtrlEntId, 'OLE.WorkspaceBkColor', EnabledColor)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// OnSegmentClick - Event
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service OnSegmentClick(CurrentCell)
|
|
|
|
CurrentCol = Field(CurrentCell, ';', 1)
|
|
PreviousCol = Field(SBBC_PreviousCell@, ';', 1)
|
|
If CurrentCol NE PreviousCol then
|
|
// It is possible that the previous cell is still highlighted (especially if a context menu was displayed) so
|
|
// it needs to be cleared.
|
|
SRP_BreadcrumbBar(CtrlEntId, 'ClearHighlight', PreviousCol)
|
|
end
|
|
|
|
SegmentPath = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentPath')
|
|
NumSegments = Count(SegmentPath, @FM) + (SegmentPath NE '')
|
|
SegmentKey = SegmentPath<CurrentCol>
|
|
|
|
Begin Case
|
|
Case SegmentKey EQ SBBC_ActiveSegment@
|
|
// Do nothing. User is clicking on currently active segment.
|
|
|
|
Case SegmentKey EQ ChildMarker$
|
|
// User clicked on an arrow segment. Make the segments appear as if they are clicked. However, it is possible
|
|
// that the previous segment was an arrow segment that had a context menu displayed. In this case, the
|
|
// normal trapping of mouse movement won't work so the highlight needs to be cleared explicitly.
|
|
Set_Property(CtrlEntId, 'OLE.CellImage[':CurrentCol:'; 1]', DownArrow$ : @FM : 'None')
|
|
Set_Property(CtrlEntId, 'OLE.CellPadding[':CurrentCol:'; All]', 5 : @FM : 2)
|
|
HotHighlightColor = 'RGB(203,232,246)'
|
|
HotGridLineColor = 'RGB(038,160,218)'
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':CurrentCol:'; 1]', @FM : HotHighlightColor)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':CurrentCol:'; 1]', HotGridLineColor : @FM : 'None' : @FM : HotGridLineColor : @FM : 'None')
|
|
PreviousCol = CurrentCol - 1
|
|
Set_Property(CtrlEntId, 'OLE.CellColors[':PreviousCol:'; 1]', @FM : HotHighlightColor)
|
|
Set_Property(CtrlEntId, 'OLE.CellGridLines[':PreviousCol:'; 1]', HotGridLineColor : @FM : 'None' : @FM : HotGridLineColor : @FM : 'None')
|
|
|
|
// Display the list of children.
|
|
RegularSegment = SegmentPath<PreviousCol>
|
|
SegmentChildren = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentChildren', RegularSegment)
|
|
GoSub CreateChildDropdown
|
|
|
|
Case SegmentKey NE RootSegment$
|
|
// User clicked on a regular segment. Update the Active Segment.
|
|
SRP_BreadcrumbBar(CtrlEntId, 'SetActiveSegment', SegmentKey)
|
|
SRP_BreadcrumbBar(CtrlEntId, 'ShowHighlight', CurrentCell, True$)
|
|
|
|
// Send an event to the control on the form so it can respond as if this were a true ActiveX control.
|
|
Send_Event(CtrlEntID, 'OnSegmentClick', SegmentKey)
|
|
|
|
Case Otherwise$
|
|
|
|
End Case
|
|
|
|
SBBC_PreviousCell@ = CurrentCell
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// OnMenuClick - Event
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service OnMenuClick(SegmentKey)
|
|
|
|
SRP_BreadcrumbBar(CtrlEntID, 'SetActiveSegment', SegmentKey)
|
|
|
|
// Send an event to the control on the form so it can respond as if this were a true ActiveX control.
|
|
Send_Event(CtrlEntID, 'OnSegmentClick', SegmentKey)
|
|
|
|
end service
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Internal GoSubs
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
* InitParams:
|
|
*
|
|
* If Assigned(CtrlEntId) else CtrlEntId = ''
|
|
* If Assigned(Message) else Message = ''
|
|
* If Assigned(Param1) else Param1 = ''
|
|
* If Assigned(Param2) else Param2 = ''
|
|
* If Assigned(Param3) else Param3 = ''
|
|
* If Assigned(Param4) else Param4 = ''
|
|
* If Assigned(Param5) else Param5 = ''
|
|
* If Assigned(Param6) else Param6 = ''
|
|
* If Assigned(Param7) else Param7 = ''
|
|
* If Assigned(Param8) else Param8 = ''
|
|
* If Assigned(Param9) else Param9 = ''
|
|
* If Assigned(Param10) else Param10 = ''
|
|
* If Assigned(Param11) else Param11 = ''
|
|
* If Assigned(Param12) else Param12 = ''
|
|
* If Assigned(Param13) else Param13 = ''
|
|
* If Assigned(Param14) else Param14 = ''
|
|
* If Assigned(Param15) else Param15 = ''
|
|
*
|
|
* return
|
|
|
|
|
|
ClearError:
|
|
|
|
SBBC_Errors@ = ''
|
|
|
|
return
|
|
|
|
|
|
CreateChildDropdown:
|
|
|
|
Menu = ''
|
|
|
|
NumSegmentChildren = Count(SegmentChildren, @FM) + (SegmentChildren NE '')
|
|
For SegChildCnt = 1 to NumSegmentChildren
|
|
SegmentChild = SegmentChildren<SegChildCnt>
|
|
SegmentData = SRP_BreadcrumbBar(CtrlEntId, 'GetSegmentData', SegmentChild)
|
|
Menu<-1> = SegmentChild : @VM : SegmentData
|
|
Next SegChildCnt
|
|
Menu = SRP_Sort_Array(Menu, 'AL2', True$)
|
|
|
|
// Calculate the position of the context menu. Visually it should appear just underneath the SRP EditTable control
|
|
// and 69 pixels to the left of the right edge of the current cell.
|
|
CellSize = Send_Message(CtrlEntId, 'OLE.GetCellRect', CurrentCol : @FM : 1)
|
|
CellXPos = CellSize<1>
|
|
CellYPos = CellSize<2>
|
|
CellWidth = CellSize<3>
|
|
CellHeight = CellSize<4>
|
|
MenuXPos = CellXPos + CellWidth - 38
|
|
MenuYPos = CellHeight + 1
|
|
Send_Message(CtrlEntID, 'OLE.ShowContextMenu', MenuXPos : ',' : MenuYPos, Menu, '')
|
|
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ControlEvents
|
|
//
|
|
// This section handles the OpenInsight events for the underlying controls. Events are routed to this utility via the
|
|
// SRP_UTILITY custom event which is in SYSPROG.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
ControlEvents:
|
|
|
|
Event = Service
|
|
|
|
Begin Case
|
|
Case Event EQ 'OnMouseMove' ; SRP_BreadcrumbBar(CtrlEntId, 'ShowHighlight', Param1)
|
|
Case Event EQ 'OnMouseExit' ; SRP_BreadcrumbBar(CtrlEntId, 'ClearHighlight')
|
|
Case Event EQ 'OnClick' ; SRP_BreadcrumbBar(CtrlEntId, 'OnSegmentClick', Param1)
|
|
Case Event EQ 'OnContextMenuClick' ; SRP_BreadcrumbBar(CtrlEntId, 'OnMenuClick', Param1)
|
|
End Case
|
|
|
|
return
|