tabmenu.vca

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

*$METHOD$ lShowQuickBar_assign()
*$CREATED$ 13/02/2007
****************************************************************************
LPARAMETERS vlNewVal

THIS.lShowQuickBar = (m.vlNewVal AND this.ltitlebar)
this.cntQuickBar.Visible = this.lShowQuickbar

ENDPROC
PROCEDURE lshowsearch_assign
LPARAMETERS vlNewVal
*To do: Modify this routine for the Assign method
THIS.lShowSearch = m.vlNewVal

this.cntsearchbox.Visible = this.lShowsearch

ENDPROC
PROCEDURE ltitlebar_assign
************************************************************************
*$METHOD$ lTitleBar_assign()
*$CREATED$ 07/02/2007
************************************************************************
LPARAMETERS vlNewVal

THIS.lTitlebar = m.vlNewVal

IF this.lTitlebar
  IF VARTYPE(this.omainform) = "O"
    this.oMainForm.TitleBar = 0
  ELSE
    _SCREEN.TitleBar = 0
  ENDIF
  this.cntcontrol.Visible = .t.
  this.lblCAPTION.Visible = .t.
ELSE
  IF VARTYPE(this.omainform) = "O"
    this.oMainForm.TitleBar = 1
  ELSE
    _SCREEN.TitleBar = 1
  ENDIF
  this.cntcontrol.Visible = .f.
  this.lShowquickbar = .f.
  this.lblCAPTION.Visible = .f.
ENDIF

this.Resize()
ENDPROC
PROCEDURE mainformresize
*************************************************************************
*$METHOD$ MainFormResize()
*$CREATED$ 27/02/2007
*************************************************************************
IF VARTYPE(this.omainform) = "O"
  this.cntControl.nWindowstate = this.omainform.windowstate
  this.Width = this.omainform.width
ELSE
  this.cntControl.nWindowstate = _SCREEN.WindowState
  IF this.Parent.Docked
    IF this.Width <> _SCREEN.width - (SYSMETRIC(3) * 2)
      this.Width = _SCREEN.width - (SYSMETRIC(3) * 2)
    ENDIF
  ELSE
    this.Width = _SCREEN.width
  ENDIF
ENDIF

ENDPROC
PROCEDURE selectmainitem
**************************************************************************
*$METHOD$ SelectMainItem()
*$CREATED$ 01/02/2007
**************************************************************************
LPARAMETERS vlShowHotkey

IF VARTYPE(this.osubmenu) = "O"
  this.osubmenu.Release()
ENDIF

*-- Create the form to hold the start menu popups
this.ofrmStartMenu = CREATEOBJECT(this.cfrmStartClass, this.cntMainItem, this)

WITH this.ofrmStartMenu
  .Show()
ENDWITH

ENDPROC
PROCEDURE selectmenuitem
***************************************************************************
*$METHOD$ SelectMenuItem()
*$CREATED$ 01/02/2007
***************************************************************************
LPARAMETERS vnItemIndex, vlShowHotKeys

LOCAL lnCount, lcItemName

this.lshowhotkeys = vlShowHotKeys

FOR lnCount = 1 TO this.ItemCount
  lcItemName = "MenuItem" + STRTRAN(STR(lnCount,3,0), " ", "0")
  WITH this.&lcItemName.
    IF .Selected AND .ItemIndex <> vnItemIndex
      .Selected = .f.
    ELSE
      IF .ItemIndex = vnItemIndex AND NOT .Selected
        .Selected = .t.
        this.pgfPopups.ActivePage = vnItemIndex
      ENDIF
    ENDIF
  ENDWITH
NEXT

IF VARTYPE(this.osubmenu) = "O"
  this.osubmenu.Release()
ENDIF
IF VARTYPE(this.ofrmstartmenu) = "O"
  this.ofrmstartmenu.Release()
ENDIF

