frmmain.frm

几个不错的VB例子

            '# Select added item
            TreeView.Nodes("C" & ID).Selected = True
            TreeView.Nodes("C" & ID).EnsureVisible
            Fill_Thumbs ""
            
            '# Enable [Add pictures] button
            Commands.Buttons("Add_Pict").Enabled = True
    
    '## Rename a category
        Case "Ren_Cat"
      
            '# If no category nodes...:
            If DataCategories.Recordset.RecordCount = 0 Then Exit Sub
            
            '# If root node...:
            If TreeView.SelectedItem.Key = "C" Then
               MsgBox "Select a category", vbInformation, "Rename Category"
               Exit Sub
            End If
            
            Resp = InputBox("Enter name (max. 50) :", _
                            "Rename category", _
                            TreeView.SelectedItem)
            
            '# Apostrophe not accepted:
            If InStr(1, Resp, Chr(39)) Then
            
                MsgBox "Character ['] not accepted", _
                       vbInformation, _
                       "Rename category"
                
                Call Commands_ButtonClick(Commands.Buttons("Ren_Cat"))
                Exit Sub
                
            End If
            
            If Trim(Resp) = "" Then Exit Sub
            
            '# Edit selected entry
            ID = TreeView.SelectedItem.Key
            DataCategories.Recordset.FindFirst "[IDCat]='" & _
                                                Right(ID, Len(ID) - 1) & "'"
            DataCategories.Recordset.Edit
            DataCategories.Recordset("Category") = Left(Trim(Resp), 50)
            DataCategories.Recordset.Update
            
            '# Fill Treeview
            Fill_TreeCategories
                             
            '# Reselect renamed item
            TreeView.Nodes(ID).Selected = True
            TreeView.Nodes(ID).EnsureVisible

    '## Delete a category
        Case "Del_Cat"
            
            '# If no category nodes...:
            If DataCategories.Recordset.RecordCount = 0 Then Exit Sub
            
            If TreeView.SelectedItem.Key = "C" Then
                '# If root node (DB)...:
                Resp = MsgBox("This will delete ALL database content. Continue?", _
                              vbExclamation Or vbYesNo Or vbDefaultButton2, _
                              "Delete database content")
            Else
                '# If category...:
                Resp = MsgBox("All subcategories will be deleted" & NL & "Delete category ?", _
                              vbExclamation Or vbYesNo Or vbDefaultButton2, _
                              "Delete category")
            End If
            
            If Resp = vbNo Then Exit Sub
            
            '# Delete entry (All subcategories will be deleted too)
            Dim tmpSource As String
            tmpSource = DataCategories.RecordSource
            
            DataCategories.RecordSource = "Select [IDCat] from tblCategories where [IDCat] LIKE '" & _
                                          Right(TreeView.SelectedItem.Key, Len(TreeView.SelectedItem.Key) - 1) & "*'"
            DataCategories.Refresh
            
            DataCategories.Recordset.MoveFirst
            Do Until DataCategories.Recordset.EOF
                DataCategories.Recordset.Delete
                DataCategories.Recordset.MoveNext
            Loop

            DataCategories.RecordSource = tmpSource
            DataCategories.Refresh
            
            '# Fill Treeview
            Fill_TreeCategories
            Fill_Thumbs ""
            
    '## Show form <Add to DB>
        Case "Add_Pict"
            
            '# Stop playing
            Call Commands_ButtonClick(Commands.Buttons("Pause"))
            Commands.Buttons("Pause").Value = tbrPressed
            frmFull.opFull(0).Checked = False
            frmFull.opFull(1).Checked = True
            
            '# Hide comments
            If chkComments Then
                chkComments = 0
                frmComments.Hide
                frmFull.opFull(19).Caption = "Show &comments"
            End If
            
            '# Show form
            frmAddtoDB.DataPictures.Refresh
            Me.Enabled = False
            frmAddtoDB.Show , Me
            
    '## Full screen
        Case "Full"
            
            On Error Resume Next
            If tblID(ThumbIndex) <= 0 Then Exit Sub
            If ThumbIsSelected = False Then Exit Sub
            
            frmFull.Image_Full.Visible = False
            frmFull.Show , Me
            Show_Picture
            frmFull.Image_Full.Visible = True
            
            If chkComments Then frmComments.Show , frmFull
            frmFull.SetFocus
            
    '## Previous picture
        Case "Previous"
            
            Select_Thumb (-1)
                
    '## Next picture
        Case "Next"
        
            Select_Thumb (1)
            
    '## Start play
        Case "Play"
      
            timerShowPictures.Enabled = True
            frmFull.opFull(0).Checked = True
            frmFull.opFull(1).Checked = False
        
    '## Stop play
        Case "Pause"
            
            timerShowPictures.Enabled = False
            frmFull.opFull(0).Checked = False
            frmFull.opFull(1).Checked = True
            
    '## First picture
        Case "First"
            
            ThumbIndex = 1
            Select_Thumb (0)
        
    '## Last picture
        Case "Last"
        
            ThumbIndex = UBound(tblID)
            Select_Thumb (0)
    
    End Select
    
End Sub

Private Sub CommandExit_ButtonClick(ByVal Button As MSComctlLib.Button)

    '## Exit Thumb DB 1.5 ...
    
    DataPictures.Recordset.Close
    DataCategories.Recordset.Close
    DataCategories.Database.Close
    
    Unload frmAbout
    Unload frmAddtoDB
    Unload frmComments
    Unload frmDB
    Unload frmHelp
    Unload frmFull
    Unload frmView
    Unload Me
    
    Set frmAbout = Nothing
    Set frmAddtoDB = Nothing
    Set frmComments = Nothing
    Set frmDB = Nothing
    Set frmHelp = Nothing
    Set frmFull = Nothing
    Set frmView = Nothing
    Set frmMain = Nothing
    
    End
    
