frmcodelib.frm

vb控件代码大全

'
'

'
' Private Members
'
Private moSettings As CSettings             ' Our Settings Object
Private mnDragNode As Node                  ' Node being Dragged
Private mDB As Database                     ' Our Database Object (DAO for now)
Private miClipBoardFormat As Integer        ' Our Custom Clipboard Format
Private mbSplitting As Boolean              ' Are we splitting ?
Private mbShowBookmarks As Boolean          ' Are we showing Bookmarks at present ?
Private msDBFileName As String              ' Current Database File Name
Private miScrollDir As Integer              ' Direction the TreeView is scrolling

Private Const DEFAULTDB = "VBCodeLib.mdb"   ' Default CodeLibrary Database Name
Private Const lVSplitLimit As Long = 1500   ' Splitter side limits

Private Sub ctlBookMarkList_BookMarkRemoved(ByVal sCodeID As String)
'
' Controls is telling us that a bookmark has been removed
'
' Update the gui as necessary
'
End Sub

Private Sub ctlBookMarkList_ViewBookMark(oCodeItem As IDataObject)
    Dim nNode As Node
'
' Bookmark Control is telling us that it needs to link to the relevant item
' in the TreeView Control
'
    On Error Resume Next
    
    Set nNode = tvCodeItems.Nodes("C" & oCodeItem.Key)
    nNode.EnsureVisible
    nNode.Selected = True
    ctlCodeItemDetails.Initialise mDB, oCodeItem
    StatusBar1.Panels(1).Text = nNode.Text

End Sub

Private Sub ctlCodeItemDetails_RequestFileName(ByVal DialogType As eGetFileDialog, sFilename As String, ByVal sDialogTitle As String)
'
' CodeItemDetails control is asking us for a filename
'
    sFilename = GetFileName(DialogType, sFilename, sDialogTitle)
End Sub

Private Sub ctlCodeItemDetails_ViewChanged(ByVal CurrentView As eCurView)
'
' View has changed, update the necessary toolbar buttons
'
    tbTools.Buttons("PRINT").Enabled = (CurrentView <> vwFiles)
End Sub

Private Sub Form_Load()

    Dim oWaitCursor As CWaitCursor
    Dim oButton As Button
    
    
On Error GoTo vbErrorHandler
'
' Set Cursor to HourGlass
'
    Set oWaitCursor = New CWaitCursor
    oWaitCursor.SetCursor
    
'
' Register Our New Clipboard Format
'
    miClipBoardFormat = RegisterClipboardFormat("VBCodeLibTree")
'
' Create our new settings Object
'
    Set moSettings = New CSettings
'
' Execute Startup Procedures as defined in the Settings Object
'
    GetLastDBName
    
    DoStartUp
'
' Set the toolbar to 'flat' style, and TrackSelect on the TreeView
'
    InitControls
'
' Setup the SysTray Icon
'
    SetupSysTrayIcon
'
' Create our Link to the Database
'
    If SetupDBConnection = True Then
'
' Set ToolBar's ImageList
'
        Set tbTools.ImageList = ImageList1
'
' Fill the Tree with our code items from the DataBase
'
        FillTree
    
'
' Initialise the UserControls
'
        ctlBookMarkList.Initialise mDB
        ctlCodeItemDetails.Initialise mDB, Nothing

        ShowBookmarks mbShowBookmarks
        EnableControls True

    Else
        EnableControls False
        ShowBookmarks True
    End If
    
    Set oWaitCursor = Nothing
    
    Exit Sub

vbErrorHandler:
'
' Error handling could be nicer, but hey !
' it's only an example application.
'
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source & " frmCodeLib::Form_Load", , App.ProductName
    
    Set oWaitCursor = Nothing
End Sub

Private Sub FillTree()

On Error GoTo vbErrorHandler

