frmpic.frm

手机话费管理系统！！！管理你的手机通话！！值得一看！！~

VERSION 5.00
Begin VB.Form frmpic 
   BackColor       =   &H80000016&
   Caption         =   "图片浏览"
   ClientHeight    =   4950
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6645
   Icon            =   "frmpic.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   4950
   ScaleWidth      =   6645
   WindowState     =   2  'Maximized
   Begin VB.HScrollBar HScroll1 
      Height          =   285
      Left            =   2565
      TabIndex        =   5
      Top             =   4635
      Visible         =   0   'False
      Width           =   3750
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   4560
      Left            =   6345
      TabIndex        =   4
      Top             =   45
      Visible         =   0   'False
      Width           =   285
   End
   Begin VB.PictureBox Picture1 
      Height          =   4560
      Left            =   2565
      ScaleHeight     =   4500
      ScaleWidth      =   3690
      TabIndex        =   3
      Top             =   45
      Width           =   3750
      Begin VB.Frame Frame1 
         BorderStyle     =   0  'None
         Height          =   1620
         Left            =   0
         TabIndex        =   6
         Top             =   -90
         Visible         =   0   'False
         Width           =   1455
         Begin VB.PictureBox Picture2 
            Height          =   1530
            Index           =   0
            Left            =   0
            ScaleHeight     =   1470
            ScaleWidth      =   1395
            TabIndex        =   7
            Top             =   90
            Width           =   1455
            Begin VB.Label Label1 
               Alignment       =   2  'Center
               BackColor       =   &H80000018&
               ForeColor       =   &H00000000&
               Height          =   240
               Index           =   0
               Left            =   -45
               TabIndex        =   8
               Top             =   1260
               Width           =   1455
            End
            Begin VB.Image Image1 
               Height          =   990
               Index           =   0
               Left            =   90
               MouseIcon       =   "frmpic.frx":0442
               MousePointer    =   99  'Custom
               Top             =   135
               Visible         =   0   'False
               Width           =   1185
            End
         End
      End
   End
   Begin VB.DirListBox Dir1 
      Height          =   4500
      Left            =   0
      TabIndex        =   1
      Top             =   405
      Width           =   2535
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   0
      TabIndex        =   0
      Top             =   45
      Width           =   2535
   End
   Begin VB.FileListBox File1 
      Height          =   810
      Left            =   0
      Pattern         =   "*.bmp;*.dib;*.jpg;*.gif;*.wmf;*.ico;*.emf;*.cur"
      TabIndex        =   2
      Top             =   4095
      Visible         =   0   'False
      Width           =   2535
   End
End
Attribute VB_Name = "frmpic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim frameini(4) As Integer
Dim pictureini(4) As Integer
Dim labelini(2) As Integer
Function Max(A, B)
    Max = B
    If A > B Then Max = A
End Function

