tabmenu.vca

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

[START METHODS]
PROCEDURE DblClick
*************************************************************************
*$METHOD$ DblClick()
*$CREATED$ 19/03/2007
*************************************************************************
IF this.Parent.ltitlebar
  RAISEEVENT(this.Parent.cntcontrol.cmdmaximize, "Click")
ENDIF

ENDPROC
PROCEDURE MouseDown
*************************************************************************
*$METHOD$ MouseDown()
*$CREATED$ 27/02/2007
*
*$HISTORY$
*  17/03/2007 - GZ: Fixed an issue where it was possible to move the
*  main wondow while the popup form or the start menu form where still
*  visible.  The method now clears any active popups as soon as the mouse
*  is clicked.
*$HISTORY$
*************************************************************************
LPARAMETERS nButton, nShift, nXCoord, nYCoord

IF nButton = 1
  this.Parent.nMouseX = m.nXCoord
  this.Parent.nMouseY = m.nYCoord

  this.Parent.ofrmstartmenu = .NULL.
  this.Parent.osubmenu = .NULL.
ENDIF
ENDPROC
PROCEDURE MouseMove
*************************************************************************
*$METHOD$ MouseMove()
*$CREATED$ 27/02/2007
*
*$PURPOSE$
*  This method allows the fake titlebar  to behave like a real title
*  bar and move the form, but it will only happen if the toolbar is
*  contained within a top level form and not the VFP screen
*$PURPOSE$
*************************************************************************
LPARAMETERS nButton, nShift, nXCoord, nYCoord

LOCAL lnDiffX, lnDiffY

IF m.nButton = 1
  IF (this.parent.nMouseX <> 0 OR this.parent.nMouseY <> 0)
    lnDiffX = m.nXCoord - this.parent.nMouseX
    lnDiffY = m.nYCoord - this.parent.nMouseY
    IF VARTYPE(this.Parent.oMainform) = "O"
      WITH this.Parent.oMainform
        .Move(.Left + m.lnDiffX, .Top + m.lnDiffY, .Width, .Height)
      ENDWITH
    ELSE
      WITH _SCREEN
        IF this.Parent.Parent.docked
          .Move(.Left + m.lnDiffX, .Top + m.lnDiffY - this.Parent.Parent.Height, .Width, .Height)
        ELSE
          .Move(.Left + m.lnDiffX, .Top + m.lnDiffY, .Width, .Height)
        ENDIF
      ENDWITH
    ENDIF
    this.MouseDown(m.nButton, m.nShift, m.nXCoord - m.lnDiffX, m.nYCoord - m.lnDiffY)
  ENDIF
ENDIF
ENDPROC
PROCEDURE MouseUp
*************************************************************************
*$METHOD$ MouseUp()
*$CREATED$ 27/02/2007
*************************************************************************
LPARAMETERS nButton, nShift, nXCoord, nYCoord

IF nButton = 1
  this.Parent.nMouseX = 0
  this.Parent.nMouseY = 0
ENDIF
ENDPROC
[END METHODS]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _2080THKLV
[CLASS] cntquickbar
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] Cntquickbar
[PARENT] cnttabmenu
[START PROPERTIES]
Top = 23
Left = 20
Visible = .F.
Name = "Cntquickbar"
imgLeft.Height = 24
imgLeft.Width = 18
imgLeft.Name = "imgLeft"
imgRight.Height = 24
imgRight.Width = 15
imgRight.Name = "imgRight"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20B0GRS3L
[CLASS] cntcontrol
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] Cntcontrol
[PARENT] cnttabmenu
[START PROPERTIES]
Top = 0
Left = 240
Name = "Cntcontrol"
imgControl.Height = 18
imgControl.Width = 95
imgControl.Name = "imgControl"
cmdMinimize.Name = "cmdMinimize"
cmdMaximize.Name = "cmdMaximize"
cmdClose.Name = "cmdClose"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20E0NUFXP
[CLASS] cntstartitem
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] cntMainItem
[PARENT] cnttabmenu
[START PROPERTIES]
Top = 0
Left = 12
Name = "cntMainItem"
Imgmainitem.Height = 38
Imgmainitem.Width = 38
Imgmainitem.Name = "Imgmainitem"
cmdStartItem.Name = "cmdStartItem"
imgHotKey.Height = 15
imgHotKey.Width = 16
imgHotKey.Name = "imgHotKey"
lblHotKey.Name = "lblHotKey"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20I0IJKN3
[CLASS] cntsearchbox
[CLASSLOC] tabmenu.vcx
[BASECLASS] container
[OBJNAME] cntSearchBox
[PARENT] cnttabmenu
[START PROPERTIES]
Top = 36
Left = 180
Name = "cntSearchBox"
imgBack.Name = "imgBack"
txtSearch.Name = "txtSearch"
imgSearch.Height = 20
imgSearch.Width = 13
imgSearch.Name = "imgSearch"
imgLeft.Height = 21
imgLeft.Width = 3
imgLeft.Name = "imgLeft"
imgRight.Height = 21
imgRight.Width = 3
imgRight.Name = "imgRight"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _20Z1D7O4R
[CLASS] image
[BASECLASS] image
[OBJNAME] imgResize
[PARENT] cnttabmenu
[START PROPERTIES]
Picture = images\resize.bmp
BackStyle = 0
Height = 11
Left = 369
MousePointer = 9
Top = 121
Width = 11
Name = "imgResize"
[END PROPERTIES]
[START METHODS]
PROCEDURE MouseDown
*************************************************************************
*$METHOD$ MouseDown()
*$CREATED$ 27/02/2007
*************************************************************************
LPARAMETERS nButton, nShift, nXCoord, nYCoord

