gentabmenu.prg

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

            \*-- Add the <<loMenuData.Prompt>> popup
            \<<"loPopup = _SCREEN.oTabMenu.AddPopup('" + loMenuData.Prompt + "'," + ALLTRIM(STR(lnTabNumber,3,0)) + ")">>
            \<<"loPopup.Width = _SCREEN.oTabMenuHandler.nDefaultItemWidth">>
            \<<"loPopup.Alignment = _SCREEN.oTabMenuHandler.nDefaultAlignment">>
          ENDIF
        
          IF NOT EMPTY(procedure)
            *-- The developer has added some code to the setup of this 
            * popup so that needs to be included in the generated program
            \<<ALLTRIM(procedure)>>
          ENDIF
          llReturn = llReturn AND spProcessMenu(m.vcMenuFile, vnLevel + 1, LEFT(ALLTRIM(Name) + SPACE(LEN(LevelName)), LEN(LevelName)), lcItemKey, lnTabNumber)
        ENDIF
      ELSE
        *-- there are no submenu items so its possible that the developer
        * simply did not select the correct object type.  We will assume 
        * that its a menu item in the default popup
        IF NOT llDefPopup
          \*-- Add the <<ALLTRIM(vcLevelName)>> default popup
          \<<"loDefPopup = _SCREEN.oTabMenu.AddPopup(''," + ALLTRIM(STR(lnTabNumber,3,0)) + ")">>
          \<<"loDefPopup.nColumns = " + STR(INT(RECCOUNT(lcCursor)/3)+IIF(MOD(RECCOUNT(lcCursor),3) = 0,0,1),3,0)>>
          \<<"loDefPopup.Width = loDefPopup.nColumns * _SCREEN.oTabMenuHandler.nDefaultItemWidth">>
          \<<"loDefPopup.Alignment = _SCREEN.oTabMenuHandler.nDefaultAlignment">>
          llDefPopup = .t.
        ENDIF
        
        \
        \<<"loItem = loDefPopup.AddPopupItem('" + loMenuData.Prompt + "','NORM','" + loMenuData.keylabel + "')">>
        IF NOT EMPTY(loMenuData.ResName)
          \<<"loItem.cPicture = '" + loMenuData.ResName + "'">>
        ENDIF
        IF NOT EMPTY(loMenuData.SkipFor)
          \<<"loItem.cSkipForExp = [" + loMenuData.SkipFor + "]">>
        ENDIF
        IF NOT EMPTY(loMenuData.Message)
          \<<"loItem.ToolTipText = [" + loMenuData.Message + "]">>
        ENDIF
        IF NOT EMPTY(lcItemKey)
          \<<"loItem.cItemKey = '" + lcItemKey + "'">>
        ENDIF

        lcEventCode  = ""
        
        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)
              lcEventCode = 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)
              lcEventCode = 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)
            lcEventCode = ""
            
            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
                  lcEventCode = "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(lcEventCode)
          poMenuDefault.ExecuteEventCode = poMenuDefault.ExecuteEventCode + CHR(13) + ;
          "FUNCTION " + lcBindEvent + "()" + CHR(13) + ;
          lcEventCode + CHR(13) + ;
          "ENDFUNC" + CHR(13)
        ENDIF
        
        \BINDEVENT(loItem, "Execute", _SCREEN.oTabMenuHandler, "<<lcBindEvent>>")        
      ENDIF
      
      USE IN (lnMenuFile)
    ELSE
      IF vnLevel = 0
        *-- commands in the top level are added to the quick bar
        \<<"IF FILE('" + loMenuData.Prompt + "')">>
        \<<"  loItem = _SCREEN.oTabMenu.cntQuickBar.AddItem('" + loMenuData.Prompt + "')">>
        IF NOT EMPTY(loMenuData.SkipFor)
          \<<"  loItem.cSkipForExp = [" + loMenuData.SkipFor + "]">>
        ENDIF
        IF NOT EMPTY(loMenuData.Message)
          \<<"  loItem.ToolTipText = [" + loMenuData.Message + "]">>
        ENDIF
        IF NOT EMPTY(lcItemKey)
          \<<"  loItem.cItemKey = 'QUICK." + lcItemKey + "'">>
        ENDIF
        \ENDIF
      ELSE
        *-- These are the menu items within the popups
        IF vnLevel = 1 
          *-- We are in the level below the menu so we need to know if the
          * default popup has been created because commands or procedures at 
          * this level need to be added to that.
          IF NOT llDefPopup
            \*-- Add the <<ALLTRIM(vcLevelName)>> default popup
            \<<"loDefPopup = _SCREEN.oTabMenu.AddPopup(''," + ALLTRIM(STR(lnTabNumber,3,0)) + ")">>
            \<<"loDefPopup.nColumns = " + STR(INT(RECCOUNT(lcCursor)/3)+IIF(MOD(RECCOUNT(lcCursor),3) = 0,0,1),3,0)>>
            \<<"loDefPopup.Width = loDefPopup.nColumns * _SCREEN.oTabMenuHandler.nDefaultItemWidth">>
            \<<"loDefPopup.Alignment = _SCREEN.oTabMenuHandler.nDefaultAlignment">>
            llDefPopup = .t.
          ENDIF
          \<<"loPopup = loDefPopup">>
        ENDIF
        \
        \<<"loItem = loPopup.AddPopupItem('" + loMenuData.Prompt + "','NORM','" + loMenuData.keylabel + "')">>
        IF NOT EMPTY(loMenuData.ResName) AND loMenuData.SysRes <> 1
          \<<"loItem.cPicture = '" + loMenuData.ResName + "'">>
        ENDIF
        IF NOT EMPTY(loMenuData.SkipFor)
          \<<"loItem.cSkipForExp = [" + loMenuData.SkipFor + "]">>
        ENDIF
        IF NOT EMPTY(loMenuData.Message)
          \<<"loItem.ToolTipText = [" + loMenuData.Message + "]">>
        ENDIF
        IF NOT EMPTY(lcItemKey)
          \<<"loItem.cItemKey = '" + lcItemKey + "'">>
        ENDIF
        IF loMenuData.SubMenu
          \<<"loItem.nShowSubmenu = 2">>
        ENDIF
      ENDIF
      
      lcEventCode  = ""
      
      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)
            lcEventCode = 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)
            lcEventCode = 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)
          lcEventCode = ""
          
          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
                lcEventCode = "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(lcEventCode)
        poMenuDefault.ExecuteEventCode = poMenuDefault.ExecuteEventCode + CHR(13) + ;
        "FUNCTION " + lcBindEvent + "()" + CHR(13) + ;
        lcEventCode + CHR(13) + ;
        "ENDFUNC" + CHR(13)
      ENDIF
      
      \BINDEVENT(loItem, "Execute", _SCREEN.oTabMenuHandler, "<<lcBindEvent>>")
    ENDIF

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

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

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

