open-insight/LSL2/STPROC/SRP_CONTEXTMENUS.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

632 lines
19 KiB
Plaintext

compile Subroutine SRP_ContextMenus(Action, CtrlEntId, lParam, Position, MenuOverride)
/************************************************************************************************
*
* 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_ContextMenus
*
* Description: Creates Context Menus for all controls on a window or a specific control.
* Also executes context menu items.
*
* Parameters:
* Action [in] -- "CREATE", "DISPLAY", "CREATE/DISPLAY" or "EXECUTE" (also null)
* CtrlEntId [in] -- Control id
* lParam [in] -- Parameter needed for PostMessage to display CM for EditTables and OLEs
* Position [in] -- Cursor Position for EditTables
* MenuOverride [in] -- Override structure containing Context Menu
*
* History (Date, Initials, Notes)
* 08/03/2004 RCH Initial Programmer
* 08/06/2004 RCH Combined functions to CREATE and EXECUTE context menus
* 08/19/2004 RCH Execute function now reads from @MENU property instead of stored CM
* 11/30/2004 RCH Fix ColNo setting in ConstructMenu and MenuItem (with ...) in Execute
* 12/14/2004 RCH Skip Create Menu if "<no context menu>" is set for CM
* 12/27/2004 RCH Create menu correctly if only default OI or Windows CM was selected
* 01/07/2005 RCH Fix hiding of last item(s) and preceding separator in menu
* 01/08/2005 DMB Set the @POSITION UDP of CtrlEntId for style function use
* 03/28/2005 RCH Fix issue with CM not displaying for multiple instances of windows
*
************************************************************************************************/
Declare function Repository
Declare subroutine PostMessage
$insert SRP_APP_INSERTS
$insert MENU_EQUATES
$insert PS_EQUATES
* $insert STYLE_EQUATES
$insert CONTEXTMENU_EQUATES
* 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
If Assigned(lParam) else lParam = ""
If Assigned(Position) else Position = ""
If Assigned(MenuOverride) else MenuOverride = ""
CtrlType = Get_Property(CtrlEntId, "TYPE")
EntId = ""
Open "SYSREPOSMENUCONTEXT" to hSRMC then
Set_Property(CtrlEntId, "@POSITION", Position) ; * Allow functions that dynamically set the style to know what the position is
If Action EQ "CREATE" Then
If CtrlEntID EQ "" Then
* Check all controls
CtrlList = Get_Property(@window,"CTRLMAP")
* Do we want CM for WINDOW?
CtrlList = "WINDOW":@fm:CtrlList
cCtrls = count(CtrlList,@fm) + (CtrlList # '')
for iCtrl = 1 to cCtrls
CtrlEntId = CtrlList<iCtrl>
CtrlName = CtrlEntId[-1, "B."]
GoSub CheckForMenu
next iCtrl
end else
CtrlName = CtrlEntId[-1, "B."]
GoSub CheckForMenu
end
end else
Window = CtrlEntId[1, 'F.']
Window = Window[1, 'F*']
Ctrl = Field(CtrlEntId, ".", 2)
CtrlName = CtrlEntId[-1, "B."]
Begin Case
Case Action EQ "CREATE/DISPLAY"
If MenuOverride then
MenuRec = MenuOverride
GoSub CreateMenu
end else
GoSub CheckForMenu
end
Case Action EQ "DISPLAY"
PostMessage(hWnd, WM_RBUTTONDOWN, 0, lParam)
Case Otherwise$
GoSub ExecuteItem
End Case
end
end
Return
!----- INTERNAL ROUTINES --------------------------------------------------------------------------------------------
CheckForMenu:
* No Context Menus for static text, group boxes, bitmaps, icons, etc.
InvalidCtrlTypes = "STATIC,ICON,GROUPBOX,RADIOBUTTON,MENU,TABCONTROL,"
InvalidCtrlTypes := "PUSHBUTTON,PUSHBMP,HSCROLLBAR,VSCROLLBAR,HSPLITBAR,VSPLITBAR"
Locate CtrlType in InvalidCtrlTypes using "," setting Invalid else
menuFound = No$
ProgId = ""
If index(Action, "DISPLAY", 1) Then
ColNo = ""
If CtrlType EQ "OLECONTROL" Then
ProgId = Get_Property(CtrlEntID, "OLE.ProgID")
Begin Case
Case ProgId _EQC "SRP.EditTable.1"
ColNo = Field(Position, ";", 1, 1)
RowNo = Field(Position, ";", 2, 1)
Titlelist = Get_Property(CtrlEntID, "OLE.TITLELIST")
convert @VM to @FM in Titlelist
Column = TitleList<ColNo>
If Column Then
EntId = @AppId<1>:"**":Window:"*":CtrlName:"*":Column
end
Case ProgId _EQC "SRP.Tab.1"
ColNo = Position
Caption = Get_Property(CtrlEntID, "OLE.TabCaption[":Position:"]")
convert "&" to "" in Caption
EntId = @AppId<1>:"**":Window:"*":CtrlName:"*":Caption
End Case
If EntId then
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
end
* Can only check for column-specific CM for EditTable on right-click (i.e., WINMSG)
If CtrlType EQ "EDITTABLE" AND Position<1> > 0 Then
ColNo = Position<1>
RowNo = Position<2>
Labels = Get_Property(CtrlEntId, "LABEL")
Column = Labels<ColNo>
If Column Then
EntId = @AppId<1>:"**":Window:"*":CtrlName:"*":Column
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
end
* If no CM under caption, check for one using numeric position
if Not(menuFound) AND ColNo then
EntId = @AppId<1>:"**":Window:"*":CtrlName:"*":ColNo
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
end
* If no CM for EditTable column or OLE tab, check for control CM
if Not(menuFound) then
If CtrlName EQ Window Then
EntId = @AppId<1>:"**":Window:"*WINDOW"
end else
EntId = @AppId<1>:"**":Window:"*":CtrlName
end
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
* If not found, check for CM for form + OLE control type
if Not(menuFound) AND ProgId then
convert @lower_case to @upper_case in ProgId
EntId = @AppId<1>:"**":Window:"*":ProgId
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
* If not found, check for CM for form + control type
if Not(menuFound) then
EntId = @AppId<1>:"**":Window:"*":CtrlType
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
* If not found, check for default CM for form
if Not(menuFound) then
EntId = @AppId<1>:"**":Window:"*Default"
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
* If not found, check for CM for form + OLE control type
if Not(menuFound) AND ProgId then
EntId = @AppId<1>:"**Default*":ProgId
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
* If not found, check for default CM for control type
if Not(menuFound) then
EntId = @AppId<1>:"**Default*":CtrlType
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
* If not found, check for default CM for application
if Not(menuFound) then
EntId = @AppId<1>:"**Default"
Read MenuRec from hSRMC, EntId then menuFound = Yes$
end
if menuFound then
If MenuRec<CM_ITEMTEXT$> NE "<no context menu>" Then GoSub CreateMenu
end
end
return
CreateMenu:
ReadOIMenu = MenuRec<CM_INCLUDE_OI_MENU$>
ReadWinMenu = MenuRec<CM_INCLUDE_WIN_MENU$>
prevSeparator = ""
allHidden = ""
ReadOnly = False$
If Assigned(ColNo) Then
If ColNo EQ 0 Then ; * User right-clicked on edittable border area
ReadOnly = True$
end else
ColStyle = Send_Message(CtrlEntId, "COLSTYLE", ColNo, "")
ReadOnly = (BitAnd(ColStyle, DTCS_PROTECT) GT 0)
end
end
menuStruct = ''
menuStruct <1, PSPOS_NAME$> = ctrlEntId :'.MENU'
menuStruct <1, PSPOS_CLASS$> = 'FLOATING'
menuStruct <1, PSPOS_TYPE$> = 'MENU'
menuStruct <1, PSPOS_PARENT$> = ctrlEntId
* create header popup
itemStruct = ''
itemStruct <MENUPOS_TYPE$> = 'P'
itemStruct <MENUPOS_END$> = True$
itemStruct <MENUPOS_ITEMNAME$> = ctrlEntId:'.POPUP'
convert @fm to @svm in itemStruct
menuStruct <1, -1> = itemStruct
itemNo = 0
If MenuRec<CM_ITEMTEXT$> then; * May only be default OI or WIN Context Menus
itemCnt = count(MenuRec<CM_ITEMTEXT$>, @vm) + 1
for itemNo = 1 to itemCnt
GoSub ConstructMenuItem
endFlag = (itemNo Eq itemCnt AND (ReadOnly OR (Not(ReadOIMenu) AND Not(ReadWinMenu))))
* endFlag = (itemNo Eq itemCnt) OR (itemName[-1, 1] Eq '}'); * used for multi-level CMs
GoSub AddMenuItem
next itemNo
End
* Display OI control menu
If ReadOIMenu Then
EntId = "SYSPROG**OIMENU"
Read MenuRec from hSRMC, EntId then
If itemNo Then GoSub AddSeparator
itemCnt = count(MenuRec<CM_ITEMTEXT$>, @vm) + 1
for itemNo = 1 to itemCnt
GoSub ConstructMenuItem
endFlag = (itemNo Eq itemCnt AND (ReadOnly OR Not(ReadWinMenu)))
GoSub AddMenuItem
next itemNo
end
end
* Display Windows control menu
If Not(ReadOnly) AND ReadWinMenu Then
EntId = "SYSPROG**WINMENU_NEW"
Read MenuRec from hSRMC, EntId then
If itemNo Then GoSub AddSeparator
itemCnt = count(MenuRec<CM_ITEMTEXT$>, @vm) + 1
for itemNo = 1 to itemCnt
GoSub ConstructMenuItem
endFlag = (itemNo Eq itemCnt)
GoSub AddMenuItem
next itemNo
end
end
* Check to see if last menu items are hidden
menuItemCnt = Count(menuStruct, @VM) + 1
For i = MenuItemCnt to 1 Step -1
While menuStruct<1, i, MENUPOS_HIDDEN$>
Next i
* If so, reset end of menu
if i < menuItemCnt Then
menuStruct<1, i, MENUPOS_END$> = True$
end
Utility("CREATE", menuStruct)
Set_Property(CtrlEntId, "@MENU", menuStruct)
if Action EQ "CREATE/DISPLAY" then
hWnd = Get_Property(CtrlEntId, "HANDLE")
PostMessage(hWnd, WM_RBUTTONDOWN, 0, lParam)
* This doesn't do anything?
Utility("DESTROY", ctrlEntId:".MENU")
end
return
ExecuteItem:
* menuItem = CtrlEntId[-1, 'B.']
numSegments = Count(CtrlEntId, ".") + (CtrlEntId NE "")
menuItem = Field(CtrlEntId, ".", 3, numSegments-2)
Control = @Window:".":Ctrl
MenuData = Get_Property(Control, "@MENU")
itemCnt = count(MenuData<1>, @vm) + 1
found = False$
for itemNo = 6 to itemCnt ; * Menu Items start at #6 in structure
if MenuData<1, itemNo, MENUPOS_TYPE$> EQ "I" Then
if menuItem _EQC MenuData<1, itemNo, MENUPOS_ITEMNAME$> Then
found = True$
MessageType = MenuData<1, itemNo, MENUPOS_MSGTYPE$>
Receipient = MenuData<1, itemNo, MENUPOS_RECEIPIENT$>
Message = MenuData<1, itemNo, MENUPOS_MESSAGE$>
Parameters = MenuData<1, itemNo, MENUPOS_MSGPARMS$>
end
end
next itemNo
If Found then
Begin Case
Case MessageType EQ "M"; * Send Message to Control
If Receipient[1, 1] EQ "@" Then
swap "@FOCUS" with Get_Property(@Window, "FOCUS") in Receipient
swap "@MDIACTIVE" with Get_Property(@Window, "MDIACTIVE") in Receipient
swap "@MDIFRAME" with Get_Property(@Window, "MDIFRAME") in Receipient
swap "@SELF" with Control in Receipient
swap "@WINDOW" with @Window in Receipient
end else
Receipient = @Window : "." : Receipient
end
Send_Event(Receipient, Message, Parameters)
Case MessageType EQ "E"; * Send Message to Entity
if index(Receipient, "CM_WINMENU_MANAGER", 1) Then
GoSub Execute_WinMenu_Option
end else
GoSub ParseParameters
rv = Repository("EXECUTE",Receipient,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20)
end
End Case
end
return
ConstructMenuItem:
menuItem = MenuRec<CM_ITEMTEXT$,itemNo>
* disabledFlag = MenuRec<CM_DISABLED$,itemNo>
* styleFunction = MenuRec<CM_STYLE_FUNCTION$,itemNo>
* Parameters = MenuRec<CM_STYLE_FUNC_PARAMS$,itemNo>
* get rid of multi-level menu characters
* convert '{' to 'P' in itemName
* convert '}' to '' in itemText
if EntId EQ "SYSPROG**WINMENU_NEW" Then
GoSub Disable_WinMenu_Option
end else
disabledFlag = No$
disabledFunction = MenuRec<CM_DISABLED_FUNCTION$,itemNo>
Parameters = MenuRec<CM_DISABLED_PARAMS$,itemNo>
If disabledFunction Then
GoSub ParseParameters
disabledFlag = Repository("EXECUTE",disabledFunction,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20)
/*
TypeOverride = Repository("EXECUTE",styleFunction,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20)
* stub in user changes in TypeOverride to CM Rec
for i = 1 to CM_NUM_MVFIELDS$
if len(TypeOverride<i>) then
MenuRec<i,itemNo> = TypeOverride<i>
end
next i*/
end
end
hiddenFlag = No$
hiddenFunction = MenuRec<CM_HIDDEN_FUNCTION$,itemNo>
Parameters = MenuRec<CM_HIDDEN_PARAMS$,itemNo>
If hiddenFunction Then
GoSub ParseParameters
hiddenFlag = Repository("EXECUTE",hiddenFunction,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20)
end
checkedFlag = No$
checkedFunction = MenuRec<CM_CHECKED_FUNCTION$,itemNo>
Parameters = MenuRec<CM_CHECKED_PARAMS$,itemNo>
If checkedFunction Then
GoSub ParseParameters
checkedFlag = Repository("EXECUTE",checkedFunction,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20)
end
variableFunction = MenuRec<CM_VARIABLE_FUNCTION$,itemNo>
Parameters = MenuRec<CM_VARIABLE_PARAMS$,itemNo>
If variableFunction Then
GoSub ParseParameters
menuItem = Repository("EXECUTE",variableFunction,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20)
end
itemStruct = ''
itemStruct <MENUPOS_ITEMNAME$> = MenuRec<CM_ITEMNAME$,itemNo>
itemStruct <MENUPOS_TEXT$> = menuItem
* itemStruct <MENUPOS_GREY$> = MenuRec<CM_DISABLED$,itemNo>
itemStruct <MENUPOS_GREY$> = disabledFlag
itemStruct <MENUPOS_CHECK$> = checkedFlag
itemStruct <MENUPOS_HIDDEN$> = hiddenFlag
itemStruct <MENUPOS_ACCEL$> = ""
itemStruct <MENUPOS_HELP_TEXT$> = MenuRec<CM_HELPTEXT$,itemNo>
itemStruct <MENUPOS_HANDLER$> = "6*":@APPID<1>:"*CONTEXTMENU..OIWIN*"
itemStruct <MENUPOS_STYLE$> = 0
itemStruct <MENUPOS_MSGTYPE$> = MenuRec<CM_MSGTYPE$,itemNo>
itemStruct <MENUPOS_RECEIPIENT$> = MenuRec<CM_RECEIPIENT$,itemNo>
itemStruct <MENUPOS_MESSAGE$> = MenuRec<CM_MESSAGE$,itemNo>
* itemStruct <MENUPOS_MSGPARMS$> = MenuRec<CM_PARAMETERS$,itemNo>
Parameters = MenuRec<CM_PARAMETERS$,itemNo>
If Parameters Then
If Assigned(ColNo) Then
swap "ColNo" with ColNo in Parameters
End
If Assigned(RowNo) Then
swap "RowNo" with RowNo in Parameters
End
End
itemStruct <MENUPOS_MSGPARMS$> = Parameters
return
AddSeparator:
itemStruct = ""
menuItem = "<separator>"
endFlag = 0
GoSub AddMenuItem
return
AddMenuItem:
itemType = "I"
if menuItem EQ "<separator>" Then itemType = "S"
itemStruct <MENUPOS_TYPE$> = itemType
itemStruct <MENUPOS_END$> = endFlag
convert @fm to @svm in itemStruct
menuStruct <1, -1> = itemStruct
menuItemCnt = count(menuStruct, @vm) + 1
hidden = menuStruct<1, menuItemCnt, MENUPOS_HIDDEN$>
* Hide separator if all previous items were also hidden
if itemType EQ "I" AND Not(hidden) Then
allHidden = False$
end
if (endFlag OR itemType EQ "S") Then
If prevSeparator AND allHidden Then
menuStruct<1, prevSeparator, MENUPOS_HIDDEN$> = True$
end
if itemType EQ "S" Then
prevSeparator = count(menuStruct, @vm) + 1
allHidden = True$
end
end
return
ParseParameters:
p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""; p7 = ""; p8 = ""; p9 = ""; p10 = ""
p11 = ""; p12 = ""; p13 = ""; p14 = ""; p15 = ""; p16 = ""; p17 = ""; p18 = ""; p19 = ""; p20 = ""
paramCnt = count(Parameters, ",") + 1
For i = 1 to paramCnt
temp = Field(Parameters, ",", i)
Begin Case
Case temp _EQC "CTRLENTID"
temp = CtrlEntId
Case temp _EQC "MenuItem"
temp = menuItem
Case temp _EQC "ColNo"
If Assigned(ColNo) Then temp = ColNo
Case temp _EQC "RowNo"
If Assigned(RowNo) Then temp = RowNo
Case temp _EQC "@FOCUS"
temp = Get_Property(@Window, "FOCUS")
Case temp _EQC "@MDIACTIVE"
temp = Get_Property(@Window, "MDIACTIVE")
Case temp _EQC "@MDIFRAME"
temp = Get_Property(@Window, "MDIFRAME")
Case temp _EQC "@SELF"
temp = Control
Case temp _EQC "@WINDOW"
temp = @Window
Case Otherwise$
* Substitute for system delimeters
swap ":@FM:" with @FM in temp
swap ":@VM:" with @VM in temp
swap ":@SVM:" with @SVM in temp
swap ":@TM:" with @TM in temp
swap ":@STM:" with @STM in temp
End Case
Begin Case
Case i EQ 1
p1 = temp
Case i EQ 2
p2 = temp
Case i EQ 3
p3 = temp
Case i EQ 4
p4 = temp
Case i EQ 5
p5 = temp
Case i EQ 6
p6 = temp
Case i EQ 7
p7 = temp
Case i EQ 8
p8 = temp
Case i EQ 9
p9 = temp
Case i EQ 10
p10 = temp
Case i EQ 11
p11 = temp
Case i EQ 12
p12 = temp
Case i EQ 13
p13 = temp
Case i EQ 14
p14 = temp
Case i EQ 15
p15 = temp
Case i EQ 16
p16 = temp
Case i EQ 17
p17 = temp
Case i EQ 18
p18 = temp
Case i EQ 19
p19 = temp
Case i EQ 20
p20 = temp
end case
Next
return
Disable_WinMenu_Option:
CanUndo = Get_Property(CtrlEntId, "CANUNDO")
ClipText = Get_Property("CLIPBOARD", "TEXT")
Selection = Get_Property(CtrlEntId, "SELECTION")
Text = Get_Property(CtrlEntId, "TEXT")
WinMenuItems = "Undo,Cut,Copy,Paste,Delete,Select All"
Locate MenuItem in WinMenuItems using "," setting itempos then
Begin Case
Case MenuItem _EQC "UNDO" AND Not(CanUndo)
disabledFlag = Yes$
Case Selection EQ ""
disabledFlag = Yes$
Case Selection<2> EQ 0 AND (MenuItem _EQC "CUT" OR MenuItem _EQC "COPY" OR MenuItem _EQC "DELETE")
disabledFlag = Yes$
Case MenuItem _EQC "PASTE" AND ClipText EQ ""
disabledFlag = Yes$
Case MenuItem _EQC "SELECT ALL" AND (Selection<2> EQ Len(Text) OR Selection<1> EQ 65536)
disabledFlag = Yes$
Case Otherwise$
disabledFlag = No$
End Case
end
return
Execute_WinMenu_Option:
CtrlType = Get_Property(Control, "TYPE")
Begin Case
Case CtrlType _NEC "EDITTABLE" AND menuItem _NEC "DELETE"
Send_Message(Control, menuItem)
Case menuItem _EQC "CUT" OR menuItem _EQC "COPY" OR menuItem _EQC "DELETE"
Selection = Get_Property(Control, "SELECTION")
Text = Get_Property(Control, "TEXT")
StartPos = Selection<1>
Length = Selection<2>
If menuItem _EQC "CUT" OR menuItem _EQC "COPY" Then
Set_Property("CLIPBOARD", "TEXT", Text[StartPos, Length])
end
If menuItem _EQC "CUT" OR menuItem _EQC "DELETE" Then
Text[StartPos, Length] = ""
Set_Property(Control, "TEXT", Text)
Set_Property(Control, "SELECTION", StartPos:@FM:0)
end
Case menuItem _EQC "PASTE"
ClipText = Get_Property("CLIPBOARD", "TEXT")
Selection = Get_Property(Control, "SELECTION")
Text = Get_Property(Control, "TEXT")
StartPos = Selection<1>
Length = Selection<2>
Text[StartPos, Length] = ClipText
Set_Property(Control, "TEXT", Text)
Case menuItem _EQC "UNDO"
Send_Message(Control, menuItem)
End Case
return