Option Explicit
Dim Apath As String, Pi As Integer, bZ As Integer
.......
Private Declare Function StretchBlt Lib "GDI32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
//本函数用来对图片进行缩放处理,生成缩略图片
.......
Private Sub CreateThumbs()
//本函数用来创造缩略图片,并且将它们放到足够的 file://缩略图载体com(i)中
Dim lIdx As Long
Dim lFilCnt As Long
Dim sText As String, i As Integer
Screen.MousePointer = vbHourglass
Com(0).Picture = LoadPicture
Com(0).Visible = False
If Com.Count > 1 Then
For i = 1 To Com.Count - 1
Unload Com(i)
Next
End If
$$$AGESEP$$$
//初始化缩略图载体com
On Error Resume Next
file://忽略错误
file://lFilCnt = filHidden.ListCount
For lIdx = 0 To filHidden.ListCount - 1
Load Com(lIdx)
Com(lIdx).Caption = filHidden.List(lIdx)
Com(lIdx).Visible = True
Pr.Value = 1
Next lIdx
DoEvents
Pr.Value = lIdx + 1
Next lIdx
Set picLoad.Picture = LoadPicture()
Set picThumb.Picture = LoadPicture()
Pr.Visible = False
Screen.MousePointer = 0
//释放占用的资源、隐藏进度条、恢复鼠标指针
End Sub
.......
Private Sub filHidden_PathChange()
$$$AGESEP$$$
//当文件目录改变时计算出标准的目录变量
file://显示有关的目录和图片文件个数信息
file://调用缩略图创建过程函数
//......
CreateThumbs
End Sub
Private Sub Form_Resize()
file://本函数用来对程序界面控件位置进行相应的调整
file://并且调整缩略图的位置
Dim X As Long
Dim Y As Long
Dim lIdx As Long
Dim lCols As Long
If Me.WindowState <> vbMinimized Then
If Me.Width < 600 * Screen.TwipsPerPixelX Then
Me.Width = 600 * Screen.TwipsPerPixelX
ElseIf Me.Height < 378 * Screen.TwipsPerPixelY Then
Me.Height = 378 * Screen.TwipsPerPixelY
end if
//限定软件界面的最小宽度和高度
Else
picFrame.Move 2, Command1.Height, Me.ScaleWidth - 11, Me.ScaleHeight - Command1.Height - St.Height
vsbSlide.Move picFrame.ScaleWidth - vsbSlide.Width, 0, vsbSlide.Width, picFrame.ScaleHeight
lCols = Int((picFrame.ScaleWidth - vsbSlide.Width) / Com(0).Width)
For lIdx = 0 To Com.Count - 1
X = (lIdx Mod lCols) * Com(0).Width
Y = Int(lIdx / lCols) * Com(0).Height
Com(lIdx).Move X, Y
Next lIdx
picSlide.Width = lCols * Com(0).Width
picSlide.Height = Int(Com.Count /lCols)*Com(0).Height
If Int(Com.Count / lCols) < (Com.Count / lCols) Then
picSlide.Height = picSlide.Height + Com(0).Height
End If
vsbSlide.Value = 0
vsbSlide.Max = picSlide.Height - picFrame.ScaleHeight
If vsbSlide.Max < 0 Then
vsbSlide.Max = 0
vsbSlide.Enabled = False
Else
vsbSlide.Enabled = True
vsbSlide.SmallChange = Com(0).Height
vsbSlide.LargeChange = picFrame.ScaleHeight
End If
End If
Pr.Top = St.Top + 8
Pr.Left = St.Panels(4).Left + 6
Picture1.Move (picFrame.Width - Picture1.Width) / 2, (picFrame.Height - Picture1.Height) / 2
End Sub
........
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
$$$AGESEP$$$
file://如果被全屏浏览的图片较大时
file://可以用鼠标拖动图片来浏览全貌
ReleaseCapture
SendMessage Picture1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End Sub
.......
Private Sub vsbSlide_Change()
Copyright by netrobo 2001-2002.All right reserved.
http://vb1.myrice.com/article/multimedia/img/019B.jpg
http://vb1.myrice.com/article/multimedia/img/019A.jpg
lx = 0: ly = -1
For i = 0 To File1.ListCount - 1
imgPic.Picture = LoadPicture(File1.Path & "\" & File1.List(i))
If i Mod 5 = 0 Then
lx = 0
ly = ly + 1 '一行显示5个图片,你可以自己改
End If
picView.PaintPicture imgPic.Picture, lx * imgPic.Width, ly * imgPic.Height, imgPic.Width, imgPic.Height
lx = lx + 1
Next
End Sub