\\**************************************************************************************
\*$PROGRAM$ <<JUSTFNAME(SET("TEXTMERGE",2))>>
\*$CREATED$ <<DATE()>>
\**************************************************************************************
\

  TEXT TO TEXTMERGE

*-- Initialise the variables
LOCAL loToolbar, loMenuTab, loPopup, loItem, loDefPopup

#define WM_GETMINMAXINFO    0x0024
#define GWL_WNDPROC         (-4)
#define WM_ACTIVATEAPP      0x001C
#define WM_KEYDOWN          0x0100
#define WM_KEYUP            0x0101
#define WM_SYSKEYUP         0x0105

*-- Need to declare the Windows API command to determine the windows process handle
DECLARE INTEGER GetWindowLong IN WIN32API INTEGER hWnd, INTEGER nIndex

*-- The toolbar tabmenu container will be added to the _SCREEN object because we
* can guarantee a path to this object in all VFP applications and that way do
* not require any additional global variables the same is true for the menu event 
* handler object
_SCREEN.AddProperty('oTabMenu')
_SCREEN.AddProperty('oTabMenuHandler')

IF TYPE("_SCREEN.ActiveForm") = "O" AND _SCREEN.ActiveForm.ShowWindow = 2
  *-- The top level form exists so the tabmenu toolbar should be added to this form
  * as should the nOldProc property to store the windows processs handle
  _SCREEN.ActiveForm.AddProperty('oToolBar')
  _SCREEN.ActiveForm.AddProperty('nOldProc')

  _SCREEN.ActiveForm.oToolbar = CREATEOBJECT("tbrTabMenu")
  _SCREEN.ActiveForm.oToolbar.Left = 0 - SYSMETRIC(3) - _SCREEN.ActiveForm.oToolbar.cntTabMenu.Left
  _SCREEN.ActiveForm.oToolbar.Top = 0 - SYSMETRIC(34) - SYSMETRIC(4) - _SCREEN.ActiveForm.oToolbar.cntTabMenu.Top
  
  _SCREEN.ActiveForm.nOldProc = GetWindowLong(_SCREEN.ActiveForm.hWnd, GWL_WNDPROC)

  _SCREEN.oTabMenu = _SCREEN.ActiveForm.oToolbar.cntTabMenu
  _SCREEN.oTabMenu.nOldProc  = _SCREEN.ActiveForm.nOldProc 
  _SCREEN.oTabMenu.cCaption  = _SCREEN.ActiveForm.Caption
  _SCREEN.oTabMenu.Width     = _SCREEN.ActiveForm.Width 
  _SCREEN.oTabMenu.oMainForm = _SCREEN.ActiveForm
  
  BINDEVENT(_SCREEN.ActiveForm.hWnd, WM_ACTIVATEAPP, _SCREEN.oTabMenu, "WMEventHandler")
  BINDEVENT(_SCREEN.ActiveForm.hWnd, WM_KEYDOWN, _SCREEN.oTabMenu, "WMEventHandler")
  BINDEVENT(_SCREEN.ActiveForm.hWnd, WM_KEYUP, _SCREEN.oTabMenu, "WMEventHandler")
  BINDEVENT(_SCREEN.ActiveForm.hWnd, WM_SYSKEYUP, _SCREEN.oTabMenu, "WMEventHandler")
  BINDEVENT(_SCREEN.ActiveForm, "Resize", _SCREEN.oTabMenu, "MainFormResize")
