frmmain.frm

利用VB+SQL2000开发的照片管理系统

            Call tvTreeView_NodeClick(tvTreeView.SelectedItem)
            
        Case "TbrDel"
            If LvListView1.ListItems.Count = 0 Then Exit Sub
            If MsgBox("是否真的删除选择的照片？", vbOKCancel + vbQuestion, "请确认...") = vbOK Then
                MdlMain.cn.BeginTrans
                    For i = 1 To LvListView1.ListItems.Count
                        If LvListView1.ListItems(i).Selected = True Then
                            Rec.Bookmark = Val(Right(LvListView1.ListItems(i).Key, Len(LvListView1.ListItems(i).Key) - 1))
                            
                            MdlMain.cn.Execute "delete from TblPicture where pid='" & LvListView1.ListItems(i).SubItems(1) & "'"
                            MdlMain.cn.Execute "delete from TblPic where pid='" & LvListView1.ListItems(i).SubItems(1) & "'"
                        End If
                    Next i
                MdlMain.cn.CommitTrans
                Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrRefresh"))
            End If
        
        Case "TbrTime"
            On Error Resume Next
            PlayTime = InputBox("请输入自动播放间隔秒数：", "时间设定", PlayTime)
            If PlayTime = 0 Then PlayTime = 2
            Timer1.Interval = PlayTime * 1000
        Case "TbrPlay"
            If Button.Caption = "播放" Then
                Button.Caption = "停止"
                Timer1.Interval = PlayTime * 1000
                Timer1.Enabled = True
            Else
                Button.Caption = "播放"
                Timer1.Enabled = False
            End If
    End Select
End Sub

Private Sub picSplitter1_LostFocus()
    picSplitter1.Visible = False
End Sub

Private Sub imgSplitter1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With imgSplitter1
        picSplitter1.Move .Left, .Top, .Width - 20, .Height - 20
    End With
    picSplitter1.Visible = True
    mbMoving = True
End Sub

Private Sub imgSplitter1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim sglPos As Single
    
    If mbMoving Then
        sglPos = x + imgSplitter1.Left
        If sglPos < sglSplitLimit Then
            picSplitter1.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter1.Left = Me.Width - sglSplitLimit
        Else
            picSplitter1.Left = sglPos
        End If
    End If
End Sub

Private Sub imgSplitter1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    SizeControls picSplitter1.Left, 0
    picSplitter1.Visible = False
    mbMoving = False
End Sub

Private Sub Form_Resize()
    SizeControls imgSplitter1.Left, imgSplitter5.Top
'    SizeControls1 imgSplitter5.Top
End Sub

Sub SizeControls(X1 As Single, shu As Single)
    On Error Resume Next
    If X1 <> 0 Then
        ProgressBar1.Left = 50
        ProgressBar1.Top = Toolbar1.Height + 40
        ProgressBar1.Width = Me.ScaleWidth - 100
        ProgressBar1.Visible = False
        
        Picture2.Left = 50
        Picture2.Width = X1
        Picture2.Top = ProgressBar1.Height + Toolbar1.Height + 70
        Picture2.Height = Me.ScaleHeight - (Picture2.Top + 40) - StatusBar1.Height
        
        imgSplitter1.Left = X1
        imgSplitter1.Top = Picture2.Top
        imgSplitter1.Height = Picture2.Height
        picSplitter1.Left = imgSplitter1.Left
        
        LvListView1.Left = imgSplitter1.Left + imgSplitter1.Width
        LvListView1.Top = Picture2.Top
        LvListView1.Height = Picture2.Height
        
        LvListView1.Width = Me.Width - (LvListView1.Left + 220)
    End If
    If shu <> 0 Then
        With tvTreeView
            .Left = 50
            .Top = 50
            .Width = Picture2.ScaleWidth - 70
            .Height = shu - .Top
            
            Picture4.Left = .Left
            Picture4.Top = .Top + .Height + 200
            Picture4.Width = .Width
            Picture4.Height = Picture2.ScaleHeight - 20 - Picture4.Top
            
            imgSplitter5.Top = shu
            imgSplitter5.Left = .Left
            imgSplitter5.Width = .Width
            imgSplitter5.Top = shu
            picSplitter5.Left = .Left
            picSplitter5.Width = .Width
            
        End With
    End If
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    Select Case ButtonMenu.Text
        Case "平铺"
            Call DeskTop(1)
        Case "拉伸"
            Call DeskTop(2)
        Case "居中"
            Call DeskTop(0)
    End Select
