📄 frmpic2.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 + -