ELSE
  *-- The screen is being used as the main form so the toolbar will be added in the VFP screen
  * as should the nOldProc property to store the windows processs handle
  _SCREEN.AddProperty('oToolBar')
  _SCREEN.AddProperty('nOldProc')
  
  _SCREEN.oToolbar = CREATEOBJECT("tbrTabMenu")
  _SCREEN.oToolbar.Left = 0 - SYSMETRIC(3) - _SCREEN.oToolbar.cntTabMenu.Left
  _SCREEN.oToolbar.Top = 0 - SYSMETRIC(34) - SYSMETRIC(4) - _SCREEN.oToolbar.cntTabMenu.Top

  _SCREEN.nOldProc = GetWindowLong(_VFP.hWnd, GWL_WNDPROC)

  _SCREEN.oTabMenu = _SCREEN.oToolbar.cntTabMenu
  _SCREEN.oTabMenu.nOldProc = _SCREEN.nOldProc 
  _SCREEN.oTabMenu.cCaption = _SCREEN.Caption
  _SCREEN.oTabMenu.Width    = _SCREEN.Width
  
  *-- Get rid of the system menu as this is supposed to replace it
  SET SYSMENU OFF

  BINDEVENT(_VFP.hWnd, WM_ACTIVATEAPP, _SCREEN.oTabMenu, "WMEventHandler")
  BINDEVENT(_VFP.hWnd, WM_KEYDOWN, _SCREEN.oTabMenu, "WMEventHandler")
  BINDEVENT(_VFP.hWnd, WM_KEYUP, _SCREEN.oTabMenu, "WMEventHandler")
  BINDEVENT(_VFP.hWnd, WM_SYSKEYUP, _SCREEN.oTabMenu, "WMEventHandler")