frmmain.frm

几个不错的VB例子

    '## Not accepted chars.: ' [ ] |
    If InStr(1, "'[]|", Chr(KeyAscii)) Then KeyAscii = 0
    
    '## [Return] key pressed:
    If KeyAscii = 13 Then
        
        '# Save find string (if doesn't exist)
        For I = 0 To txtFilter.ListCount - 1
            If UCase(txtFilter.Text) = UCase(txtFilter.List(I)) Then
                btnRefresh_Click
                Exit Sub
            End If
        Next I
        '# Save and Refresh thumbnails:
        txtFilter.AddItem txtFilter
        btnRefresh_Click
    
    End If
    
End Sub

Private Sub txtFilter_GotFocus()

    Me.KeyPreview = False
    
End Sub

Private Sub txtFilter_LostFocus()

    Me.KeyPreview = True
    
End Sub

Private Sub chkFilter_Click()
    
    If chkFilter Then
        chkAll.Enabled = True
    Else
        chkAll.Enabled = False
    End If

End Sub

Private Sub chkThumbs_Click()
    
    '## Visible/Not visible: thumbnails
    If chkThumbs Then
        chkFullGrid.Enabled = True
    Else
        chkFullGrid.Enabled = False
        FullGrid.Visible = False
        vsbFullGrid.Visible = False
    End If
    
    If DataCategories.Recordset.RecordCount = 0 Then Exit Sub
        
    '# Fill ThumbGrid
    Fill_Thumbs TreeView.SelectedItem.Key

End Sub

Private Sub chkFullGrid_Click()

    FullGrid.Visible = False
    vsbFullGrid.Visible = False
    
    If DataCategories.Recordset.RecordCount = 0 Then Exit Sub
        
    If chkFullGrid Then
        Fill_Thumbs TreeView.SelectedItem.Key
    End If
    
End Sub

' =================================================================================
' ThumbGrid control
' =================================================================================

Private Sub ThumbGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Dim tmpThumbIndex As Integer
    
    '## Get thumbnail index from mouse position
    tmpThumbIndex = Int(y / 66) * 6 + Int(x / 66) + 1
    
    '## If no records...
    If DataPictures.Recordset.RecordCount = 0 Or _
       chkThumbs = 0 Or _
       tmpThumbIndex > UBound(tblID) Then ThumbIsSelected = False: Exit Sub
    
    '## If thumbnail moved, deleted or load error
    If tblID(tmpThumbIndex) < 0 And tblID(tmpThumbIndex) <> -2 Then ThumbIsSelected = False: Exit Sub
       
    '## Select thumbnail
    ThumbIndex = tmpThumbIndex
    ThumbIsSelected = True
    
    Select Case Button
        
        '# Show context menu
        Case vbRightButton
        
            Call Commands_ButtonClick(Commands.Buttons("Pause"))
            Commands.Buttons("Pause").Value = tbrPressed
            frmFull.opFull(0).Checked = False
            frmFull.opFull(1).Checked = True
            
            Select_Thumb (0)
            
            If tblID(ThumbIndex) = 0 Then
                OpThumb(2).Enabled = False
                OpThumb(3).Enabled = False
                OpThumb(4).Enabled = False
            Else
                OpThumb(2).Enabled = True
                OpThumb(3).Enabled = True
                OpThumb(4).Enabled = True
            End If
            
            PopupMenu ThumbMenu
            
        '# Select thumbnail and move/copy it to category
        Case vbLeftButton
        
            '## Copy/Move thumbnail to category
            
            If Shift = 1 Then
                ThumbGrid.DragIcon = crsCopy
                CopyThumb = True
            Else
                ThumbGrid.DragIcon = crsMove
                CopyThumb = False
            End If
            
            If Shift > 0 And tblID(ThumbIndex) > 0 Then
                Call Commands_ButtonClick(Commands.Buttons("Pause"))
                Commands.Buttons("Pause").Value = tbrPressed
                frmFull.opFull(0).Checked = False
                frmFull.opFull(1).Checked = True
                ThumbGrid.Drag
            End If
            
            Select_Thumb (0)
            
    End Select
    
End Sub

Private Sub ThumbGrid_DblClick()
    
    Call Commands_ButtonClick(Commands.Buttons("Full"))

End Sub

Private Sub vsbThumbGrid_Change()

    ThumbGrid.Top = -vsbThumbGrid.Value
    
End Sub

Private Sub vsbThumbGrid_Scroll()

    vsbThumbGrid_Change

End Sub

' =================================================================================
' FullGrid control
' =================================================================================

Private Sub vsbFullGrid_Change()

    FullGrid.TopRow = vsbFullGrid
    
End Sub

Private Sub vsbFullGrid_Scroll()

    vsbFullGrid_Change

End Sub

Private Sub FullGrid_Click()

    ThumbIndex = FullGrid.Row + 1
    Select_Thumb (0)

End Sub

Private Sub FullGrid_DblClick()

    Call Commands_ButtonClick(Commands.Buttons("Full"))
    
End Sub

Private Sub FullGrid_RowColChange()

    If FullGrid.Visible Then FullGrid_Click
    
End Sub

Private Sub FullGrid_Scroll()

    vsbFullGrid = FullGrid.TopRow