WITH this.pgfPopups.Pages(vnItemIndex)
  FOR lnCount = 1 TO .ControlCount
    .Controls(lnCount).lShowHotKeys = vlShowHotKeys
  NEXT
ENDWITH

this.nSelecteditem = vnItemIndex
ENDPROC
PROCEDURE sendhotkey
**************************************************************************
*$METHOD$ SendHotKey()
*$CREATED$ 10/02/2007
**************************************************************************
LPARAMETERS vcHotKey

LOCAL llReturn, lnCount, lcItemName
llReturn = .f.
lnCount = 0
lcItemName = ""

IF ASC(vcHotKey) = 27
  *-- The escape key has been pressed
  DO CASE
    CASE VARTYPE(this.ofrmstartmenu) = "O"
      *-- Release the start menu if that is visible
      this.ofrmStartMenu.Release()
    CASE VARTYPE(this.osubmenu) = "O"
      *-- Release the sub menu if that is visible
      this.osubMenu.Release()
    OTHERWISE
      *-- Switch off the hotkeys
      this.lShowhotkeys = .f.
      RETURN .f.
  ENDCASE
ENDIF

vcHotKey = UPPER(vcHotKey)

IF NOT llReturn AND VARTYPE(this.ofrmstartmenu) = "O"
  *-- If the Start Menu form is active send the hotkey there first.
  llReturn = this.ofrmStartMenu.SendHotKey(vcHotKey)
ENDIF

IF NOT llReturn AND VARTYPE(this.osubmenu) = "O"
  *-- If a Sub Menu form is active send the hotkey there.
  llReturn = this.oSubMenu.SendHotKey(vcHotKey)
ENDIF

IF NOT llReturn AND this.lshowmain AND this.cntMainItem.chotkey = vcHotKey
  *-- If the hotkey has not yet been processed see if the hotkey refers to
  * the main item
  llReturn = this.cntMainItem.SelectMain(.t.)
ENDIF

IF NOT llReturn
  *-- It's not the main item so see if the hotkey refers to any of the
  * menu tabs.
  FOR lnCount = 1 TO this.ItemCount
    lcItemName = "MenuItem" + STRTRAN(STR(lnCount,3,0), " ", "0")
    WITH this.&lcItemName.
      IF .cHotKey = vcHotKey
        this.Selectmenuitem(.ItemIndex, .t.)
        llReturn = .t.
      ENDIF
    ENDWITH
  NEXT
ENDIF

IF NOT llReturn AND this.nSelectedItem > 0
  *-- It's not the menu tabs so see if the hotkey refers to any of the
  * menu popups for the selected menu item
  WITH this.pgfPopups.Pages(this.nSelectedItem)
    FOR lnCount = 1 TO .ControlCount
      IF .Controls(lnCount).lShowHotKeys AND .Controls(lnCount).SendHotKey(vcHotKey)
        llReturn = .t.
        EXIT
      ENDIF
    NEXT
  ENDWITH
ENDIF

IF NOT llReturn AND this.lshowquickbar
  *-- It's not the menu popups so see if the hotkey refers to any of the
  * quickbar shortcuts
  llReturn = this.cntquickbar.Sendhotkey(vcHotKey)
ENDIF

RETURN llReturn

ENDPROC
PROCEDURE toggleminimize
*************************************************************************
*$METHOD$ ToggleMinimize()
*$CREATED$ 18/03/2007
*************************************************************************
this.lMinimized = NOT this.lMinimized
ENDPROC
PROCEDURE togglequickbar
*************************************************************************
*$METHOD$ ToggleQuickBar()
*$CREATED$ 18/03/2007
*************************************************************************
this.lshowquickbar = (this.lTitleBar AND NOT this.lShowQuickBar)
ENDPROC
PROCEDURE wmeventhandler
************************************************************************
*$METHOD$ WMEventHandler()
*$CREATED$ 11/02/2007
************************************************************************
LPARAMETERS hWnd, Msg, wParam, lParam