'
' Populate our TreeView Control with the Data from our database
'
    Dim lCount As Long
    Dim rsSections As Recordset
    Dim sParent As String
    Dim sKey As String
    Dim sText As String
    Dim bBookMark As Boolean
    Dim nNode As Node
    
    Set rsSections = mDB.OpenRecordset("select * from codeitems order by parentid", dbOpenSnapshot)
    
    Set tvCodeItems.ImageList = Nothing
    Set tvCodeItems.ImageList = ImageList1

    If rsSections.BOF And rsSections.EOF Then
        tvCodeItems.Nodes.Add , , "ROOT", "Code Library", "VIEWBOOKMARKS"
        BoldTreeNode tvCodeItems.Nodes("ROOT")
        Exit Sub
    End If
        
    TreeRedraw tvCodeItems.hwnd, False
    
    rsSections.MoveFirst
    Set tvCodeItems.ImageList = Nothing
    Set tvCodeItems.ImageList = ImageList1
'
' Populate the TreeView Nodes
'

    With tvCodeItems.Nodes
        .Clear
        .Add , , "ROOT", "Code Library", "VIEWBOOKMARKS"
'
' Make our Root Item BOLD
'
        BoldTreeNode tvCodeItems.Nodes("ROOT")
'
' Now add all nodes into TreeView, but under the root item.
' We reparent the nodes in the next step
'
        Do Until rsSections.EOF
            sParent = rsSections("ParentID").Value
            sKey = rsSections("ID").Value
            sText = rsSections("Description").Value
            Set nNode = .Add("ROOT", tvwChild, "C" & sKey, sText, "FOLDER")
'
' Record parent ID
'
            nNode.Tag = "C" & sParent
            rsSections.MoveNext
        Loop
    
    End With
'
' Here's where we rebuild the structure of the nodes
'
    For Each nNode In tvCodeItems.Nodes
        sParent = nNode.Tag
        If Len(sParent) > 0 Then        ' Don't try and reparent the ROOT !
            If sParent = "C0" Then
                sParent = "ROOT"
            End If
            Set nNode.Parent = tvCodeItems.Nodes(sParent)
        End If
    Next
'
' Now setup the images for each node in the treeview & set each node to
' be sorted if it has children
'
    For Each nNode In tvCodeItems.Nodes
        If nNode.Children = 0 Then
            nNode.Image = "CHILD"
        Else
            nNode.Sorted = True
        End If
    Next
    
    Set rsSections = Nothing
'
' Expand the Root Node
'
    tvCodeItems.Nodes("ROOT").Sorted = True
    tvCodeItems.Nodes("ROOT").Expanded = True
    
    TreeRedraw tvCodeItems.hwnd, True
    
    Exit Sub

vbErrorHandler:
    
    TreeRedraw tvCodeItems.hwnd, True
    
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source & " frmCodeLib::FillTree", , App.ProductName

End Sub

Private Sub Form_Resize()
    On Error Resume Next
'
' Make sure that all of our Controls are resized appropriately
'
    SizeControls tvCodeItems.Width
End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo vbErrorHandler
'
' Clear the treeview
'
    ClearTreeView
'
' Kill of any handles to objects in the Controls
'
    ctlBookMarkList.Terminate
    ctlCodeItemDetails.Terminate
'
' Kill the SysTray Icon
'
    KillSysTrayIcon
'
' Close the Database Connection
'
    If Not (mDB Is Nothing) Then
        mDB.Close
        Set mDB = Nothing
    End If
'
' Execute our unload procedure
'
    DoUnload
'
' That's it !
'
    Exit Sub

vbErrorHandler:
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source & " frmCodeLib::Form_Unload", , App.ProductName

End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'
' Handle Splitter Movement - taken straight from the VB Template code
'
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbSplitting = True
End Sub


Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'
' Handle Splitter Movement - taken straight from the VB Template code
'
    Dim sglPos As Single
    
    If mbSplitting Then
        sglPos = x + imgSplitter.Left
        If sglPos < lVSplitLimit Then
            picSplitter.Left = lVSplitLimit
        ElseIf sglPos > Me.Width - lVSplitLimit Then
            picSplitter.Left = Me.Width - lVSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub


Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'
' Handle Splitter Movement - taken straight from the VB Template code
'
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbSplitting = False
End Sub