End Sub

Private Sub tvTreeView_DragDrop(Source As Control, x As Single, y As Single)
    If Source = imgSplitter1 Then
        SizeControls x, 0
    End If
End Sub

Private Sub Image1_DblClick()
    If LvListView1.ListItems.Count = 0 Then Exit Sub
    FrmPicLl.Show vbModal
End Sub

Private Sub Picture2_Resize()
    With tvTreeView
        .Left = 50
        .Top = 50
        .Width = Picture2.ScaleWidth - 70
'        .Height = Shu - .Top
        
        Picture4.Left = .Left
        Picture4.Top = .Top + .Height + 200
        Picture4.Width = .Width
'        Picture4.Height = Picture2.ScaleHeight - 350 - Picture4.Top
        
'        imgSplitter5.Top = Shu
        imgSplitter5.Left = .Left
        imgSplitter5.Width = .Width
'        imgSplitter5.Top = Shu
        picSplitter5.Left = .Left
        picSplitter5.Width = .Width
        
    End With
End Sub

Private Sub Picture4_Resize()
    Call PicDisplay
End Sub

Private Sub PicDisplay()
    On Error Resume Next
    Image1.Picture = LoadPicture()
    Image1.Stretch = False
    Image1.Picture = MdlMain.Chunk2Image(MdlMain.Chunk, "")
    
    Dim Wr As Double
    Dim Hr As Double
    Dim r As Double
    Image1.Visible = False
    Wr = Picture4.Width / Image1.Width
    Hr = Picture4.Height / Image1.Height
    If Wr > Hr Then r = Hr Else r = Wr
    Image1.Width = Image1.Width * r
    Image1.Height = Image1.Height * r
    Image1.Top = (Picture4.Height - Image1.Height) / 2
    Image1.Left = (Picture4.Width - Image1.Width) / 2
    Image1.Stretch = True
    Image1.Visible = True
End Sub


Private Sub imgSplitter5_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With imgSplitter5
        picSplitter5.Move .Left, .Top, .Width - 20, .Height - 20
    End With
    picSplitter5.Visible = True
    IsMoving = True
End Sub

Private Sub imgSplitter5_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim sglPos As Single
    If IsMoving Then
        sglPos = y + imgSplitter5.Top
        If sglPos < sglSplitLimit + Toolbar1.Height Then
            picSplitter5.Top = sglSplitLimit + Toolbar1.Height
        ElseIf sglPos > Picture2.Height - sglSplitLimit - 700 Then
            picSplitter5.Top = Picture2.Height - sglSplitLimit - 700
        Else
            picSplitter5.Top = sglPos
        End If
    End If
End Sub

Private Sub imgSplitter5_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    SizeControls 0, picSplitter5.Top
'    SizeControls1 picSplitter5.Top
    picSplitter5.Visible = False
    IsMoving = False
End Sub

Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    If Rec.State = 1 Then Rec.Close: Set Rec = Nothing
    Rec.CursorLocation = adUseClient
    Select Case Left(Node.Key, 1)
        Case "r"
            Sql_Str = " "
            Rec.Open "select TblPic.*,tbltype.tname from TblPic left join Tbltype on tbltype.tid=tblpic.tid order by tblpic.pid", _
                MdlMain.cn, adOpenDynamic, adLockOptimistic
        Case "L"
            Sql_Str = " TblPic.tid='" & Trim(Left(Node.Text, InStr(Node.Text, " | "))) & "' order by tblpic.pid"
            Rec.Open "select TblPic.*,tbltype.tname from TblPic left join Tbltype on " & _
                "tbltype.tid=tblpic.tid where " & Sql_Str, MdlMain.cn, adOpenDynamic, adLockOptimistic
    End Select
    Image1.Picture = LoadPicture()
    Call Init_LvListView1(Rec)
