frmmain.frm

管理电子相片 可以进行上传 评价 浏览 等操作

    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, ((ThumbIndex - 1) \ 6) * 66 + 25
        Refresh_FullGrid 0
        
        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, ((ThumbIndex - 1) \ 6) * 66 + 25
        Refresh_FullGrid 2
        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
        tblSt(ThumbIndex) = 3
    End If
    
    Select_Thumb (0)
    Set TreeView.DropHighlight = Nothing
End Sub

Private Sub Treeview_NodeClick(ByVal Node As MSComctlLib.Node)
    
    '-- 如果是根节点
    If (Node.Key = "C") Then
         '-- 不显示右边的图片列表框
        FullGrid.Visible = False
        vsbFullGrid.Visible = False
        Fill_Thumbs ""
        Exit Sub
    End If

    '--  清除图片列表框中的内容
    ThumbGrid.Cls
    FullGrid.Visible = False
    vsbFullGrid.Visible = False
    DoEvents

    '-- 解除查找所有文件
    chkAll = 0

    '-- 装载图片列表框中的内容
    TreeView.SelectedItem.Expanded = True
    Fill_Thumbs TreeView.SelectedItem.Key
    ThumbGrid.SetFocus
End Sub

Private Sub btnRefresh_Click()
    
    '-- 刷新缩略图
    If (DataCategories.Recordset.RecordCount > 0) Then
        '-- 设置缩略图为默认模式
        FullGrid.Visible = False
        vsbFullGrid.Visible = False
        '-- 装载缩略图
        Fill_Thumbs TreeView.SelectedItem.Key
    End If
End Sub

'------------------------------------------------------------------------------
' Filter control
'------------------------------------------------------------------------------

Private Sub txtFilter_KeyPress(KeyAscii As Integer) ' Comments filter

    '-- 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
    FullGrid.Visible = True
    vsbFullGrid.Visible = True
        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 = (y \ 66) * 6 + (x \ 66) + 1
    
    '-- If no records...
    If (DataPictures.Recordset.RecordCount = 0 Or chkThumbs = 0 Or tmpThumbIndex > UBound(tblID)) Then
        ThumbIsSelected = False
        Exit Sub
    End If
    
    '-- If thumbnail moved, deleted or load error
    If (tblSt(tmpThumbIndex) > 1) Then
        ThumbIsSelected = False
        Exit Sub
    End If
    
    '-- 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 (tblSt(ThumbIndex) > 0) Then
                '-- Moved/deleted
                OpThumb(2).Enabled = False
                OpThumb(3).Enabled = False
                OpThumb(4).Enabled = False
              Else
                '-- Load error/copied/current thumbnail
                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 tblSt(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 Refresh_FullGrid(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_Error
        Case 2
            Set FullGrid.CellPicture = Image_Moved
        Case 3
            Set FullGrid.CellPicture = Image_Deleted
        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 (tblSt(ThumbIndex) > 1) Then ThumbIsSelected = False: Exit Sub
    
    Select Case Button
    
        '-- Show context menu
        Case vbRightButton
        
            '-- Load error/Moved/Deleted