Private Sub mnuAbout_Click()
    Dim mFrm As frmAbout

On Error GoTo vbErrorHandler

'
' Show the about form
'
    Set mFrm = New frmAbout
    
    Load mFrm
    mFrm.Show vbModal
    Unload mFrm
    Set mFrm = Nothing

    Exit Sub

vbErrorHandler:
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source & "frmCodeLib::mnuAbout_Click", , App.ProductName

End Sub

Private Sub mnuAddCode_Click()
'
' Add Code at the selected poit
'
    AddCode
End Sub

Private Sub AddCode()
'
' Add Code at the selected poit
'
On Error GoTo vbErrorHandler

    Dim sTitle As String
    Dim nNode As Node
    Dim oCodeItem As CCodeItem
    Dim iDO As IDataObject
    Dim sParentKey As String
    Dim nParentNode As Node
    
    Set nNode = tvCodeItems.SelectedItem
    
    If nNode.Key = "ROOT" Then
        sParentKey = "0"
    Else
        sParentKey = Right$(nNode.Key, Len(nNode.Key) - 1)
    End If
    
    If sParentKey <> "0" Then
        Set nParentNode = tvCodeItems.Nodes("C" & sParentKey)
        nParentNode.Image = "FOLDER"
        nParentNode.ExpandedImage = "FOLDER"
    End If
    
    Set iDO = New CCodeItem
    Set oCodeItem = iDO
    
    iDO.Initialise mDB
    oCodeItem.Description = "New Code item"
    oCodeItem.ParentKey = sParentKey
    iDO.Commit
    
    ctlCodeItemDetails.Initialise mDB, iDO
    
    Set nNode = tvCodeItems.Nodes.Add(tvCodeItems.SelectedItem, tvwChild, "C" & iDO.Key, oCodeItem.Description, "CHILD")
    Set tvCodeItems.SelectedItem = nNode
    nNode.EnsureVisible
    
    tvCodeItems.StartLabelEdit
    

    Exit Sub

vbErrorHandler:
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source & " frmCodeLib::AddCode", , App.ProductName

End Sub

Private Sub mnuBookMark_Click()
'
' Add BookMark at the selected poit
'
    AddBookMark

End Sub

Private Sub AddBookMark()
'
' Add BookMark at the selected poit
'
On Error GoTo vbErrorHandler
    
    Dim sKey As String
    Dim iDO As IDataObject
    Dim frmBookMark As frmAddBookmark
    
    sKey = tvCodeItems.SelectedItem.Key
    If sKey = "ROOT" Then Exit Sub
    
    sKey = Right$(sKey, Len(sKey) - 1)
    
    Set iDO = New CCodeItem
    iDO.Initialise mDB, sKey
    
    Set frmBookMark = New frmAddBookmark
    
    Load frmBookMark
    
    With frmBookMark
        .Initialise mDB, iDO
        .Show vbModal, Me
        If Not (.Cancelled) Then
            ctlBookMarkList.Initialise mDB
            ctlBookMarkList.FindBookmark tvCodeItems.SelectedItem.Text
        End If
    End With
    
    Unload frmBookMark
    
    Set frmBookMark = Nothing
    Set iDO = Nothing


    Exit Sub

vbErrorHandler:
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source & " frmCodeLib::AddBookMark", , App.ProductName

End Sub


Private Sub mnuDeleteCode_Click()
'
' Delete the selected CodeItem and all it's children
'
    DeleteCodeItem
End Sub

Private Sub mnuEdit_Click()
    Dim bIsRoot As Boolean
'
' Make menu items enabled/disabled as appropriate
'
    bIsRoot = (StrComp(tvCodeItems.SelectedItem.Key, "ROOT", vbTextCompare) = 0)
    mnuRename.Enabled = Not (bIsRoot)
    mnuDeleteCode.Enabled = Not (bIsRoot)
    mnuBookMark.Enabled = Not (bIsRoot)
    
End Sub

Private Sub mnuExit_Click()
'
' Quit !
'
    Unload Me
End Sub

Private Sub mnuExport_Click()
'
' Export All the CodeItems from the selected node