*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="_menu.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS _shortcutmenu AS _custom OF "_base.vcx"
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
*
*m: activatemenu && Activates existing shortcut menu.
*m: addmenubar && Adds new menu bar to shortcut menu.
*m: addmenuseparator && Adds separator to shortcut menu.
*m: clearmenu && Releases existing shortcut menu.
*m: deactivatemenu && Deactivates existing shortcut menu.
*m: newmenu && Creates new menu popup for shortcut menu.
*m: setmenu && Releases current shortcut menu to create new one.
*m: showmenu && Show existing shortcut menu.
*p: cmenu && Name of shortcut menu.
*p: conselection && Menu bar selection routine.
*a: amenu[1,0]
*
*
cmenu =
conselection =
Height = 22
Name = "_shortcutmenu"
Width = 24
*
PROCEDURE activatemenu && Activates existing shortcut menu.
LPARAMETERS tcParentMenu
LOCAL lnArrayColumns,llMultiArray,lnBar,lnSkipCount,lnCount,lnMRow,lnMCol
LOCAL lnMenuCount,lcMenu,lcMenu2,lcMenuItem,luMenuSelection,llSetMark,lcClauses
lnMRow=MAX(MROW(),0)
lnMCol=MAX(MCOL(),0)
IF TYPE("this.aMenu")#"C"
RETURN .F.
ENDIF
lnMenuCount=ALEN(this.aMenu,1)
IF lnMenuCount=0
RETURN .F.
ENDIF
lcMenu=IIF(EMPTY(tcParentMenu),SYS(2015),ALLTRIM(tcParentMenu))
this.cMenu=lcMenu
lnArrayColumns=ALEN(this.aMenu,2)
llMultiArray=(lnArrayColumns>0)
DEACTIVATE POPUP (lcMenu)
CLEAR TYPEAHEAD
IF EMPTY(tcParentMenu)
DEFINE POPUP (lcMenu) ;
FROM lnMRow,lnMCol ;
MARGIN ;
SHORTCUT
ON SELECTION POPUP (lcMenu) DEACTIVATE MENU (lcMenu)
ENDIF
lnSkipCount=0
FOR lnCount = 1 TO lnMenuCount
lcMenuItem=IIF(llMultiArray,this.aMenu[lnCount,1],this.aMenu[lnCount])
IF TYPE("lcMenuItem")#"C" OR EMPTY(lcMenuItem) OR ;
((lnCount=1 OR lnCount=lnMenuCount) AND ALLTRIM(lcMenuItem)=="\-")
lnSkipCount=lnSkipCount+1
LOOP
ENDIF
lnBar=lnCount-lnSkipCount
llSetMark=.F.
IF LEFT(lcMenuItem,1)=="^"
lcMenuItem=SUBSTR(lcMenuItem,2)
llSetMark=.T.
ENDIF
IF lnArrayColumns>=3 AND NOT EMPTY(this.aMenu[lnCount,3])
lcClauses=ALLTRIM(this.aMenu[lnCount,3])
ELSE
lcClauses=""
ENDIF
IF EMPTY(lcClauses)
DEFINE BAR lnBar OF (lcMenu) PROMPT (lcMenuItem)
ELSE
DEFINE BAR lnBar OF (lcMenu) PROMPT (lcMenuItem) &lcClauses
ENDIF
IF llSetMark
SET MARK OF BAR (lnBar) OF (lcMenu) TO .T.
ENDIF
IF NOT llMultiArray
LOOP
ENDIF
luMenuSelection=this.aMenu[lnCount,2]
IF TYPE("luMenuSelection")=="O" AND NOT ISNULL(luMenuSelection)
lcMenu2=SYS(2015)
DEFINE POPUP (lcMenu2) ;
MARGIN ;
SHORTCUT
ON SELECTION POPUP (lcMenu2) DEACTIVATE MENU (lcMenu2)
ON BAR lnBar OF (lcMenu) ACTIVATE POPUP (lcMenu2)
IF EMPTY(luMenuSelection.cOnSelection)
luMenuSelection.cOnSelection=this.cOnSelection
ENDIF
luMenuSelection.ActivateMenu(lcMenu2)
LOOP
ENDIF
IF EMPTY(luMenuSelection)
luMenuSelection=ALLTRIM(this.cOnSelection)
ENDIF
IF NOT EMPTY(luMenuSelection)
ON SELECTION BAR lnBar OF (lcMenu) &luMenuSelection
ENDIF
ENDFOR
IF lnSkipCount>=lnMenuCount OR NOT EMPTY(tcParentMenu)
RETURN
ENDIF
ACTIVATE POPUP (lcMenu)
IF NOT EMPTY(this.cMenu)
DEACTIVATE POPUP (this.cMenu)
ENDIF
this.cMenu=""
ENDPROC
PROCEDURE addmenubar && Adds new menu bar to shortcut menu.
LPARAMETERS tcPrompt,tcOnSelection,tcClauses,tnElementNumber,tlMark,tlDisabled,tlBold
LOCAL lcPrompt,lcClauses,lnElementNumber,lnMenuCount,lnArrayColumns,lnIndex,oShortCutMenu
IF EMPTY(tcPrompt)
RETURN .F.
ENDIF
IF TYPE("tcPrompt")=="O" AND NOT ISNULL(tcPrompt)
oShortCutMenu=tcPrompt
tcPrompt=.NULL.
FOR lnIndex = 1 TO ALEN(oShortCutMenu.aMenu,1)
this.AddMenuBar(oShortCutMenu.aMenu[lnIndex,1],oShortCutMenu.aMenu[lnIndex,2], ;
oShortCutMenu.aMenu[lnIndex,3])
ENDFOR
RETURN
ENDIF
lcPrompt=tcPrompt
lcClauses=IIF(EMPTY(tcClauses),"",tcClauses)
IF tlMark
lcPrompt="^"+lcPrompt
ENDIF
IF tlDisabled
lcClauses=lcClauses+[ SKIP FOR .T.]
ENDIF
IF tlBold
lcClauses=lcClauses+[ STYLE "B"]
ENDIF
lnMenuCount=ALEN(this.aMenu,1)
lnArrayColumns=ALEN(this.aMenu,2)
IF lnMenuCount<=1 AND EMPTY(this.aMenu[1])
lnMenuCount=1
lnArrayColumns=3
ELSE
lnMenuCount=lnMenuCount+1
ENDIF
lnIndex=lnMenuCount
DIMENSION this.aMenu[lnIndex,lnArrayColumns]
IF TYPE("tnElementNumber")=="N"
lnElementNumber=MAX(INT(tnElementNumber),1)
IF lnElementNumber=3
this.aMenu[lnIndex,3]=lcClauses
ENDIF
ENDPROC
PROCEDURE addmenuseparator && Adds separator to shortcut menu.
LPARAMETERS tnElementNumber
this.AddMenuBar("\-",,,tnElementNumber)
ENDPROC
PROCEDURE clearmenu && Releases existing shortcut menu.
DIMENSION this.aMenu[1]
this.aMenu=""
this.cOnSelection=""
ENDPROC
PROCEDURE deactivatemenu && Deactivates existing shortcut menu.
IF EMPTY(this.cMenu)
RETURN
ENDIF
DEACTIVATE POPUP (this.cMenu)
this.cMenu=""
DOEVENTS
ENDPROC
PROCEDURE Init
this.ClearMenu
ENDPROC
PROCEDURE newmenu && Creates new menu popup for shortcut menu.
LOCAL toObject
LOCAL oNewObject,lcClass,lcClassLibrary,lcBaseClass,lcAlias,llAddLibrary
IF TYPE("toObject")#"O" OR ISNULL(toObject)
toObject=this
ENDIF
lcClass=LOWER(toObject.Class)
lcClassLibrary=LOWER(toObject.ClassLibrary)
lcBaseClass=LOWER(toObject.BaseClass)
IF EMPTY(lcClassLibrary)
oNewObject=CREATEOBJECT(lcBaseClass)
RETURN oNewObject
ENDIF
lcAlias=LOWER(SYS(2015))
llAddLibrary=(ATC(lcClassLibrary,SET("CLASSLIB"))=0)
IF llAddLibrary
SET CLASSLIB TO (lcClassLibrary) ALIAS (lcAlias) ADDITIVE
ENDIF
oNewObject=CREATEOBJECT(lcClass)
IF llAddLibrary
RELEASE CLASSLIB ALIAS (lcAlias)
ENDIF
RETURN oNewObject
ENDPROC
PROCEDURE setmenu && Releases current shortcut menu to create new one.
LPARAMETERS toObject
this.ClearMenu
RETURN .F.
ENDPROC
PROCEDURE showmenu && Show existing shortcut menu.
RETURN this.ActivateMenu()
ENDPROC
ENDDEFINE