End Sub




'                                  *   *   *   *   *



' =================================================================================
' Treeview (Categories)
' =================================================================================

Private Sub btnExpand_Click()
    
    TreeView.Visible = False
    
    For I = 1 To TreeView.Nodes.Count
        TreeView.Nodes(I).Expanded = True
    Next I
    TreeView.SelectedItem.EnsureVisible
    
    TreeView.Visible = True

End Sub

Private Sub btnContract_Click()

    For I = 1 To TreeView.Nodes.Count
        TreeView.Nodes(I).Expanded = False
    Next I
    
    Fill_Thumbs ""

End Sub

Private Sub Treeview_DragOver(Source As Control, x As Single, y As Single, State As Integer)
    
    Set TreeView.DropHighlight = TreeView.HitTest(x, y)

End Sub

Private Sub Treeview_DragDrop(Source As Control, x As Single, y As Single)
    
    '## No node
    If TreeView.DropHighlight Is Nothing Then Exit Sub
    
    '## Root node or Src. node = Dst. node
    If TreeView.DropHighlight.Key = "C" Or _
       TreeView.DropHighlight.Key = TreeView.SelectedItem.Key Then
       
       Set TreeView.DropHighlight = Nothing
       Exit Sub
        
    End If
    
    '## Check maximum: 500 thumbnails per category
    Dim tmpSource As String
    Dim NumIDCat As String
    Dim Thumbnails As Integer
    
    tmpSource = DataPictures.RecordSource
    NumIDCat = Right(TreeView.DropHighlight.Key, Len(TreeView.DropHighlight.Key) - 1)
    
    With DataPictures
    
        '## Get recordset
        .RecordSource = "Select * from tblPictures where [IDCat] = '" & NumIDCat & "'"
        .Refresh
        
        '## Fill recordset
        If .Recordset.RecordCount > 0 Then
           .Recordset.MoveFirst
           .Recordset.MoveLast
        End If
        
        '## Get number of entries
        Thumbnails = .Recordset.RecordCount
        
        '## Close recordset and set default source
        .Recordset.Close
        .RecordSource = tmpSource
        .Refresh

    End With
    
    If Thumbnails = 500 Then
    
        MsgBox "The destination category is full", _
        vbExclamation, _
        "Move/Copy thumbnail"
        
        Set TreeView.DropHighlight = Nothing
        Exit Sub
        
    End If
    
    '## Show Image message "MOVED"/"COPIED" on Grids
    If CopyThumb Then
        
        '# Copy thumbnail
        ThumbGrid.PaintPicture Image_Copied, _
                               ((ThumbIndex - 1) Mod 6) * 66 + 2, _
                               Int((ThumbIndex - 1) / 6) * 66 + 25
        RefreshFullGrid -3
        
        DataPictures.Recordset.FindFirst "IDPict = " & tblID(ThumbIndex)
        
        With DataCopy
    
            .Recordset.AddNew
                
                .Recordset("Path") = DataPictures.Recordset("Path")
                .Recordset("IDCat") = Right(TreeView.DropHighlight.Key, _
                                            Len(TreeView.DropHighlight.Key) - 1)
                .Recordset("Properties") = DataPictures.Recordset("Properties")
                .Recordset("DateInDB") = Now
                .Recordset("Thumb") = DataPictures.Recordset("Thumb")
                .Recordset("Comments") = DataPictures.Recordset("Comments")
                
            .Recordset.Update
        
        End With
    
    Else
        
        '# Move thumbnail
        ThumbGrid.PaintPicture Image_Moved, _
                               ((ThumbIndex - 1) Mod 6) * 66 + 2, _
                               Int((ThumbIndex - 1) / 6) * 66 + 25
        RefreshFullGrid -1
        
        DataPictures.Recordset.FindFirst "IDPict = " & tblID(ThumbIndex)
        DataPictures.Recordset.Edit
        DataPictures.Recordset("IDCat") = Right(TreeView.DropHighlight.Key, _
                                            Len(TreeView.DropHighlight.Key) - 1)
        DataPictures.Recordset.Update
        
        '# Set "thumbnail moved" index
        tblID(ThumbIndex) = -1
    
    End If
    
    Select_Thumb (0)
    Set TreeView.DropHighlight = Nothing
    
End Sub

Private Sub Treeview_NodeClick(ByVal Node As MSComctlLib.Node)
    
    '## If root node...
    If Node.Key = "C" Then
        Fill_Thumbs ""
        Exit Sub
    End If
    
    '## Clear Grids
    ThumbGrid.Cls
    FullGrid.Visible = False
    vsbFullGrid.Visible = False
    DoEvents
 
    '## Deactivate "Search all categories"
    chkAll = 0
    
    '## Fill ThumbGrid
    TreeView.SelectedItem.Expanded = True
    Fill_Thumbs TreeView.SelectedItem.Key
    ThumbGrid.SetFocus
    
End Sub

Private Sub btnRefresh_Click()
    
    '## Refresh Thumbnails
    If DataCategories.Recordset.RecordCount > 0 Then
        
        '# Set ThumbGrid to default view mode
        FullGrid.Visible = False
        vsbFullGrid.Visible = False
        
        '# Fill ThumbGrid
        Fill_Thumbs TreeView.SelectedItem.Key
    
    End If
    
End Sub

' =================================================================================
' Filter control
' =================================================================================

Private Sub txtFilter_KeyPress(KeyAscii As Integer) ' Comments filter