End Sub

Public Sub Init_LvListView1(Rrec As ADODB.Recordset)
    LvListView1.ListItems.Clear
    LvListView1.Sorted = False
    If Rrec.EOF And Rrec.BOF Then Exit Sub
    Rrec.MoveLast
    StatusBar1.Panels(2).Text = "选定图片数量：" & Rrec.AbsolutePosition & " 张"
    ProgressBar1.Max = Rrec.AbsolutePosition
    ProgressBar1.Min = 0
    ProgressBar1.Value = 0
    ProgressBar1.Visible = True
    Rrec.MoveFirst
    With Rrec
        Do While Not .EOF
            ProgressBar1.Value = .AbsolutePosition
            LvListView1.ListItems.Add , "r" & .Bookmark, ProgressBar1.Value, 13, 13
            LvListView1.ListItems("r" & .Bookmark).SubItems(1) = IIf(IsNull(.Fields("pid").Value), "", .Fields("pid").Value)
            LvListView1.ListItems("r" & .Bookmark).SubItems(2) = IIf(IsNull(.Fields("pname").Value), "", .Fields("pname").Value)
            LvListView1.ListItems("r" & .Bookmark).SubItems(3) = IIf(IsNull(.Fields("pdate").Value), "", Format(.Fields("pdate").Value, "yyyy-mm-dd"))
            LvListView1.ListItems("r" & .Bookmark).SubItems(4) = IIf(IsNull(.Fields("pdis").Value), "", .Fields("pdis").Value)
            LvListView1.ListItems("r" & .Bookmark).SubItems(5) = IIf(IsNull(.Fields("tname").Value), "", .Fields("tname").Value)
            .MoveNext
        Loop
    End With
    Rrec.MoveFirst
    ProgressBar1.Visible = False
    DoEvents
    If LvListView1.ListItems.Count <> 0 Then
        CurrentPosition = 1
        LvListView1.ListItems(1).Selected = True
        LvListView1.Tag = LvListView1.SelectedItem.Key
        DoEvents
        Call LvListView1_ItemClick(LvListView1.SelectedItem)
    End If
End Sub

Private Sub LvListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    LvListView1.Sorted = True
    LvListView1.SortKey = ColumnHeader.Index - 1
    If LvListView1.SortOrder = lvwAscending Then
        LvListView1.SortOrder = lvwDescending
    Else
        LvListView1.SortOrder = lvwAscending
    End If
End Sub

Private Sub DeskTop(DeskTopStyle As Integer)
    '取得windows目录
    Dim Path As String
    Dim strSave As String
    
    strSave = String(50, Chr$(0))
    Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
    '转换图片并保存到Windows目录下面
    
    SavePicture Image1, Path & "\FIL663.bmp"
    
    '更换墙纸
    Dim aa As String
    aa = Path & "\FIL663.bmp"
    
    '写入注册表
    MdlReg.UpdateKey MdlReg.HKEY_CURRENT_USER, "Control Panel\desktop", "TileWallpaper", REG_SZ, CStr(DeskTopStyle), 1
    MdlReg.UpdateKey MdlReg.HKEY_CURRENT_USER, "Control Panel\desktop", "Wallpaper", REG_EXPAND_SZ, aa, LenB(aa)
    MdlReg.UpdateKey MdlReg.HKEY_CURRENT_USER, "Control Panel\desktop", "WallpaperStyle", REG_SZ, CStr(DeskTopStyle), 1
    
    MdlReg.UpdateKey MdlReg.HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Desktop\General", "TileWallpaper", REG_SZ, CStr(DeskTopStyle), 1
    MdlReg.UpdateKey MdlReg.HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Desktop\General", "Wallpaper", REG_EXPAND_SZ, aa, LenB(aa)
    MdlReg.UpdateKey MdlReg.HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Desktop\General", "WallpaperStyle", REG_SZ, CStr(DeskTopStyle), 1
    
    MdlMain.SystemParametersInfo SPI_SETDESKWALLPAPER, 0, aa, 0
End Sub