⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmpic2.frm

📁 手机话费管理系统!!!管理你的手机通话!!值得一看!!~
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frmpic 
   Caption         =   "Form1"
   ClientHeight    =   4950
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6645
   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 
         Height          =   1320
         Left            =   0
         TabIndex        =   6
         Top             =   -90
         Visible         =   0   'False
         Width           =   1445
         Begin VB.Image Image1 
            BorderStyle     =   1  'Fixed Single
            Height          =   1320
            Index           =   0
            Left            =   0
            Stretch         =   -1  'True
            Top             =   0
            Visible         =   0   'False
            Width           =   1445
         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;*.jpg;*.gif;*.wmf;*.ico"
      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
Function Max(A, B)
    Max = B
    If A > B Then Max = A
End Function
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 = ccArrowHourglass
  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)
      End If
  Next
  
  Frame1.Left = 0
  Frame1.Top = -90
  Frame1.Height = Image1(0).Height
  Frame1.Width = Image1(0).Width
  Frame1.Visible = False
  
  Image1(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 - Image1(0).Width) \ Image1(0).Width
  
  Image1(0).Visible = True
  Frame1.Visible = True
  
  If Right(Dir1.Path, 1) = "\" Then
     Image1(0).Picture = LoadPicture(Dir1.Path & File1.List(0))
  Else
     Image1(0).Picture = LoadPicture(Dir1.Path & "\" & File1.List(0))
  End If
  
  For i = 1 To File1.ListCount - 1
      If IsLoaded(Image1(i)) = False Then
         Load Image1(i)
         If (rowcount = 0 And colcount = 0) Then colcount = 1
         If (rowcount = 0) Then Frame1.Width = Image1(0).Width * (colcount + 1)
         
         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
         
         Image1(i).Left = Image1(0).Left + Image1(0).Width * colcount
         Image1(i).Top = Image1(0).Top + Image1(0).Height * rowcount
         
         If Right(Dir1.Path, 1) = "\" Then
            Image1(i).Picture = LoadPicture(Dir1.Path & File1.List(i))
         Else
            Image1(i).Picture = LoadPicture(Dir1.Path & "\" & File1.List(i))
         End If
         
         Image1(i).Visible = True
         
         colcount = colcount + 1
         If (colcount > colnum) Then
            colcount = 0
            rowcount = rowcount + 1
            Frame1.Height = Image1(0).Height * rowcount
            
            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_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 VScroll1_Change()
    Frame1.Top = -VScroll1.Value
End Sub

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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -