tabmenu.vca

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

SCCTEXT Version 4.0.0.2
PLATFORM C(8,0),UNIQUEID C(10,0),TIMESTAMP N(10,0),CLASS M(4,0),CLASSLOC M(4,0),BASECLASS M(4,0),OBJNAME M(4,0),PARENT M(4,0),PROPERTIES M(4,0),PROTECTED M(4,0),METHODS M(4,0),OBJCODE M(4,0),OLE M(4,0),OLE2 M(4,0),RESERVED1 M(4,0),RESERVED2 M(4,0),RESERVED3 M(4,0),RESERVED4 M(4,0),RESERVED5 M(4,0),RESERVED6 M(4,0),RESERVED7 M(4,0),RESERVED8 M(4,0),USER M(4,0)
1252

[ RECORD]
[PLATFORM] COMMENT 
[UNIQUEID] Class     
[START RESERVED1]
VERSION =   3.00[END RESERVED1]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX0XK18Y
[CLASS] container
[BASECLASS] container
[OBJNAME] cnttabmenu
[START PROPERTIES]
Anchor = 11
Width = 390
Height = 142
BorderWidth = 0
BackColor = 221,234,251
BorderColor = 59,90,130
itemcount = ( 0)
ofrmstartmenu = ( .NULL.)
lshowhelp = ( .t.)
lshowmain = ( .t.)
ccaption = ( "")
ltitlebar = ( .t.)
lshowquickbar = ( .t.)
lshowhotkeys = .F.
nselecteditem = ( 0)
lshowsearch = ( .t.)
noldproc = ( 0)
cfrmstartclass = ( "frmStartMenu")
lctrldown = .F.
osubmenu = ( .NULL.)
nmousex = ( 0)
nmousey = ( 0)
omainform = ( .NULL.)
lallowresize = ( .f.)
nmaxitempos = ( 0)
cbasefont = ( "Segoe UI")
orightclick = ( .NULL.)
lminimized = .F.
Name = "cnttabmenu"
[END PROPERTIES]
[START PROTECTED]
lctrldown
[END PROTECTED]
[START METHODS]
PROCEDURE Destroy
***************************************************************************
*$METHOD$ Destroy()
*$CREATED$ 17/02/2007
*
*$HISTORY$
*  18/03/2007 - GZ: Added code to clean up contained objects
*$HISTORY$
***************************************************************************
UNBINDEVENTS(this)

this.omainform     = .NULL.
this.oRightClick   = .NULL.
this.ofrmStartmenu = .NULL.
this.osubmenu      = .NULL.

IF VARTYPE(_SCREEN.oTabMenuHandler) = "O"
  *-- the tab menu handler object exists on the _SCREEN object so when
  * we get rid of the tabmenu we should also get rid of the handler
  * object
  UNBINDEVENTS(_SCREEN.oTabMenuHandler)
  _SCREEN.oTabMenuHandler = .NULL.
  REMOVEPROPERTY(_SCREEN, "oTabMenuHandler")
ENDIF

IF VARTYPE(_SCREEN.oTabMenu) <> "U"
  *-- the tab menu property exists on the _SCREEN object so when we get
  * rid of the tabmenu we should also get rid of the property
  _SCREEN.oTabMenu = .NULL.
  REMOVEPROPERTY(_SCREEN, "oTabMenu")
ENDIF

IF VARTYPE(_SCREEN.oToolbar) <> "U"
  *-- the toolbar property exists on the _SCREEN object so when we get
  * rid of the tabmenu we should also get rid of the property
  _SCREEN.oToolbar = .NULL.
  REMOVEPROPERTY(_SCREEN, "oToolbar")
ENDIF
ENDPROC
PROCEDURE Init
*************************************************************************
*$METHOD$ Init()
*$CREATED$ 11/02/2007
*
*$HISTORY$
*  18/03/2007 - GZ: Added a property that can be used for context menus
*$HISTORY$
*************************************************************************
LOCAL loRightClick

