tabmenu.vca

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

thisform.cntMenuItems.shpShadow.Left = thisform.cntMenuItems.cntSubMenu.Left + 2
thisform.cntMenuItems.shpShadow.Width = thisform.cntMenuItems.cntSubMenu.Width
thisform.cntMenuItems.shpShadow.Height = thisform.cntMenuItems.cntSubMenu.Height

thisform.cntMenuItems.cntQuickMenu.Top = 0
thisform.cntMenuItems.cntQuickMenu.Left = 0
thisform.cntMenuItems.cntQuickMenu.Height = this.cntMenuItems.Height
thisform.cntMenuItems.cntQuickMenu.Width = this.cntMenuItems.Width - this.cntMenuItems.cntRecentItems.Width

ENDPROC
PROCEDURE cbasefont_assign
*************************************************************************
*$METHOD$ cBaseFont_assign()
*$CREATED$ 09/03/2007
*************************************************************************
LPARAMETERS vcNewVal

DODEFAULT(vcNewVal)
this.cnTMENUITEMS.cnTQUICKMENU.cBasefont = this.cBasefont
this.cnTMENUITEMS.cnTRECENTITEMS.cBasefont = this.cBasefont
this.cnTMENUITEMS.cnTSUBMENU.cBasefont = this.cBaseFont

ENDPROC
PROCEDURE cmdCancel.Click
**********************************************************************
*$METHOD$ Click()
*$CREATED$ 10/02/2007
**********************************************************************
IF thisform.cntMenuItems.cntSubMenu.Visible
  thisform.Hidesubmenu()
ELSE
  thisform.Release()
ENDIF
ENDPROC
PROCEDURE hidesubmenu
*************************************************************************
*$METHOD$ HideSubMenu()
*$CREATED$ 25/02/2007
*************************************************************************
IF thisform.cntMenuItems.cntsubMenu.Visible
  IF VARTYPE(thisform.oActiveItem) = "O"
    thisform.oActiveItem.lSelected = .f.
    thisform.oActiveItem = .NULL.
  ENDIF
  thisform.cntmenuItems.shpShadow.Visible = .f.
  thisform.cntmenuItems.cntsubMenu.Visible = .f.
  thisform.cntMenuItems.cntSubMenu.Deleteitems()
ENDIF
ENDPROC
PROCEDURE lshowhotkeys_assign
************************************************************************
*$METHOD$ lShowHotKeys_Assign()
*$CREATED$ 10/02/2007
************************************************************************
LPARAMETERS vlNewVal

THIS.lShowHotKeys = m.vlNewVal

this.cntMenuItems.cntRecentItems.lshowhotkeys = this.lShowhotkeys
this.cntMenuItems.cntQuickMenu.lshowhotkeys = this.lShowhotkeys
this.cntMenuItems.cntSubMenu.lshowhotkeys = this.lShowhotkeys

ENDPROC
PROCEDURE sendhotkey
************************************************************************
*$METHOD$ SendHotKey()
*$CREATED$ 12/02/2007
************************************************************************
LPARAMETERS vcHotKey

LOCAL llReturn

IF NOT llReturn
  llReturn = this.cntMenuItems.cntQuickMenu.SendHotKey(vcHotKey)
ENDIF

IF this.cntMenuItems.cntSubMenu.Visible AND NOT llReturn
  llReturn = this.cntMenuItems.cntSubmenu.SendHotKey(vcHotKey)
ENDIF

IF NOT llReturn
  llReturn = this.cntMenuItems.cntRecentItems.SendHotKey(vcHotKey)
ENDIF

RETURN llReturn

ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
16[END RESERVED2]
[START RESERVED3]
oactiveitem
*hidesubmenu 
*showsubmenu 
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20X0MZWCB
[CLASS] shape
[BASECLASS] shape
[OBJNAME] shpBackground
[PARENT] frmstartmenu
[START PROPERTIES]
Top = 0
Left = 36
Height = 17
Width = 100
BackStyle = 0
BorderColor = 138,175,225
Name = "shpBackground"
[END PROPERTIES]
[START METHODS]
PROCEDURE MouseMove
*******************************************************************************
*$METHOD$ MouseMove()
*$CREATED$ 25/02/2007
*******************************************************************************
LPARAMETERS nButton, nShift, nXCoord, nYCoord

thisform.Hidesubmenu()