End Sub

Private Sub RefreshFullGrid(ID As Integer)
    
    If FullGrid.Rows = 0 Then Exit Sub
    
    FullGrid.Row = ThumbIndex - 1
    FullGrid.Col = 0
    
    Select Case ID
        
        Case -1
        Set FullGrid.CellPicture = Image_Moved
        
        Case -2
        Set FullGrid.CellPicture = Image_Deleted
        
        Case 0
        Set FullGrid.CellPicture = Image_Error
        
        Case Else
        Set FullGrid.CellPicture = Image_Copied
    
    End Select
    
End Sub

' =================================================================================
' Preview control
' =================================================================================

Private Sub btnPreview_Click()

    If lblPreview = "Best Fit" Then
        lblPreview = "100%"
        Image_Preview.ZoomReal
    Else
        lblPreview = "Best Fit"
        Image_Preview.BestFit
    End If

End Sub

Private Sub Image_Preview_DblClick()
    
    Call Commands_ButtonClick(Commands.Buttons("Full"))
    Show_Picture

End Sub

Private Sub Image_Preview_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    '## If no records...
    If DataPictures.Recordset.RecordCount = 0 Or _
       chkThumbs = 0 Then ThumbIsSelected = False: Exit Sub
    
    '## If thumbnail moved, deleted or load error
    If tblID(ThumbIndex) < 0 Then ThumbIsSelected = False: Exit Sub
    Select Case Button
        
        '# Show context menu
        Case vbRightButton
        
            Call Commands_ButtonClick(Commands.Buttons("Pause"))
            Commands.Buttons("Pause").Value = tbrPressed
            frmFull.opFull(0).Checked = False
            frmFull.opFull(1).Checked = True
            
            PopupMenu ThumbMenu
            
        '# Select thumbnail and move/copy it to category
        Case vbLeftButton
        
            '## Copy/Move thumbnail to category
            If Shift = 1 Then
                Image_Preview.DragIcon = crsCopy
                CopyThumb = True
            Else
                Image_Preview.DragIcon = crsMove
                CopyThumb = False
            End If
            
            If Shift > 0 And tblID(ThumbIndex) > 0 Then
                Call Commands_ButtonClick(Commands.Buttons("Pause"))
                Commands.Buttons("Pause").Value = tbrPressed
                frmFull.opFull(0).Checked = False
                frmFull.opFull(1).Checked = True
                Image_Preview.Drag
            End If
            
    End Select
           
End Sub

Private Sub Image_Preview_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    ThumbGrid.SetFocus
    
End Sub

' =================================================================================
' ThumbGrid / FullGrid modes
' =================================================================================

Private Sub cmdFullGrid_Click()
    
    If FullGrid.Visible = True Then
        
        '# Show ThumbGrid
        FullGrid.Visible = False
        vsbFullGrid.Visible = False
        ThumbGrid.TabStop = True
        ThumbGrid.SetFocus
        
    ElseIf (DataPictures.Recordset.RecordCount > 0 And FullGrid.Rows > 0) And _
            chkThumbs And chkFullGrid Then
        
        '# Show FullGrid
        FullGrid.Visible = True
        vsbFullGrid.Visible = True
        ThumbGrid.TabStop = False
        FullGrid.SetFocus
        
    Else
        
        '# FullGrid empty and/or no thumbnails
        MsgBox "FullGrid empty and/or no thumbnails in this category :" & NL & NL & _
               "Click FullGrid checkbox to fill FullGrid", _
               vbInformation, _
               "FullGrid empty"
               
        ThumbGrid.SetFocus
        
    End If
    
End Sub

' =================================================================================
' Thumbnail/Preview menu
' =================================================================================

Public Sub OpThumb_Click(Index As Integer)
   
    Select Case Index
   
    '## Info
        Case 0
        
           MsgBox Mid(DataPictures.Recordset("Path"), InStrRev(DataPictures.Recordset("Path"), "\") + 1) & NL & NL & _
                  DataPictures.Recordset("Path") & NL & NL & _
                  DataPictures.Recordset("Properties") & NL & NL & _
                  "Date in DB: " & Format(DataPictures.Recordset("DateInDB"), "dd/mm/yy, hh:mm:ss"), vbInformation, "Info"
    
    '## Edit picture
        Case 2
        
            Dim lRet  As Long
            Dim sFile As String
            
            sFile = DataPictures.Recordset("Path")
            If Len(sFile) > 0 Then
                lRet = ShellExecute(Me.hWnd, "Open", sFile, &H0&, &H0&, SW_RESTORE)
            End If
                
    '## Copy to clipboard (Thumbnail)
        Case 3
        
            Clipboard.Clear
            Select_Thumb (0)
            Clipboard.SetData Image_DB
                
    '## Copy to clipboard (Picture)
        Case 4
        
            Clipboard.Clear
            Select_Thumb (0)
            Clipboard.SetData Picture_Loaded
                
    '## Delete thumbnail
        Case 6

            ThumbGrid.PaintPicture Image_Deleted, _
                                  ((ThumbIndex - 1) Mod 6) * 66 + 2, _
                                  Int((ThumbIndex - 1) / 6) * 66 + 25
            RefreshFullGrid -2