gentabmenu.prg

vfp巅峰制作(仿office2007),精典源码作品,不容错过

  BINDEVENT(_SCREEN, "Resize", _SCREEN.oTabMenu, "MainFormResize")
ENDIF

*-- Make sure that the menu event handler object exists as this is the thing
* that all menu events will be bound to
_SCREEN.otabMenuHandler = CREATEOBJECT("cusMenuEventHandler")

  ENDTEXT

  RETURN m.llreturn
ENDFUNC

**************************************************************************************
*$FUNCTION$ spProcessSetup()
*$CREATED$ 15/02/2007
**************************************************************************************
FUNCTION spProcessSetup()
  LOCAL llReturn
  llReturn = .t.

\**************************************************************************************
\*Setup code for the menu
\**************************************************************************************
\
  TEXT TO TEXTMERGE
<<poMenuDefault.Setup>>  
  ENDTEXT
    
  RETURN m.llreturn
ENDFUNC

**************************************************************************************
*$FUNCTION$ spProcessCleanup()
*$CREATED$ 15/02/2007
**************************************************************************************
FUNCTION spProcessCleanup()
  LOCAL llReturn
  llReturn = .t.

\
\**************************************************************************************
\*Cleanup code for the menu
\**************************************************************************************
\
  TEXT TO TEXTMERGE
<<poMenuDefault.Cleanup>>  
  ENDTEXT
  
  RETURN m.llreturn
ENDFUNC

**************************************************************************************
*$FUNCTION$ spProcessFooter()
*$CREATED$ 15/02/2007
**************************************************************************************
FUNCTION spProcessFooter()
  LOCAL llReturn
  llReturn = .t.

\_SCREEN.oTabMenu.SelectMenuItem(1)

\IF TYPE("_SCREEN.ActiveForm") = "O" AND _SCREEN.ActiveForm.ShowWindow = 2
\  _SCREEN.ActiveForm.oToolbar.Refresh()
\  _SCREEN.ActiveForm.oToolbar.Show()
\ELSE
\  _SCREEN.oToolbar.Refresh()
\  _SCREEN.oToolbar.Show()
\ENDIF
\
\RETURN
\
\**************************************************************************************
\*$CLASS$ cusMenuEventHandler
\**************************************************************************************
\DEFINE CLASS cusMenuEventHandler AS Custom
\
\  *-- Initialise the properties
\  nDefaultItemWidth = 150
\  nDefaultAlignment = 2
\
\**************************************************************************************
\*$METHOD$ <<poMenuDefault.DefEvent>>()
\*
\*$PURPOSE$
\* This method contains the code run by the selected menu options if the menu option 
\* has no code of its own.
\*$PURPOSE$
\**************************************************************************************
\FUNCTION <<poMenuDefault.DefEvent>>()
\<<poMenuDefault.DefEventCode>>
\ENDFUNC
\
\<<poMenuDefault.ExecuteEventCode>>
\
IF NOT EMPTY(poMenuDefault.procedure)
\<<poMenuDefault.procedure>>
ENDIF
\ENDDEFINE
\**************************************************************************************
  
  RETURN m.llreturn
ENDFUNC