Sub setpicture(objpic As Object, objimg As Object, objlab As Object, i As Integer)
  objimg.Stretch = False
  objimg.Visible = True
  objlab.Visible = True
  If Right(Dir1.Path, 1) = "\" Then
     objimg.Picture = LoadPicture(Dir1.Path & File1.List(i))
  Else
     objimg.Picture = LoadPicture(Dir1.Path & "\" & File1.List(i))
  End If
  
  objlab.Left = labelini(0)
  objlab.Top = labelini(1)
  If objimg.Width < objpic.ScaleWidth Then
     objimg.Left = (objpic.ScaleWidth - objimg.Width) / 2
     objimg.Top = (objpic.ScaleHeight - objimg.Height - objlab.Height) / 2
  Else
     objimg.Stretch = True
     objimg.Left = 0
     objimg.Top = 0
     objimg.Height = objpic.ScaleHeight - objlab.Height
     objimg.Width = objpic.ScaleWidth
  End If
  
  objlab.Caption = File1.List(i)
End Sub
Private Sub Dir1_Change()
  On Error Resume Next
  Dim i As Integer
  Dim picnum As Integer
  Dim rowcount As Integer
  Dim colcount As Integer
  Dim colnum As Integer
  
  picnum = 0
  rowcount = 0
  colcount = 0
  colnum = 0
  
  Me.MousePointer = ccHourglass
  For i = 0 To frmpic.Controls.Count - 1
      If TypeOf frmpic.Controls(i) Is Image Then picnum = picnum + 1
  Next
  
  For i = 1 To picnum
      If IsLoaded(Image1(i)) Then
         Unload Image1(i)
         Unload Label1(i)
         Unload Picture2(i)
      End If
  Next
  
  Frame1.Left = frameini(0)
  Frame1.Top = frameini(1)
  Frame1.Height = frameini(2)
  Frame1.Width = frameini(3)
  Frame1.Visible = False
  
  Picture2(0).Left = pictureini(0)
  Picture2(1).Top = pictureini(1)
  Picture2(2).Height = pictureini(2)
  Picture2(3).Width = pictureini(3)
  Picture2(0).Visible = False
  
  Image1(0).Visible = False
  Label1(0).Visible = False
  HScroll1.Visible = False
  VScroll1.Visible = False
  
  File1.Path = Dir1.Path
  
  If File1.ListCount <= 0 Then
     Me.MousePointer = ccDefault
     Exit Sub
  End If
  colnum = (Picture1.ScaleWidth - Picture2(0).Width) \ Picture2(0).Width
  
  Frame1.Visible = True
  Picture2(0).Visible = True
  
  setpicture Picture2(0), Image1(0), Label1(0), 0
  
  For i = 1 To File1.ListCount - 1
      If IsLoaded(Picture2(i)) = False Then
         Load Picture2(i)
         If (rowcount = 0 And colcount = 0) Then colcount = 1
         If (rowcount = 0) Then Frame1.Width = Picture2(0).Width * (colcount + 1)
         Frame1.Height = Picture2(0).Height * (rowcount + 1) + frameini(2) - pictureini(2)

         If Frame1.Width > Picture1.ScaleWidth Then
            HScroll1.Visible = True
            HScroll1.Min = 0
            HScroll1.Value = 0
            HScroll1.Max = Frame1.Width - Picture1.ScaleWidth
            HScroll1.SmallChange = Max(HScroll1.Max / 100, 1)
            HScroll1.LargeChange = Max(HScroll1.Max / 10, 1)
         End If
         
         Picture2(i).Left = Picture2(0).Left + Picture2(0).Width * colcount
         Picture2(i).Top = Picture2(0).Top + Picture2(0).Height * rowcount
         Picture2(i).Visible = True
         
         If IsLoaded(Image1(i)) = False Then
            Load Image1(i)
            Load Label1(i)
            Set Image1(i).Container = Picture2(i)
            Set Label1(i).Container = Picture2(i)
            setpicture Picture2(i), Image1(i), Label1(i), i
         End If
         
         colcount = colcount + 1
         If (colcount > colnum) Then
            colcount = 0
            rowcount = rowcount + 1
            
            If Frame1.Height > Picture1.ScaleHeight Then _
                VScroll1.Visible = True
                VScroll1.Min = 0
                VScroll1.Value = 0
                VScroll1.Max = Frame1.Height - Picture1.ScaleHeight
                VScroll1.SmallChange = Max(VScroll1.Max / 100, 1)
                VScroll1.LargeChange = Max(VScroll1.Max / 10, 1)
            End If
       End If
       If i = 32767 Then Exit For
  Next
  Me.MousePointer = ccDefault
End Sub

Private Sub Drive1_Change()
  On Error Resume Next
  Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Load()
  frameini(0) = Frame1.Left
  frameini(1) = Frame1.Top
  frameini(2) = Frame1.Height
  frameini(3) = Frame1.Width
    
  pictureini(0) = Picture2(0).Left
  pictureini(1) = Picture2(0).Top
  pictureini(2) = Picture2(0).Height
  pictureini(3) = Picture2(0).Width
  
  labelini(0) = Label1(0).Left
  labelini(1) = Label1(0).Top
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  Dir1.Height = frmpic.ScaleHeight - Drive1.Height
  
  Picture1.Top = Drive1.Top
  
  If HScroll1.Visible = True Then
     Picture1.Height = frmpic.ScaleHeight - HScroll1.Height
  Else
     Picture1.Height = frmpic.ScaleHeight
  End If
  
  If VScroll1.Visible = True Then
     Picture1.Width = frmpic.ScaleWidth - Dir1.Width - VScroll1.Width
  Else
     Picture1.Width = frmpic.ScaleWidth - Dir1.Width
  End If
  
  HScroll1.Top = frmpic.ScaleHeight - HScroll1.Height
  HScroll1.Width = Picture1.Width
  
  VScroll1.Top = Drive1.Top
  VScroll1.Height = Picture1.Height
  VScroll1.Left = frmpic.ScaleWidth - VScroll1.Width
  
End Sub

Private Sub Image1_dblClick(Index As Integer)
  Frmpicqry.Show vbModal
End Sub

Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim i As Integer
  Dim imgcount As Integer
  
  imgcount = 0
  For i = 0 To frmpic.Controls.Count - 1
      If TypeOf frmpic.Controls(i) Is Image Then imgcount = imgcount + 1
  Next
  For i = 0 To imgcount - 1
      Image1(i).BorderStyle = 0
  Next
  Image1(Index).BorderStyle = 1
End Sub

Private Sub VScroll1_Change()
    Frame1.Top = -VScroll1.Value
    If Frame1.Top = 0 Then Frame1.Top = frameini(1)
End Sub

Private Sub HScroll1_Change()
    Frame1.Left = -HScroll1.Value
End Sub