IF nButton = 1
  this.Parent.nMouseX = m.nXCoord
  this.Parent.nMouseY = m.nYCoord
ENDIF
ENDPROC
PROCEDURE MouseMove
*************************************************************************
*$METHOD$ MouseMove()
*$CREATED$ 27/02/2007
*************************************************************************
LPARAMETERS nButton, nShift, nXCoord, nYCoord

LOCAL lnDiffX &&, lnDiffY

IF m.nButton = 1
  IF (this.parent.nMouseX <> 0 OR this.parent.nMouseY <> 0)
    lnDiffX = m.nXCoord - this.parent.nMouseX
*    lnDiffY = m.nYCoord - this.parent.nMouseY
    IF VARTYPE(this.Parent.oMainform) = "O"
      WITH this.Parent.oMainform
        .Width = .Width + m.lnDiffX
      ENDWITH
    ENDIF
    this.Parent.nMouseX = m.nXCoord
*    this.Parent.nMouseY = m.nYCoord
  ENDIF
ENDIF
ENDPROC
PROCEDURE MouseUp
*************************************************************************
*$METHOD$ MouseUp()
*$CREATED$ 27/02/2007
*************************************************************************
LPARAMETERS nButton, nShift, nXCoord, nYCoord

IF nButton = 1
  this.Parent.nMouseX = 0
  this.Parent.nMouseY = 0
ENDIF
ENDPROC
[END METHODS]

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

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX0Y5UIT
[CLASS] container
[BASECLASS] container
[OBJNAME] cntmenuitem
[START PROPERTIES]
Width = 200
Height = 28
Picture = images\tabstrip.bmp
BorderWidth = 0
caption = ("")
selected = .F.
itemindex = ( 0)
chotkey = ( "")
lshowhotkey = .F.
cskipforexp = ( "")
citemkey = ( "")
cbasefont = ( "")
Name = "cntmenuitem"
[END PROPERTIES]
[START METHODS]
PROCEDURE Click
****************************************************************************
*$METHOD$ Click()
*$CREATED$ 10/02/2007
****************************************************************************
IF this.Enabled
  this.Parent.SelectMenuItem(this.ItemIndex)
ENDIF
ENDPROC
PROCEDURE Destroy
***************************************************************************
*$METHOD$ Destroy()
*$CREATED$ 17/02/2007
***************************************************************************
UNBINDEVENTS(this)
ENDPROC
PROCEDURE Init
LPARAMETERS vcCaption

this.Caption = vcCaption

this.imgHotKey.Top = this.Height - this.imgHotKey.Height
this.imgHotkey.Left = this.Width - this.imgHotKey.Width
this.lblHotKey.Top = this.imgHotKey.Top
this.lblHotKey.Left = this.imgHotkey.Left
this.lblHotkey.Width = this.imghotkey.width

ENDPROC
PROCEDURE MouseEnter
LPARAMETERS nButton, nShift, nXCoord, nYCoord

this.HotTrackon()
ENDPROC
PROCEDURE MouseLeave
LPARAMETERS nButton, nShift, nXCoord, nYCoord

this.Hottrackoff()
ENDPROC
PROCEDURE Refresh
this.Width = this.lblCaption.Width + 12

IF NOT EMPTY(this.cSkipforexp)
  this.Enabled = NOT EVALUATE(this.cSkipforexp)
ENDIF
ENDPROC
PROCEDURE Resize
this.imgRight.Left = this.Width - this.imgRight.Width
this.cmdMenuItem.Width = this.width - 7

this.imgHotKey.Top = this.Height - this.imgHotKey.Height
this.imgHotkey.Left = this.Width - this.imgHotKey.Width
this.lblHotKey.Top = this.imgHotKey.Top
this.lblHotKey.Left = this.imgHotkey.Left
this.lblHotkey.Width = this.imghotkey.width

ENDPROC
PROCEDURE caption_assign
LPARAMETERS vcNewVal