**************************************************************************************
*$FUNCTION$ spProcessSubMenu()
*$CREATED$ 23/02/2007
**************************************************************************************
FUNCTION spProcessSubMenu(vcMenuFile, vnItemRecno, vcLevelName, vcItemKey, vcBindEvent)
  LOCAL llReturn, lcCursor, lnSelect, loMenuData, lcEventCode, lcItemKey, lnMenuFile, ;
        lcSubCode, lcBindEvent
  
  lnSelect    = SELECT()
  lcCursor    = "r" + SYS(2015)
  vcItemKey   = IIF(EMPTY(vcItemKey),"",vcItemKey)
  llReturn    = .t.
  lcEventCode = ""
  lcSubCode   = ""
  lcSubEvent  = ""
  lcItemKey   = ""
  lnMenuFile  = 0

  *-- Need to see if there is any specific code added to this submenu
  SELECT 0
  USE (m.vcMenuFile) AGAIN
  lnMenuFile = SELECT()
  
  GO vnItemRecno
  LOCATE REST FOR objtype = 2 AND objcode = 0
  IF FOUND() 
    IF NOT EMPTY(ALLTRIM(procedure))
      lcSubCode = "*-- Add the submenu specific code here" + CHR(13) + ;
                  ALLTRIM(procedure) + CHR(13)
    ENDIF
  ENDIF
  
  USE IN (lnMenuFile)
  
  *-- Determine the sub menu data
  SELECT *, RECNO() AS itemrecno FROM (m.vcMenuFile) WHERE (LevelName = vcLevelName) AND (VAL(ItemNum) > 0) AND (ALLTRIM(prompt) <> "\-") INTO CURSOR (lcCursor)
  
  lcEventCode = "LOCAL loItem, loSubMenu" + CHR(13) + ;
                "AEVENTS(paSource,0)" + CHR(13) + ;
                "paSource[1].lSelected = .t." + CHR(13) + ;
                "losubMenu = CREATEOBJECT('frmPopup', paSource[1], _SCREEN.oTabMenu)" + CHR(13) + ;
                "WITH losubMenu" + CHR(13) + ;
                "  *-- Resize the window" + CHR(13) + ;
                "  .Width  = _SCREEN.oTabMenuHandler.nDefaultItemWidth" + CHR(13) + ;
                "  .Height = " + STR(RECCOUNT(lcCursor)*24,3,0) + CHR(13) + ;
                "  .nPopupStyle = 1" + CHR(13) + ;
                lcSubCode + ;
                "  .Resize()" + CHR(13)
 
  SCAN FOR NOT DELETED()
    SCATTER MEMO NAME loMenuData

    *-- Add the properties needed to the data
    ADDPROPERTY(loMenuData, "Submenu", .f.)
    ADDPROPERTY(loMenuData, "MarkExp", "")

    IF "*:MARKEXP" $ UPPER(loMenuData.Comment)
      *-- The menu bar has additional directives in the comment
      * which need to be parsed and included in the menu data object
      loMenuData.MarkExp = spGetDirective("*:MARKEXP", loMenuData.Comment)
    ENDIF

    *-- Format the text
    loMenuData.Prompt = STRTRAN(loMenuData.Prompt, "\-", "")
    loMenuData.Prompt = STRTRAN(loMenuData.Prompt, "\+", "")
    loMenuData.Prompt = CHRTRAN(loMenuData.Prompt, "\<", "")
    
    IF EMPTY(loMenuData.Prompt)
      *-- No data here so skip it
      LOOP
    ENDIF

    loMenuData.KeyLabel = STRTRAN(UPPER(loMenuData.KeyLabel), "CTRL+", "")
    loMenuData.KeyLabel = STRTRAN(UPPER(loMenuData.KeyLabel), "ALT+", "")

    *-- Build up the item key as a string based on the structure of the menu
    lcItemKey = vcItemKey + IIF(EMPTY(vcItemKey),"",".") + UPPER(CHRTRAN(loMenuData.Prompt," .",""))
    
    lcEventCode = lcEventCode + "loItem = .cntPopupItems.AddPopupItem('" + loMenuData.Prompt + "', 'NORM','" + loMenuData.KeyLabel + "')" + CHR(13)
    IF NOT EMPTY(loMenuData.ResName) AND loMenuData.SysRes <> 1
      lcEventCode = lcEventCode + "loItem.cPicture = '" + loMenuData.ResName + "'" + CHR(13)
    ENDIF
    IF NOT EMPTY(loMenuData.SkipFor)
      lcEventCode = lcEventCode + "loItem.cSkipForExp = [" + loMenuData.SkipFor + "]" + CHR(13)
    ENDIF
    IF NOT EMPTY(loMenuData.Message)
      lcEventCode = lcEventCode + "loItem.ToolTipText = [" + loMenuData.Message + "]"  + CHR(13)
    ENDIF
    IF NOT EMPTY(loMenuData.MarkExp)
      lcEventCode = lcEventCode + "loItem.cMarkExp = [" + loMenuData.MarkExp + "]" + CHR(13)
    ENDIF
    IF NOT EMPTY(lcItemKey)
      lcEventCode = lcEventCode + "loItem.cItemKey = '" + lcItemKey + "'" + CHR(13)
    ENDIF
    
    lcSubEvent  = ""
    
    DO CASE
      CASE loMenuData.ObjCode = 67
        *-- The menu item is defined as a command
        IF EMPTY(loMenuData.Command)
          lcBindEvent = poMenuDefault.DefEvent
        ELSE
          lcBindEvent = "c" + SYS(2015)
          lcSubEvent = loMenuData.Command
        ENDIF
      CASE loMenuData.ObjCode = 80
        *-- The menu item is defined as a procedure
        IF EMPTY(loMenuData.procedure)
          lcBindEvent = poMenuDefault.DefEvent
        ELSE
          lcBindEvent = "p" + SYS(2015)
          lcSubEvent = loMenuData.Procedure
        ENDIF
      CASE loMenuData.ObjCode = 78 AND USED("w_menudata")
        *-- The menu item is defines as a system menu bar #
        lcBindEvent = "b" + SYS(2015)
        lcSubEvent = ""
        
        SELECT w_menudata
        LOCATE FOR w_menudata.sysmenuname = LOWER(loMenuData.Name)
        IF FOUND() AND NOT EMPTY(loMenuData.Name)
          DO WHILE NOT BOF("w_menudata")
            SKIP -1
            IF AT("_",w_menudata.sysmenuname,2) = 0
              lcSubEvent = "SYS(1500, '" + LOWER(loMenuData.Name) + "', '" + ALLTRIM(w_menudata.sysmenuname) + "')"
              EXIT
            ENDIF
          ENDDO
        ELSE
          *-- Bind it to the default event
          lcBindEvent = poMenuDefault.DefEvent
        ENDIF
      OTHERWISE
        *-- The menu item needs to use the default event
        lcBindEvent = poMenuDefault.DefEvent
    ENDCASE
    
    IF NOT EMPTY(lcSubEvent)
      poMenuDefault.ExecuteEventCode = poMenuDefault.ExecuteEventCode + CHR(13) + ;
      "FUNCTION " + lcBindEvent + "()" + CHR(13) + ;
      lcSubEvent + CHR(13) + ;
      "ENDFUNC" + CHR(13)
    ENDIF
    
    lcEventCode = lcEventCode + [BINDEVENT(loItem, "Execute", _SCREEN.oTabMenuHandler, "] + lcBindEvent + [")] + CHR(13)
  ENDSCAN

  lcEventCode = lcEventCode + CHR(13) + ;
                "  _SCREEN.oTabMenu.oSubMenu = loSubMenu" + CHR(13) + ;
                "  .Show()" + CHR(13) + ;
                "ENDWITH"
  
  IF NOT EMPTY(lcEventCode)
    poMenuDefault.ExecuteEventCode = poMenuDefault.ExecuteEventCode + CHR(13) + ;
    "FUNCTION " + vcBindEvent + "()" + CHR(13) + ;
    lcEventCode + CHR(13) + ;
    "ENDFUNC" + CHR(13)
  ENDIF

  *-- Close the cursor opened here
  USE IN (lcCursor)

  *-- Reselect the previous work area
  SELECT (lnSelect)
  
  RETURN m.llReturn
ENDFUNC

**************************************************************************************
*$FUNCTION$ spGetDirective()
*$CREATED$ 17/03/2007
**************************************************************************************
FUNCTION spGetDirective(vcSearchFor, vcSearchIn)
  LOCAL lcReturn, lnCount, lcText

  STORE "" TO lcReturn

  _MLINE = 0
  FOR lnCount = 1 TO MEMLINES(m.vcSearchIn)
    lcText = MLINE(m.vcSearchIn, 1, _MLINE)
    IF UPPER(m.vcSearchFor) $ UPPER(m.lcText)
      lcReturn = ALLTRIM(SUBSTR(m.lcText, LEN(m.vcSearchFor) + 1))
    ENDIF
  NEXT
  
  RETURN m.lcReturn
ENDFUNC