【VB开源代码栏目提醒】：网学会员,鉴于大家对VB开源代码十分关注，论文会员在此为大家搜集整理了“VB图片浏览代码 - 讲义教程”一文，供大家参考学习!

Option Explicit Dim filepath As String filename As String Dim i As Integer Dim picname As String Dim a As Integer Dim ex As String Dim fs As New FileSystemObject Dim aa As Integer Private Sub cmdnext_ClickIndex As Integer If Fil.ListIndex Fil.ListCount - 1 Then Fil.ListIndex Fil.ListIndex 1 Else Fil.ListIndex 0 End If End Sub Private Sub cmdopen_ClickIndex As Integer Call filcount If a 0 Then tmrplay.Enabled True Else MsgBox 此文件夹内没有支持的图片文件不能用幻灯片演示 48 错误 Exit Sub End If End Sub Private Sub cmdplay_ClickIndex As Integer Call filcount If a 0 Then tmrplay.Enabled True Else MsgBox 此文件夹内没有支持的图片文件不能用幻灯片演示 48 错误 Exit Sub End If End Sub Private Sub cmdprv_ClickIndex As Integer If Fil.ListIndex 0 Then Fil.ListIndex Fil.ListIndex - 1 Else Fil.ListIndex Fil.ListCount - 1 End If End Sub Private Sub cmdquit_ClickIndex As Integer End End Sub Private Sub Command1_ClickIndex As Integer tmrplay.Enabled False End Sub Private Sub Dir_Change Fil.Path Dir.Path End Sub Private Sub drv_Change Dir.Path drv.Drive End Sub Private Sub Fil_Click Dim ex As String Dim fs As New FileSystemObject picname Fil.Path Fil.filename ex fs.GetExtensionNameFil.filename If ex bmp Or ex jpg Or ex gif Then imgplay.Picture LoadPicturepicname Else MsgBox 图片格式不正确请重新选择 48 错误 Exit Sub End If aa Fil.ListIndex End Sub Private Sub Form_Load tmrplay.Enabled False End Sub Private Sub imgplay_Click dlg.InitDir Fil.Path dlg.Filter 所有图片文件.jpg.bmp.gif.jpg.bmp.gifjpeg文件.jpg.jpgbmp文件.bmp.bmpgif文件.gif.gif dlg.ShowOpen If dlg.filename Then Fil.Refresh filename dlg.filename For i Lenfilename To 1 Step -1 If Midfilename i 1 Then If i 3 Then filepath Midfilename 1 i Else filepath Midfilename 1 i - 1 End If Exit For End If Next i drv.Drive filepath Dir.Path filepath Fil.Path filepath imgplay.Picture LoadPicturefilename End If End Sub Private Sub filcount Fil.ListIndex 0 For i 0 To Fil.ListCount - 1 picname Fil.Path Fil.filename ex fs.GetExtensionNameFil.filename ex LCaseex If ex bmp Or ex jpg Or ex gif Then a a 1 Next i End Sub Private Sub tmrplay_Timer If Fil.ListIndex Fil.ListCount - 1 Then Fil.ListIndex Fil.ListIndex 1 Else Fil.ListIndex 0 End If End Sub