this.BackColor = RGB(221,234,251)

IF this.lTitlebar
  this.imgTitleBar.Left = 0
  this.imgTitleBar.Top = 0
  this.imgTitleBar.Width = this.width
  this.imgTitleBar.Visible = .t.

  this.lblCapTION.Visible = .f.
  this.lblCaption.Width = this.Width
  this.lblCaption.Top = INT((this.imgTitleBar.Height - this.lblCapTION.Height) / 2)
  this.lblCapTION.Left = 0

  this.cntcontrol.Top = 0
  this.cntcontrol.Left = this.Width - this.cntcontrol.width
  this.cntcontrol.nWindowstate = 0
ELSE
  this.lblCapTION.Visible = .f.
  this.imgTitleBar.Visible = .f.
  this.cntcontrol.Visible = .f.
ENDIF

this.imgTabStrip.Top = IIF(this.lTitleBar, this.imgTitleBar.Height, 0)
this.imgTabStrip.Width = this.Width

this.shpPopup.Top = IIF(this.lTitlebar, this.imgTitleBar.Height, 0) + this.imgTabStrip.Height + 2
this.shpPopup.Width = this.Width - (this.shpPopup.Left * 2)
this.shpPopup.height = this.Height - this.shpPopup.Top

this.pgfPopups.Height = this.shpPopup.Height - 2
this.pgfPopups.Top = this.shpPopup.Top + 1
this.pgfPopups.Width = this.shpPopup.Width - 2
this.pgfPopups.Left = this.shpPopup.Left + 1

IF this.lShowhelp
  this.cntHelpItem.Left = this.Width - this.cntHelpItem.Width - 3
  IF this.lTitlebar
    this.cntHelpItem.Top = this.imgTitleBar.Height + 3
  ELSE
    this.cntHelpItem.Top = 3
  ENDIF
ELSE
  this.cntHelpItem.Visible = .f.
ENDIF

IF this.lShowSearch
  this.cntSearchBox.Left = this.Width - (IIF(this.lShowHelp, this.cntHelpItem.Width, 0) + this.cntSearchBox.Width + 2)
  IF this.lTitleBar
    this.cntSearchBox.Top = this.imgTitleBar.Height + 3
  ELSE
    this.cntSearchBox.Top = 3
  ENDIF
ELSE
  this.cntSearchBox.Visible = .f.
ENDIF

IF this.lShowMain
  this.cntMainitem.Left = 0
  this.cntMainitem.Top = 0
  this.cntQuickBar.Left = this.cntMainItem.Width - 5
ELSE
  this.imgMainitem.Visible = .f.
  this.cntQuickBar.Left = 2
ENDIF

this.cntQuickBar.Top = 0

IF NOT this.lShowQuickbar
  this.cntQuickBar.Visible = .f.
ENDIF

*-- Create a dummy menu item object for use with any context menus that might be required
loRightClick = CREATEOBJECT("empty")

ADDPROPERTY(loRightClick, "lSelected", .f.)
ADDPROPERTY(loRightClick, "Top", 0)
ADDPROPERTY(loRightClick, "Left", 0)
ADDPROPERTY(loRightClick, "Height", 0)
ADDPROPERTY(loRightClick, "BaseClass", "empty")
ADDPROPERTY(loRightClick, "Parent", this)

this.oRightClick = loRightClick
ENDPROC
PROCEDURE Refresh
*************************************************************************
*$METHOD$ Refresh()
*$CREATED$ 11/02/2007
*************************************************************************
LOCAL lnCount, lcItemName, lnLeft, lcPrevItem

lnLeft = IIF(this.lShowMain, 45, 5)

this.nMaxItemPos = 0