#define WM_GETMINMAXINFO    0x0024
#define WM_ACTIVATEAPP      0x001C
#define WM_KEYDOWN          0x0100
#define WM_KEYUP            0x0101
#define WM_SYSKEYDOWN       0x0104
#define WM_SYSKEYUP         0x0105
#define WM_COMMAND          0x0111
#define WM_SYSCOMMAND       0x0112

LOCAL llPassThrough

llPassThrough = .f.

DO CASE
  CASE Msg = WM_ACTIVATEAPP
    IF wParam = 0
      this.cntcontrol.lActive = .f.
      this.lblCAPTION.ForeColor = RGB(141,141,141)
    ELSE
      this.cntcontrol.lActive = .t.
      this.lblCAPTION.ForeColor = RGB(21,66,139)

      IF TYPE("_SCREEN.Activeform") <> "O"
        *-- If there are no forms active in the application
        * then just refresh the toolbar, if there are screens
        * active then their activate should do this so there
        * is no need to make it happen twice
        this.Refresh()
      ENDIF
    ENDIF
    llPassThrough = .t.

  CASE Msg = WM_KEYDOWN AND this.lShowhotkeys
*    MESSAGEBOX("WM_KEYDOWN: " + TRANSFORM(wParam), 4096,"test",5000)
    *-- If the hotkeys are enabled we don't want the active control to
    * get any keyboard input
    =INKEY(0,"H")
    IF this.SendHotkey(CHR(wParam))
      this.lshowhotkeys = .t.
    ENDIF

  CASE Msg = WM_KEYDOWN AND this.lshowSearch
    IF wParam = 17
      this.lCtrlDown = .t.
    ELSE
      IF this.lCtrlDown AND wParam = 70
        this.lCtrlDown = .t.
        =INKEY(0,"H")
        this.cntsearchbox.txtSearch.SetFocus()
      ELSE
        llPassThrough = .t.
      ENDIF
    ENDIF
  CASE Msg = WM_KEYUP AND this.lCtrlDown
    IF wParam = 17
      this.lCtrlDown = .f.
    ENDIF
    llPassThrough = .t.
*    MESSAGEBOX("WM_KEYUP: wParam = " + TRANSFORM(wParam) + " lParam = " + TRANSFORM(lParam), 4096,"test",5000)

  CASE Msg = WM_SYSKEYUP
*    MESSAGEBOX("WM_SYSKEYUP: " + TRANSFORM(wParam), 4096,"test",5000)
    IF wParam = 9
      *-- Alt+Tab was pressed then we don't really want to do anything
      llPassThrough = .t.
    ELSE
      this.lshowhotkeys = (NOT this.lShowHotkeys)
      IF wParam > 18
        IF this.Sendhotkey(CHR(wParam))
          this.lshowhotkeys = .t.
        ENDIF
      ENDIF
    ENDIF
  CASE Msg = WM_GETMINMAXINFO
*    MESSAGEBOX("WM_GETMINMAXINFO: width: " + TRANSFORM(this.oMainform.Width) + CHR(13) + ;
*               "height: " + TRANSFORM(this.oMainform.Height) + CHR(13) + ;
*               "top: " + TRANSFORM(this.oMainform.Top) + CHR(13) + ;
*               "left: " + TRANSFORM(this.oMainform.Left) + CHR(13) + ;
*               "Windowstate: " + TRANSFORM(this.oMainform.WindowState), 4096,"test")
*    this.oMainForm.WindowState = 0
*    RAISEEVENT(this, "AppMaximize")
  OTHERWISE
    llPassThrough = .t.

ENDCASE

IF llPassThrough
  DECLARE INTEGER CallWindowProc in Win32API ;
     integer lpPrevWndFunc, integer hWnd, integer Msg, integer wParam, ;
     integer lParam

  RETURN CallWindowProc(this.nOldProc, hWnd, Msg, wParam, lParam)
ELSE
  RETURN
