窗体一个Image，一个Lits。代码如下：
Option Explicit
Dim CC1 As Boolean
Private Sub Find1(MyPath As String)
On Error Resume Next
Dim Myname As String
Dim dir_i() As String
Dim I As Long
Dim S As String
Dim idir As Long
If Right(MyPath, 1) <> "\" Then MyPath = MyPath + "\"
Myname = Dir(MyPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
Do While Myname <> ""
If Myname <> "." And Myname <> ".." Then
If (GetAttr(MyPath & Myname) And vbDirectory) = vbDirectory Then
idir = idir + 1
ReDim Preserve dir_i(idir) As String
dir_i(idir - 1) = Myname
Else
S = UCase$(Right$(Myname, Len(Myname) - InStrRev(Myname, ".")))
If S = "JPG" Then List1.AddItem MyPath & Myname
If List1.ListCount > 32760 Then Exit Sub
End If
End If
Myname = Dir
'DoEvents
Loop
For I = 0 To idir - 1
Call Find1(MyPath + dir_i(I))
Next I
ReDim dir_i(0) As String
End Sub
Private Sub Form_Load()
List1.Visible = False
CC1 = True
End Sub
Private Sub Form_Resize()
If Me.WindowState <> 1 Then
Image1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
List1.Move 0, 0
End If
Me.Caption = CStr(Me.ScaleWidth \ 10) & "x" & CStr(Me.ScaleHeight \ 10)
End Sub
Private Sub Form_Unload(Cancel As Integer)
CC1 = True
End Sub
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim I As Integer
If Button = 1 Then
CC1 = Not CC1
If List1.ListCount > 0 Then
For I = 0 To List1.ListCount - 1
If CC1 Then
Exit For
Else
Image1.Picture = LoadPicture(List1.List(I))
End If
Me.Caption = CStr(I + 1) & "/" & List1.ListCount
DoEvents
Next I
End If
CC1 = True
ElseIf Button = 2 Then
List1.Visible = Not List1.Visible
End If
End Sub
Private Sub Image1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim T1 As String
Dim S As String
Dim I As Integer
For I = 1 To Data.Files.Count
T1 = Data.Files(I)
If (GetAttr(T1) And vbDirectory) = vbDirectory Then
Find1 T1
Else
S = UCase$(Right$(T1, Len(T1) - InStrRev(T1, ".")))
If S = "JPG" Then List1.AddItem T1
End If
Next
Me.Caption = List1.ListCount
End Sub
Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
CC1 = True
List1.Clear
Me.Caption = "0"
End If
End Sub