FOR lnCount = 1 TO this.ItemCount
  lcPrevItem = lcItemName
  lcItemName = "MenuItem" + STRTRAN(STR(lnCount,3,0), " ", "0")
  IF lnCount > 1
    lnLeft = this.&lcPrevItem..Left + this.&lcPrevItem..Width
  ENDIF
  WITH this.&lcItemName.
    .Refresh()
    .Left = lnLeft
    .Top = IIF(this.ltitlebar, this.imgTitleBar.Height, 0)
    IF .Left + .Width > this.nMaxitempos
      *-- Determine the position of the rightmost item
      this.nMaxItemPos = .Left + .Width
    ENDIF
  ENDWITH
NEXT
ENDPROC
PROCEDURE Resize
**************************************************************************
*$METHOD$ Resize()
*$CREATED$ 11/02/2007
**************************************************************************
IF this.lTitlebar
  this.imgTitleBar.Top = 0
  this.imgTitleBar.Left = 0
  this.imgTitleBar.Width = this.width
ENDIF

this.cntControl.Left = this.Width - this.cntcontrol.Width
this.cntControl.Top = 0

this.lblCaption.Width = this.Width

this.imgTabStrip.Top = IIF(this.lTitleBar, this.imgTitleBar.Height, 0)
this.imgTabStrip.Width = this.Width
this.shpPopup.Top = IIF(this.lTitlebar, this.imgTitleBar.Height, 0) + this.imgTabStrip.Height + 2

IF VARTYPE(this.omainform) = "O"
  this.imgResize.Visible = .t.
ELSE
  this.imgResize.Visible = .f.
ENDIF
this.imgReSIZE.Left = this.Width - this.imgreSIZE.Width
this.imgResize.Top = this.Height - this.imgreSIZE.Height

this.shpPopup.Width = this.Width - (this.shpPopup.Left * 2)
this.shpPopup.height = this.Height - this.shpPopup.Top && - 2

this.pgfPopups.Height = this.shpPopup.Height - 2
this.pgfPopups.Top = this.shpPopup.Top + 1
this.pgfPopups.Width = this.shpPopup.Width - 2
this.pgfPopups.Left = this.shpPopup.Left + 1

this.cntHelpItem.Left = MAX(this.nMaxItemPos, this.Width - this.cntHelpItem.Width - 3)
this.cntHelpItem.Top = IIF(this.lTitleBar, this.imgTitleBar.Height + 3, 3)

IF this.lShowSearch
  this.cntSearchBox.Left = this.Width - (IIF(this.lShowHelp, this.cntHelpItem.Width, 0) + this.cntSearchBox.Width + 2)
  IF this.lTitleBar
    this.cntSearchBox.Top = this.imgTitleBar.Height + 3
  ELSE
    this.cntSearchBox.Top = 3
  ENDIF
  IF this.cntSearchBox.Left < this.nMaxitempos
    *-- If we have shrunk the screen to the extent that things
    * start to overlap then make them invisible
    this.cntsearchbox.Visible = .f.
  ELSE
    this.cntsearchbox.Visible = .t.
  ENDIF
ELSE
  this.cntSearchBox.Visible = .f.
ENDIF

ENDPROC
PROCEDURE RightClick
*************************************************************************
*$METHOD$ RightClick()
*$CREATED$ 18/03/2007
*************************************************************************
LOCAL loSubMenu, loItem

this.osubmenu      = .NULL.
this.ofrmstartmenu = .NULL.

IF VARTYPE(this.oMainform) = "O"
  this.oRightClick.Top = MROW(this.oMainform.Name,3)
  this.oRightClick.Left = MCOL(this.oMainform.Name,3)
ELSE
  this.oRightClick.Top = MROW("",3)
  this.oRightClick.Left = MCOL("",3)
ENDIF

*-- Create the submenu popup form and size it according to the current
* display settings
loSubmenu = CREATEOBJECT("frmPopup",this.oRightClick,this)
loSubMenu.nPopupStyle = 1
loSubMenu.Width  = 200
IF this.lTitlebar
  loSubMenu.Height = 50