THIS.caption = m.vcNewVal
this.lblCaption.Caption = this.Caption
this.cmdMenuItem.Caption = this.Caption
this.lblCaption.Visible = .t.
this.lblCaption.Left = 6
this.Width = this.lblCaption.Width + 12
ENDPROC
PROCEDURE cbasefont_assign
*************************************************************************
*$METHOD$ cBaseFont_Assign()
*$CREATED$ 03/07/2007
*************************************************************************
LPARAMETERS vcNewVal

THIS.cBaseFont = m.vcNewVal

this.lblCaption.FontName = this.cBaseFont
this.lblHotKey.FontName = this.cBaseFont

ENDPROC
PROCEDURE chotkey_assign
LPARAMETERS vcNewVal

THIS.chotkey = m.vcNewVal
this.lblHotKey.Caption = this.cHotkey

ENDPROC
PROCEDURE cskipforexp_assign
****************************************************************************
*$METHOD$ cSkipForExp_assign()
*$CREATED$ 13/02/2007
****************************************************************************
LPARAMETERS vcNewVal

THIS.cSkipForExp = m.vcNewVal

ENDPROC
PROCEDURE enabled_assign
****************************************************************************
*$METHOD$ enabled_assign()
*$CREATED$ 13/02/2007
****************************************************************************
LPARAMETERS vlNewVal

this.enabled = m.vlNewVal

IF this.Enabled
  this.lblCaption.ForeColor = RGB(21,66,139)
ELSE
  this.lblCaption.ForeColor = RGB(141,141,141)
ENDIF

ENDPROC
PROCEDURE hottrackoff
IF NOT this.Selected
  this.imgLeft.Picture = 'tabLEFT.BMP'
  this.imgLeft.Visible = .f.
  this.Picture = 'TABSTRIP.BMP'
  this.imgRight.Picture = 'tabseparator.BMP'
ENDIF
ENDPROC
PROCEDURE hottrackon
IF this.Enabled AND NOT this.Selected
  this.imgLeft.Picture = 'HOVLEFT.BMP'
  this.imgLeft.Visible = .t.
  this.Picture = 'HOVMENU.BMP'
  this.imgRight.Picture = 'HOVRIGHT.BMP'
ENDIF
ENDPROC
PROCEDURE lshowhotkey_assign
LPARAMETERS vlNewVal

THIS.lShowHotKey = m.vlNewVal AND this.Enabled

this.lblHotKey.Visible = this.lshowhotkey AND NOT EMPTY(this.chotkey)
this.imgHotKey.Visible = this.lshowhotkey AND NOT EMPTY(this.chotkey)

ENDPROC
PROCEDURE selected_assign
LPARAMETERS vlNewVal

THIS.Selected = m.vlNewVal

IF m.vlNewVal
  this.picture = "tabmenu.bmp"
  this.imgLeft.Picture = 'TABLEFT.BMP'
  this.imgLeft.Visible = .t.
  this.imgRight.Picture = 'TABRIGHT.BMP'
ELSE
  this.Picture = 'TABSTRIP.BMP'
  this.imgLeft.Visible = .f.
  this.imgRight.Picture = 'TABSEPARATOR.BMP'
ENDIF
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
7[END RESERVED2]
[START RESERVED3]
caption Specifies the text displayed in an object's caption.
selected Specifies if an item is selected in a ComboBox or ListBox control.
itemindex
chotkey
lshowhotkey
cskipforexp
citemkey
cbasefont
*caption_assign 
*selected_assign 
*hottrackon 
*hottrackoff 
*chotkey_assign 
*lshowhotkey_assign 
*cskipforexp_assign 
*enabled_assign 
*cbasefont_assign 
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX0YEC5M
[CLASS] image
[BASECLASS] image
[OBJNAME] imgLeft
[PARENT] cntmenuitem
[START PROPERTIES]
Picture = images\tableft.bmp
Height = 28
Left = 0
Top = 0
Visible = .F.
Width = 4
Name = "imgLeft"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX0YEC5N
[CLASS] image
[BASECLASS] image
[OBJNAME] imgRight
[PARENT] cntmenuitem
[START PROPERTIES]
Picture = images\tabseparator.bmp
Height = 28
Left = 144
Top = 0
Width = 5
Name = "imgRight"
[END PROPERTIES]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX0YEC5O
[CLASS] label
[BASECLASS] label
[OBJNAME] lblCaption
[PARENT] cntmenuitem
[START PROPERTIES]
AutoSize = .T.
FontName = "Segoe UI"
BackStyle = 0
Caption = "Menu Item"
Height = 17
Left = 36
Top = 8
Width = 60
ForeColor = 21,66,139
Name = "lblCaption"
[END PROPERTIES]
[START METHODS]
PROCEDURE Click
RAISEEVENT(this.Parent,"Click")
ENDPROC
[END METHODS]

[ RECORD]
[PLATFORM] WINDOWS 
[UNIQUEID] _1ZX1BH80E
[CLASS] commandbutton
[BASECLASS] commandbutton