menutree.ctl

人事档案管理系统(PB)/人事工资管理系统/干部信息管理系统/投标报价与合同管理系统/... 超市...

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.UserControl MenuTree 
   Alignable       =   -1  'True
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   Begin VB.PictureBox picSplitter 
      BackColor       =   &H80000006&
      BorderStyle     =   0  'None
      Height          =   1215
      Left            =   3120
      MouseIcon       =   "MenuTree.ctx":0000
      ScaleHeight     =   1215
      ScaleWidth      =   75
      TabIndex        =   2
      Top             =   1080
      Visible         =   0   'False
      Width           =   75
   End
   Begin MSComctlLib.TreeView tvMenus 
      Height          =   3135
      Left            =   60
      TabIndex        =   1
      Top             =   330
      Width           =   2655
      _ExtentX        =   4683
      _ExtentY        =   5530
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   529
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.CommandButton cmdClose 
      Height          =   195
      Left            =   4530
      Picture         =   "MenuTree.ctx":0152
      Style           =   1  'Graphical
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   30
      Width           =   195
   End
   Begin VB.Image imgSplitter 
      Appearance      =   0  'Flat
      Height          =   1335
      Left            =   4200
      MouseIcon       =   "MenuTree.ctx":01CC
      MousePointer    =   99  'Custom
      Top             =   1170
      Width           =   75
   End
End
Attribute VB_Name = "MenuTree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private miSplitterLeftOffset As Integer
Private mbResizing As Boolean
Private m_MinHorizontalSize As Integer

Event CloseMe()
Event NodeClick(ByVal Node As MSComctlLib.Node)

Public Property Get MenuTreeView() As TreeView
    Set MenuTreeView = tvMenus
End Property

Private Sub cmdClose_Click()
    RaiseEvent CloseMe
End Sub


Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    'On the mouse down we need to display
    'the bar that gets dragged. To do that
    'We need to set the parent of the
    'picSplitter control.  This is required
    'mostly because of the single pane mode feature
    
    picSplitter.Visible = True
    miSplitterLeftOffset = CInt(x)
    mbResizing = True
    SetParent picSplitter.hwnd, UserControl.Parent.hwnd
    picSplitter.Top = UserControl.Extender.Top
    
End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim iNewPos As Integer
    
    'As the mouse moves we need to also move the
    'picSplitter control.  We need to contain
    'the splitter to the area of its parent control
    'and only allow it to show in valid areas.
    If mbResizing Then
        iNewPos = UserControl.Extender.Left + imgSplitter.Left + x - miSplitterLeftOffset
        If iNewPos < UserControl.Extender.Left + m_MinHorizontalSize Then
            picSplitter.Left = UserControl.Extender.Left + m_MinHorizontalSize
        ElseIf iNewPos > UserControl.Parent.width - 240 Then
            picSplitter.Left = UserControl.Parent.width - 240
        Else
            picSplitter.Left = iNewPos
        End If
    End If
End Sub

Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    'On the mouse up we need to move the splitter
    'to where the picSplitter is when the mouse
    'was released.
    picSplitter.Visible = False
    mbResizing = False
    
    UserControl.width = picSplitter.Left - UserControl.Extender.Left
    SetParent picSplitter.hwnd, UserControl.hwnd
    UserControl_Resize
End Sub

Private Sub tvMenus_NodeClick(ByVal Node As MSComctlLib.Node)
    RaiseEvent NodeClick(Node)
End Sub

Private Sub UserControl_Initialize()
    'ThinBorder UserControl.hwnd, False
End Sub

'This routine is just to make it looks nice
Private Sub UserControl_Paint()
    On Error Resume Next
    Dim hBr As Long, rc As RECT
    
    UserControl.ScaleMode = vbPixels
    
    UserControl.Cls
    
    GetClientRect UserControl.hwnd, rc
    Draw3dRect UserControl.hDC, rc, vbButtonShadow, &H80000014
    
    With rc
        .Left = 3
        .Top = 6
        .bottom = .Top + 3
        .right = UserControl.ScaleWidth - cmdClose.width - 1 - imgSplitter.width - 4
    End With
    
    Draw3dRect UserControl.hDC, rc, &H80000014, vbButtonShadow
    
    rc.Top = rc.bottom + 1
    rc.bottom = rc.Top + 3
    
    Draw3dRect UserControl.hDC, rc, &H80000014, vbButtonShadow
    
    UserControl.ScaleMode = vbTwips
End Sub

Private Sub UserControl_Resize()
    On Error Resume Next
    Dim lWidth As Long, lHeight As Long
    lWidth = UserControl.ScaleWidth
    lHeight = UserControl.ScaleHeight
    
    With imgSplitter
        .Move lWidth - .width, 0, .width, lHeight
        picSplitter.Move .Left, 0, .width, lHeight
    End With
    With cmdClose
        .Move lWidth - .width - 30 - imgSplitter.width, 60, .width, .height
        tvMenus.Move 60, .Top + .height + 30, _
            lWidth - 80 - imgSplitter.width, _
            lHeight - (.Top + .height + 100)
    End With
    
    picSplitter.ZOrder 0
End Sub