ELSE
  loSubMenu.Height = 25
ENDIF
loSubMenu.Resize()

*-- Add the options, if there is not titlebar then the quickbar will not
* be shown.  If there is a titlebar allow the user to show or hide the
* quickbar.
IF this.lTitleBar
  loItem = loSubMenu.cntPopupItems.AddPopupItem("Show Quick Access Bar","NORM","S")
  IF this.lshowquickbar
    loItem.cMarkExp = ".t."
  ELSE
    loItem.cMarkExp = ".f."
  ENDIF
  BINDEVENT(loItem, "Execute", this, "ToggleQuickBar")
ENDIF

*-- Provide the option to allow the user to minimize the ribbon.
loItem = loSubMenu.cntPopupItems.AddPopupItem("Minimize the Ribbon","NORM","N")
IF this.lMinimized
  loItem.cMarkExp = ".t."
ELSE
  loItem.cMarkExp = ".f."
ENDIF
BINDEVENT(loItem, "Execute", this, "ToggleMinimize")

loSubMenu.Show()

this.oSubMenu = loSubMenu
ENDPROC
PROCEDURE addmenuitem
****************************************************************************
*$METHOD$ AddMenuItem()
*$CREATED$ 01/02/2007
****************************************************************************
LPARAMETERS vcCaption, vcHotKey

LOCAL lcItemName, lnLeft, lcPrevItem

lcPrevItem = "MenuItem" + STRTRAN(STR(this.ItemCount,3,0), " ", "0")
this.Itemcount = this.Itemcount + 1
lcItemName = "MenuItem" + STRTRAN(STR(this.ItemCount,3,0), " ", "0")
this.AddObject(lcItemName, "cntMenuItem", vcCaption)

lnLeft = IIF(this.lShowMain, 45, 5)
IF this.ItemCount > 1
  lnLeft = this.&lcPrevItem..Left + this.&lcPrevItem..Width
ENDIF

WITH this.&lcItemName.
  .Top = IIF(this.ltitlebar, this.imgTitleBar.Height, 0)
  .Left = lnLeft
  .cHotKey = IIF(EMPTY(vcHotKey),"",vcHotKey)
  .ItemIndex = this.Itemcount
  .cBaseFont = this.cBasefont
  .Visible = .t.
ENDWITH

this.pgfPopups.PageCount = this.Itemcount
this.pgfPopups.Pages(this.Itemcount).BackColor = this.shpPopup.BackColor
this.pgfPopups.Pages(this.Itemcount).BackStyle = 0
this.pgfPopups.Pages(this.Itemcount).AddProperty("ItemCount", 0)

RETURN this.&lcItemName.
ENDPROC
PROCEDURE addpopup
*************************************************************************
*$METHOD$ AddPopup()
*$CREATED$ 01/02/2007
*************************************************************************
LPARAMETERS vcCaption, vnItemIndex

LOCAL lcPopupItem, loPage, lnLeft, lcPrevPopup

lnLeft = 2
loPage = this.pgfPopups.Pages(vnItemIndex)
WITH loPage
  lcPrevPopup = "PopupMenu" + STRTRAN(STR(.ItemCount,3,0)," ","0")
  .ItemCount = .ItemCount + 1
  lcPopupItem = "PopupMenu" + STRTRAN(STR(.ItemCount,3,0)," ","0")
  .AddObject(lcPopupItem, "cntPopupMenu")

  IF .ItemCount > 1
    lnLeft = loPage.&lcPrevPopup..Left + loPage.&lcPrevPopup..Width + 2
  ENDIF

  WITH .&lcPopupItem.
    .Height    = loPage.Parent.height - 4
    .top       = 2
    .left      = lnLeft
    .Caption   = vcCaption
    .cBaseFont = this.cBasefont
    .Visible   = .t.
  ENDWITH
ENDWITH