ENDPROC
[END METHODS]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0FQEXD
[CLASS] shape
[BASECLASS] shape
[OBJNAME] shpLeft
[PARENT] frmstartmenu
[START PROPERTIES]
Top = 72
Left = 357
Height = 17
Width = 13
BorderStyle = 0
BorderWidth = 0
BackColor = 0,255,0
Name = "shpLeft"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20S0NL96V
[CLASS] shape
[BASECLASS] shape
[OBJNAME] shpbottom
[PARENT] frmstartmenu
[START PROPERTIES]
Top = 106
Left = 356
Height = 17
Width = 13
BorderStyle = 0
BorderWidth = 0
BackColor = 0,255,0
Name = "shpbottom"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0ULTWG
[CLASS] commandbutton
[BASECLASS] commandbutton
[OBJNAME] cmdExit
[PARENT] frmstartmenu
[START PROPERTIES]
Top = 220
Left = 279
Height = 20
Width = 84
FontName = "Segoe UI"
Caption = "Exit"
Name = "cmdExit"
[END PROPERTIES]
[START METHODS]
PROCEDURE Click
RAISEEVENT(thisform.oTabmenu, "AppExit")
thisform.Release()

ENDPROC
[END METHODS]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX0Y5UIT
[CLASS] container
[BASECLASS] container
[OBJNAME] cntMenuItems
[PARENT] frmstartmenu
[START PROPERTIES]
Top = 12
Left = 0
Width = 348
Height = 200
BorderColor = 138,175,225
Name = "cntMenuItems"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0LXFWC
[CLASS] cntpopupmenu
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] cntRecentItems
[PARENT] frmstartmenu.cntMenuItems
[START PROPERTIES]
Top = 0
Left = 144
BackColor = 233,234,238
alignment = ( 0)
topcaption = ( .t.)
Name = "cntRecentItems"
lblCaption.Name = "lblCaption"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0NL84H
[CLASS] cntpopupmenu
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] cntQuickMenu
[PARENT] frmstartmenu.cntMenuItems
[START PROPERTIES]
Top = 0
Left = 0
Width = 145
Height = 200
BackColor = 255,255,255
Name = "cntQuickMenu"
lblCaption.Name = "lblCaption"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20V0OCMXD
[CLASS] shape
[BASECLASS] shape
[OBJNAME] shpShadow
[PARENT] frmstartmenu.cntMenuItems
[START PROPERTIES]
Top = 24
Left = 240
Height = 17
Width = 100
BorderStyle = 0
BorderWidth = 0
Visible = .F.
BackColor = 192,192,192
Name = "shpShadow"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20V0OCMXE
[CLASS] cntpopupmenu
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] cntSubMenu
[PARENT] frmstartmenu.cntMenuItems
[START PROPERTIES]
Top = 6
Left = 156
Width = 175
Height = 175
Visible = .F.
BackColor = 255,255,255
topcaption = ( .t.)
Name = "cntSubMenu"
lblCaption.Caption = "SubMenu"
lblCaption.Name = "lblCaption"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20015KWUK
[CLASS] image
[BASECLASS] image
[OBJNAME] imgbottom
[PARENT] frmstartmenu
[START PROPERTIES]
Picture = images\shadbott.bmp
Stretch = 2
Height = 4
Left = 108
Top = 241
Width = 3
Name = "imgbottom"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20015RNMW
[CLASS] image
[BASECLASS] image
[OBJNAME] imgRight
[PARENT] frmstartmenu
[START PROPERTIES]
Picture = images\shadright.bmp
Stretch = 2
Height = 17
Left = 200
Top = 41
Width = 4
Name = "imgRight"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20016BDO6
[CLASS] image
[BASECLASS] image
[OBJNAME] imgtr
[PARENT] frmstartmenu
[START PROPERTIES]
Picture = images\shadtr.bmp
Height = 9
Left = 357
Top = 23
Width = 4
Name = "imgtr"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZZ0J2LMZ
[CLASS] image
[BASECLASS] image
[OBJNAME] imgLeft
[PARENT] frmstartmenu
[START PROPERTIES]
Picture = images\mainsel.png
BackStyle = 0
Height = 38
Left = -19
Top = -19
Width = 38
Name = "imgLeft"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0FQEXD
[CLASS] image
[BASECLASS] image
[OBJNAME] imgbr
[PARENT] frmstartmenu
[START PROPERTIES]
Picture = images\shadbr.bmp
Height = 4
Left = 360
Top = 78
Width = 4
Name = "imgbr"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20S0NPLX5
[CLASS] image
[BASECLASS] image
[OBJNAME] imgbl
[PARENT] frmstartmenu
[START PROPERTIES]
Picture = images\shadbl.bmp
Height = 4
Left = 357
Top = 112
Width = 8
Name = "imgbl"
[END PROPERTIES]