ENDIF

ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
12[END RESERVED2]
[START RESERVED3]
itemcount
ofrmstartmenu
lshowhelp
lshowmain
ccaption
ltitlebar
lshowquickbar
lshowhotkeys
nselecteditem
lshowsearch
noldproc
cfrmstartclass
lctrldown
osubmenu
nmousex
nmousey
omainform
lallowresize
nmaxitempos
cbasefont
orightclick
lminimized
*addmenuitem 
*selectmenuitem 
*addpopup 
*ccaption_assign 
*ltitlebar_assign 
*lshowquickbar_assign 
*lshowhotkeys_assign 
*wmeventhandler 
*sendhotkey 
*lshowhelp_assign 
*lshowsearch_assign 
*selectmainitem 
*appexit 
*appminimize 
*appmaximize 
*apprestore 
*mainformresize 
*lallowresize_assign 
*cbasefont_assign 
*togglequickbar 
*lminimized_assign 
*toggleminimize 
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _2080IECMR
[CLASS] image
[BASECLASS] image
[OBJNAME] imgTitleBar
[PARENT] cnttabmenu
[START PROPERTIES]
Picture = images\titleback.bmp
Stretch = 2
Height = 24
Left = 56
Top = 2
Width = 4
Name = "imgTitleBar"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX0XZRX1
[CLASS] image
[BASECLASS] image
[OBJNAME] imgTabStrip
[PARENT] cnttabmenu
[START PROPERTIES]
Picture = images\tabstrip.bmp
Stretch = 2
Height = 28
Left = 0
Top = 0
Width = 4
Name = "imgTabStrip"
[END PROPERTIES]
[START METHODS]
PROCEDURE RightClick
*************************************************************************
*$METHOD$ RightClick()
*$CREATED$ 18/03/2007
*************************************************************************
RAISEEVENT(this.Parent, "RightClick")
ENDPROC
[END METHODS]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX12IR5T
[CLASS] shape
[BASECLASS] shape
[OBJNAME] shpPopup
[PARENT] cnttabmenu
[START PROPERTIES]
Top = 30
Left = 4
Height = 110
Width = 43
Curvature = 5
BackColor = 219,230,244
BorderColor = 138,175,225
Name = "shpPopup"
[END PROPERTIES]
[START METHODS]
PROCEDURE Click
IF VARTYPE(this.Parent.ofrmstartmenu) = "O"
  this.Parent.ofrmstartmenu.Release()
ENDIF
ENDPROC
[END METHODS]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0TP5RC
[CLASS] pageframe
[BASECLASS] pageframe
[OBJNAME] pgfPopups
[PARENT] cnttabmenu
[START PROPERTIES]
ErasePage = .T.
PageCount = 0
ActivePage = 0
BorderWidth = 0
Top = 24
Left = 84
Width = 241
Height = 169
Tabs = .F.
Name = "pgfPopups"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0UR0OI
[CLASS] cnthelpitem
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] Cnthelpitem
[PARENT] cnttabmenu
[START PROPERTIES]
Top = 0
Left = 350
Name = "Cnthelpitem"
IMGLEFT.Height = 21
IMGLEFT.Width = 3
IMGLEFT.Name = "IMGLEFT"
IMGRIGHT.Height = 21
IMGRIGHT.Width = 3
IMGRIGHT.Name = "IMGRIGHT"
IMGBACK.Name = "IMGBACK"
imgHelp.Height = 16
imgHelp.Width = 16
imgHelp.Name = "imgHelp"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _2080OX9DF
[CLASS] label
[BASECLASS] label
[OBJNAME] lblCaption
[PARENT] cnttabmenu
[START PROPERTIES]
FontName = "Segoe UI"
FontSize = 10
Alignment = 2
BackStyle = 0
Caption = "Label1"
Height = 17
Left = 99
Top = 6
Width = 40
ForeColor = 21,66,139
Name = "lblCaption"
[END PROPERTIES]