Option Explicit
 
Dim WithEvents picBig As PictureBox
Dim WithEvents picscroller As HScrollBar
Dim pics As Collection 'Bilddateien
Dim imgLoaded As StdPicture
 
Private Sub Form_Load()
 
Me.ScaleMode = vbPixels
Me.Width = 9000: Me.Height = 9000
Me.ScaleWidth = 600: Me.ScaleHeight = 600
Me.BorderStyle = 1
 
Set picBig = Me.Controls.Add("VB.PictureBox", "PicBig", Me)
Set picscroller = Me.Controls.Add("VB.HScrollbar", "PicScroller", Me)
 
With picscroller
   .Top = 0: .Left = 0: .Width = 590: .Visible = False
End With
With picBig
   .Top = 25: .Left = 5: .Width = 590: .Height = 450
   .ScaleMode = vbPixels
End With
 
Set pics = GetPicFiles(App.Path & "\Bilder")
If pics.Count < 1 Then
    MsgBox "Keine Bilddateien im Ordner"
Else
   If pics.Count > 1 Then
      With picscroller
       .Min = 1: .Max = pics.Count: .Value = 1: .Visible = True
      End With
   End If
End If
 
End Sub
 
Private Sub PicLoad(pbox As PictureBox, ByVal index As Integer)
 
    Dim w As Long, h As Long, wp As Long, hp As Long
    On Error GoTo fehler
    If index < 1 Or index > pics.Count Then
        pbox.Visible = False: Exit Sub
    End If
    Set imgLoaded = LoadPicture(pics(index))
    'Bild in Picturebox einpassen
    w = imgLoaded.Width: h = imgLoaded.Height
    hp = pbox.Height: wp = w / h * pbox.Height
    If wp > pbox.Width Then
       hp = h / w * pbox.Width: wp = pbox.Width
    End If
 
    With pbox
       .AutoRedraw = True: .Picture = LoadPicture
       Call .PaintPicture(imgLoaded, 0, 0, wp, hp)
       .Picture = .Image: .AutoRedraw = False
       .Visible = True
    End With
fehler:
 
End Sub
 
Private Function GetPicFiles(ByVal folderspec As String) As Collection
    'Bilddateien im Ordner ermitteln (BMP, JPG)
    Dim fs, f, f1, fc, piccol As Collection, fn As String
    Set piccol = New Collection
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    For Each f1 In fc
        fn = UCase(f1.Name)
        If InStr(fn, ".JPG") > 0 Or InStr(fn, ".BMP") > 0 Then
           Call piccol.Add(f1.Path)
        End If
    Next f1
    Set GetPicFiles = piccol
End Function
 
 
Private Sub picscroller_Change()
    'Das neue Scroller-Event
    Call PicLoad(picBig, picscroller.Value)
    Call PicLoad(picNext, picscroller.Value + 1)
    Call PicLoad(picPrior, picscroller.Value - 1)
    Me.Caption = pics(picscroller.Value)
End Sub
 
Private Sub picNext_MouseDown(Button As Integer, _
     Shift As Integer, X As Single, Y As Single)
     Dim pv As Integer
     pv = picscroller.Value
     If pv < picscroller.Max Then picscroller.Value = pv + 1
End Sub
 
Private Sub picPrior_MouseDown(Button As Integer, _
     Shift As Integer, X As Single, Y As Single)
     Dim pv As Integer
     pv = picscroller.Value
     If pv > 1 Then picscroller.Value = pv - 1
End Sub