浏览文件夹中的图片 首先要新建一个工程,在Form1中添加dirlistbox控件,drivelistbox控件,filelistbox控件,combobox控件,textbox控件,vscrollbar控件和一个command1控件Option Explicitprivate Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Longprivate Const MAX_PATH = 260private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Typeprivate Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End TypeDim Pic As Object Private Sub Command1_Click() Dim obj As Object Dim pcname As String Dim i As Long, j As Long, counter As Long Dim wfd As WIN32_FIND_DATA Dim source As String, piname As String Dim hfile As Long Dim nfile As Long Dim filename() As String Dim x As Long, length1 As Long, width1 As Longcounter = 0 Set Pic = Form1.Controls.Add("VB.PictureBox", "test") Pic.Visible = True If Right(Dir1.Path, 1) <> "\" Then source = Dir1.Path & "\" & Text1.Text Else source = Dir1.Path & Text1.Text End Ifhfile = FindFirstFile(source, wfd) If hfile = -1 Then MsgBox "没有找到文件" End If counter = counter + 1 Do nfile = FindNextFile(hfile, wfd) If nfile <> 0 Then counter = counter + 1 End If Loop Until nfile = 0 ReDim filename(counter) As String hfile = FindFirstFile(source, wfd) filename(0) = wfd.cFileName For i = 1 To counter nfile = FindNextFile(hfile, wfd) filename(i) = wfd.cFileName Next i If Right(Dir1.Path, 1) <> "\" Then source = Dir1.Path & "\" Else source = Dir1.Path End If Call FindClose(hfile)For i = 0 To (counter / 4) For j = 0 To 3 piname = "picture" & j + 1 + i * 4 Set obj = Form1.Controls.Add("VB.Image", piname) obj.Width = 1500 obj.Height = 1500 obj.Stretch = True Set obj.Container = Pic obj.Left = j * obj.Width obj.Top = i * obj.Height If (j + 1 + i * 4) > counter Then GoTo line End If obj.Picture = LoadPicture(source & (filename(j + 1 + i * 4))) obj.Visible = True Next j Next i line: width1 = j * obj.Width length1 = i * obj.Height Pic.Width = 4 * obj.Width Pic.Height = length1 Pic.Left = Dir1.Left + Dir1.Width Pic.Top = 0 width1 = 4 * obj.Width length1 = i * obj.Height VScroll1.Min = 0 VScroll1.Max = 32767 End Sub Private Sub Dir1_Change() File1.filename = Dir1.Path End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub Form_Load() Combo1.Text = "*.jpg" Combo1.AddItem "*.bmp" Combo1.AddItem "*.gif" VScroll1.LargeChange = 200 VScroll1.SmallChange = 50 Text1.Text = Combo1.Text End Sub Private Sub VScroll1_Change() Pic.Top = 0 - VScroll1.Value End Sub
Option Explicit Dim i As Integer Const TextCount As Integer = 10 Const TextVisible As Integer = 4 Dim firstTop As IntegerPrivate Sub Form_Load() For i = 0 To 9 Text1(i) = i Next i firstTop = Text1(0).Top With VScroll1 .SmallChange = Int(Text1(1).Top - Text1(0).Top) .Min = 0 .Max = .SmallChange * (TextCount - TextVisible) End With End SubPrivate Sub VScroll1_Change() For i = 0 To 9 Text1(i).Top = VScroll1.SmallChange * i - VScroll1.Value + firstTop Text1(i).Visible = Text1(i).Top > 0 Next i End Sub
首先要新建一个工程,在Form1中添加dirlistbox控件,drivelistbox控件,filelistbox控件,combobox控件,textbox控件,vscrollbar控件和一个command1控件Option Explicitprivate Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Longprivate Const MAX_PATH = 260private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Typeprivate Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End TypeDim Pic As Object
Private Sub Command1_Click()
Dim obj As Object
Dim pcname As String
Dim i As Long, j As Long, counter As Long
Dim wfd As WIN32_FIND_DATA
Dim source As String, piname As String
Dim hfile As Long
Dim nfile As Long
Dim filename() As String
Dim x As Long, length1 As Long, width1 As Longcounter = 0
Set Pic = Form1.Controls.Add("VB.PictureBox", "test")
Pic.Visible = True
If Right(Dir1.Path, 1) <> "\" Then
source = Dir1.Path & "\" & Text1.Text
Else
source = Dir1.Path & Text1.Text
End Ifhfile = FindFirstFile(source, wfd)
If hfile = -1 Then
MsgBox "没有找到文件"
End If
counter = counter + 1
Do
nfile = FindNextFile(hfile, wfd)
If nfile <> 0 Then
counter = counter + 1
End If
Loop Until nfile = 0
ReDim filename(counter) As String
hfile = FindFirstFile(source, wfd)
filename(0) = wfd.cFileName
For i = 1 To counter
nfile = FindNextFile(hfile, wfd)
filename(i) = wfd.cFileName
Next i
If Right(Dir1.Path, 1) <> "\" Then
source = Dir1.Path & "\"
Else
source = Dir1.Path
End If
Call FindClose(hfile)For i = 0 To (counter / 4)
For j = 0 To 3
piname = "picture" & j + 1 + i * 4
Set obj = Form1.Controls.Add("VB.Image", piname)
obj.Width = 1500
obj.Height = 1500
obj.Stretch = True
Set obj.Container = Pic
obj.Left = j * obj.Width
obj.Top = i * obj.Height
If (j + 1 + i * 4) > counter Then
GoTo line
End If
obj.Picture = LoadPicture(source & (filename(j + 1 + i * 4)))
obj.Visible = True
Next j
Next i
line:
width1 = j * obj.Width
length1 = i * obj.Height
Pic.Width = 4 * obj.Width
Pic.Height = length1
Pic.Left = Dir1.Left + Dir1.Width
Pic.Top = 0
width1 = 4 * obj.Width
length1 = i * obj.Height
VScroll1.Min = 0
VScroll1.Max = 32767
End Sub
Private Sub Dir1_Change()
File1.filename = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
Combo1.Text = "*.jpg"
Combo1.AddItem "*.bmp"
Combo1.AddItem "*.gif"
VScroll1.LargeChange = 200
VScroll1.SmallChange = 50
Text1.Text = Combo1.Text
End Sub
Private Sub VScroll1_Change()
Pic.Top = 0 - VScroll1.Value
End Sub
Dim i As Integer
Const TextCount As Integer = 10
Const TextVisible As Integer = 4
Dim firstTop As IntegerPrivate Sub Form_Load()
For i = 0 To 9
Text1(i) = i
Next i
firstTop = Text1(0).Top
With VScroll1
.SmallChange = Int(Text1(1).Top - Text1(0).Top)
.Min = 0
.Max = .SmallChange * (TextCount - TextVisible)
End With
End SubPrivate Sub VScroll1_Change()
For i = 0 To 9
Text1(i).Top = VScroll1.SmallChange * i - VScroll1.Value + firstTop
Text1(i).Visible = Text1(i).Top > 0
Next i
End Sub