[ RECORD]
[PLATFORM] COMMENT 
[UNIQUEID] RESERVED  
[OBJNAME] frmstartmenu
[START PROPERTIES]
Segoe UI, 0, 9, 6, 15, 12, 22, 3, 0
Arial, 0, 9, 5, 15, 12, 32, 3, 0
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZY0KG7R9
[CLASS] container
[BASECLASS] container
[OBJNAME] cntpopupitem
[START PROPERTIES]
Width = 163
Height = 200
BackStyle = 0
BorderWidth = 0
BackColor = 219,230,244
caption = ( "")
itemindex = ( 0)
lselected = .F.
type = ( "")
alignment = ( 2)
lshowpin = .F.
lpinned = .F.
cpicture = ( "")
lshowhotkey = .F.
chotkey = ( "")
cskipforexp = ( "")
citemkey = ( "")
nshowsubmenu = ( 0)
lactive = .F.
cbasefont = ( "")
cmarkexp = ( "")
lmarked = .F.
Name = "cntpopupitem"
[END PROPERTIES]
[START METHODS]
PROCEDURE Destroy
***************************************************************************
*$METHOD$ Destroy()
*$CREATED$ 17/02/2007
***************************************************************************
UNBINDEVENTS(this)
ENDPROC
PROCEDURE Init
******************************************************************************
*$METHOD$ Init()
*$CREATED$ 01/02/2007
******************************************************************************
LPARAMETERS vcCaption, vcType, vnWidth

this.Type = vcType

this.Hottrackoff()

IF this.lShowpin
  this.imgPin.Visible = .t.
  this.cmdPin.Visible = .t.
ENDIF

IF this.nShowSubmenu > 0
  this.imgSubmenu.Visible = .t.
  this.cmdSubmenu.Visible = (this.nShowSubmenu = 2)
ENDIF

this.Caption = vcCaption
DO CASE
  CASE UPPER(vcType) = "NORM"
    this.Height = 21
    this.imgsubMenu.Picture   = "popupdn.bmp"
    this.imgsep.Picture       = "itemsep.bmp"
    this.imgback.Picture      = "itemback.bmp"
    this.imghighlight.Picture = "itemback.bmp"
    this.imgsubback.Picture   = "itemsubback.bmp"
    this.imgsubleft.Picture   = "itemsubleft.bmp"
  OTHERWISE
    this.Height = 44
    this.imgsubMenu.Picture   = "popuprt.bmp"
    this.imgsep.Picture       = "bitmsep.bmp"
    this.imgback.Picture      = "bitmback.bmp"
    this.imghighlight.Picture = "bitmback.bmp"
    this.imgsubback.Picture   = "bitmsubback.bmp"
    this.imgsubleft.Picture   = "bitmsubleft.bmp"
ENDCASE
this.Width = vnWidth
ENDPROC
PROCEDURE Refresh
************************************************************************
*$METHOD$ Refresh()
*$CREATED$ 13/02/2007
*
*$HISTORY$
*  12/03/2007 - GZ: Added support for the marked property
*  17/03/2007 - GZ: Fixed a bug resulting from a cut and paste
*$HISTORY$
************************************************************************
IF NOT EMPTY(this.cSkipforexp)
  this.Enabled = NOT EVALUATE(this.cSkipForExp)
ENDIF
IF NOT EMPTY(this.cMarkExp)
  this.lMarked = EVALUATE(this.cMarkexp)
ELSE
  this.lMarked = .f.
ENDIF
ENDPROC
PROCEDURE Resize
************************************************************************************
*$METHOD$ Resize()
*$CREATED$ 13/02/2007
*
*$HISTORY$
*  12/03/2007 - GZ: Added support for positioning the caption based on the
*  type of popup being used.
*  17/03/2007 - GZ: Added support for new imgMark control
*$HISTORY$
************************************************************************************
this.imgLeft.Top = 0
this.imgLeft.Left = 0
this.imgLeft.Height = this.Height

this.imgRight.Top = 0
this.imgRight.Left = this.Width - this.imgRight.Width
this.imgRight.Height = this.height

this.imgPin.Left = this.Width - this.imgPin.Width
this.imgPin.Top = 0

this.cmdPin.Left = thi