RETURN loPage.&lcPopupItem.

ENDPROC
PROCEDURE appmaximize
************************************************************************
*$METHOD$ AppMaximize()
*$CREATED$ 27/02/2007
************************************************************************
this.cntCONTROL.nwindowstate = 2
ENDPROC
PROCEDURE appminimize
************************************************************************
*$METHOD$ AppMinimize()
*$CREATED$ 27/02/2007
************************************************************************
this.cntCONTROL.nwindowstate = 1
ENDPROC
PROCEDURE apprestore
************************************************************************
*$METHOD$ AppRestore()
*$CREATED$ 27/02/2007
************************************************************************
this.cntCONTROL.nwindowstate = 0
ENDPROC
PROCEDURE cbasefont_assign
*************************************************************************
*$METHOD$ cBaseFont_Assign()
*$CREATED$ 09/03/2007
*************************************************************************
LPARAMETERS vcNewVal

THIS.cBaseFont = m.vcNewVal
this.lblCaption.FontName = this.cBasefont
this.cntMainItem.cBaseFont = this.cBasefont

ENDPROC
PROCEDURE ccaption_assign
************************************************************************
*$METHOD$ cCaption_assign()
*$CREATED$ 07/02/2007
************************************************************************
LPARAMETERS vcNewVal

THIS.cCaption = m.vcNewVal

IF EMPTY(this.cCaption)
  this.lblCaption.Visible = .f.
  this.lblCapTION.Caption = ""
ELSE
  this.lblCapTION.Caption = vcNewVal
  this.lblCapTION.Visible = this.ltitlebar
ENDIF
ENDPROC
PROCEDURE lallowresize_assign
**************************************************************************
*$METHOD$ lAllowResize_Assign()
*$CREATED$ 27/02/2007
**************************************************************************
LPARAMETERS vlNewVal

THIS.lAllowResize = m.vlNewVal
IF VARTYPE(this.omainform) = "O"
  this.imgResize.Visible = m.vlNewVal
ELSE
  this.imgResize.Visible = .f.
ENDIF

ENDPROC
PROCEDURE lminimized_assign
*************************************************************************
*$METHOD$ lMinimized_assign()
*$CREATED$ 18/03/2007
*************************************************************************
LPARAMETERS vlNewVal

THIS.lMinimized = m.vlNewVal

ENDPROC
PROCEDURE lshowhelp_assign
LPARAMETERS vlNewVal

THIS.lshowhelp = m.vlNewVal
this.cntHelpItem.Visible = this.lShowHelp

ENDPROC
PROCEDURE lshowhotkeys_assign
LPARAMETERS vlNewVal

THIS.lShowHotkeys = m.vlNewVal

this.cntMAINITEM.lshowhotkey = THIS.lShowHotkeys
this.cntQUICKBAR.lshowhotkeys = THIS.lShowHotkeys

LOCAL lnCount, lcItemName

FOR lnCount = 1 TO this.ItemCount
  lcItemName = "MenuItem" + STRTRAN(STR(lnCount,3,0), " ", "0")
  WITH this.&lcItemName.
    .lShowHotKey = THIS.lShowHotkeys
  ENDWITH
NEXT

IF this.pgfPopups.PageCount > 0 AND this.nSelecteditem > 0
  WITH this.pgfPopups.Pages(this.nSelectedItem)
    FOR lnCount = 1 TO .ControlCount
      .Controls(lnCount).lShowHotKeys = this.lShowHotkeys
    NEXT
  ENDWITH
ENDIF

IF VARTYPE(this.ofrmstartmenu) = "O"
  this.oFrmstartmenu.lShowHotKeys = this.lShowHotkeys
ENDIF

IF VARTYPE(this.osubmenu) = "O"
  this.osubmenu.lShowHotKeys = this.lShowHotkeys
ENDIF
ENDPROC
PROCEDURE lshowquickbar_assign
****************************************************************************