Option Explicit
 
Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" (ByVal hWnd As Long, _
        ByVal lpOperation As String, ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long _
        ) As Long
 
 
Dim selected_index  'Index der zuletzt angeklickten Bitmap
Dim stop_read, PopMenu As Boolean
Dim stretch As Boolean, Summe%
Dim fso As New FileSystemObject   'Zugang zu FSO-Objekten

 
 
Private Sub Form_Load()
 ' stretch = True
End Sub

 
Private Sub mnuStop_Click()
    stop_read = True
End Sub

 
'Spaltenkopf: A - Z oder Z - A
Private Sub ListV_ColumnClick(ByVal ColumnHeader As ColumnHeader)
  If ListV.SortKey = ColumnHeader.Index - 1 Then
    ListV.SortOrder = 1 - ListV.SortOrder
  Else
    ListV.SortKey = ColumnHeader.Index - 1
    ListV.SortOrder = lvwAscending
  End If
  ListV.Sorted = True
End Sub

 
Private Sub ListV_ItemClick(ByVal Item As ListItem)
  selected_index = Item.Index
End Sub

 
Private Sub mnuRaster_Click()
    'Linien in ListView1 ein- od. ausschalten
    If mnuRaster.Checked Then
       ListV.GridLines = False
       mnuRaster.Checked = False
    Else
       ListV.GridLines = True
       mnuRaster.Checked = True
       ListV.Font.Size = 9: ListV.View = lvwReport
       mnuReport_Click
    End If
End Sub

 
Private Sub mnuList_Click()
    ListV.Font.Size = 9: ListV.View = lvwList
    mnuSmallSymbols.Checked = False: mnuSymbols.Checked = False
    mnuList.Checked = True: mnuReport.Checked = False
    ListV.GridLines = False
End Sub

 
Private Sub mnuSmallSymbols_Click()
    ListV.View = lvwSmallIcon
    ListV.GridLines = False
    mnuSmallSymbols.Checked = True: mnuSymbols.Checked = False
    mnuList.Checked = False: mnuReport.Checked = False
End Sub

 
Private Sub mnuSymbols_Click()
    ListV.View = lvwIcon
    mnuSmallSymbols.Checked = False: mnuSymbols.Checked = True
    mnuList.Checked = False: mnuReport.Checked = False
    ListV.GridLines = False
End Sub

 
Private Sub mnuReport_Click()
    ListV.Font.Size = 9: ListV.View = lvwReport
    mnuSmallSymbols.Checked = False: mnuSymbols.Checked = False
    mnuList.Checked = False: mnuReport.Checked = True
End Sub

Private Sub mnu32_Click()
    Picture2.Width = 615: Picture2.Height = 570
    ListV.Font.Size = 7: ReadListView
End Sub

 
Private Sub mnu48_Click()
    Picture2.Width = 858: Picture2.Height = 795
    ListV.Font.Size = 7: ReadListView
End Sub

 
Private Sub mnu64_Click()
    Picture2.Width = 1100: Picture2.Height = 1020
    ListV.Font.Size = 8: ReadListView
End Sub

 
Private Sub mnu96_Click()
    Picture2.Width = 1635: Picture2.Height = 1515
    ListV.Font.Size = 10: ReadListView
End Sub

Private Sub mnu128_Click()
    Picture2.Width = 2169: Picture2.Height = 2010
    ListV.Font.Size = 12: ReadListView
End Sub

 
Private Sub mnuStretch_Click()
    If stretch = True Then
       stretch = False
       mnuStretch.Checked = False
    Else
       stretch = True
       mnuStretch.Checked = True
    End If
    ReadListView
End Sub

 
Private Sub Drive1_Change()
   Dir1.Path = Drive1.Drive
End Sub

Private Sub Dir1_MouseDown(Button As Integer, Shift As Integer, _
                                         X As Single, Y As Single)
  'Verzeichniswechsel per einfachen Mausklick
  Dir1.Path = Dir1.List(Dir1.ListIndex)
  ReadListView
End Sub

 
Sub ReadListView()          'Pfadwechsel
     ReadListV Dir1.Path
End Sub

 
' Bitmaps suchen und einfügen
Sub ReadListV(pth$)
  On Error Resume Next
  Dim litem As ListItem, but As Button
  Dim fld As Folder, fil As File
  Dim typ$, filnam$
  Dim i&, iconb&, iconh&, b&, h&, x0&, y0&, siconb&, siconh&
  Dim lastupdate&
  Dim bz, hz
   StBar.Panels(2).Text = "Kein Objekt markiert"
  Summe = 0
  lastupdate = Timer
  MousePointer = 13
  stop_read = False
  mnuStop.Enabled = True
  ' Initialisierungsarbeiten
  iconb = Picture2.ScaleWidth: iconh = Picture2.ScaleHeight
  siconb = Picture3.ScaleWidth: siconh = Picture3.ScaleHeight
  ListV.ListItems.Clear                'ListView löschen
  ListV.Icons = ListImagesDummy
  ListV.SmallIcons = ListImagesDummy
  ListImagesBig.ListImages.Clear       'Icon-Feld löschen
  ListImagesBig.ImageWidth = iconb
  ListImagesBig.ImageHeight = iconh
  ListImagesBig.MaskColor = ListV.BackColor
  ListImagesSmall.ListImages.Clear     'Icon-Feld löschen
  ListImagesSmall.ImageWidth = siconb
  ListImagesSmall.ImageHeight = siconh
  ListImagesSmall.MaskColor = ListV.BackColor
  If Right(pth, 1) <> "\" Then pth = pth + "\"
  Set fld = fso.GetFolder(pth)
  For Each fil In fld.Files
    filnam = fil.Name
    If Len(filnam) > 4 Then
      typ = LCase(Right(filnam, 3))
      'Suchmaske
      If typ = "bmp" Or typ = "ico" Or typ = "gif" Or typ = "jpg" _
                                 Or typ = "cur" Or typ = "wmf" Then
        i = i + 1
        'Bitmap laden
        Picture1.Picture = LoadPicture(pth + filnam)
        If Err <> 0 Then
          Picture1.Picture = BildFehler.Picture: Err = 0
        End If
        'Bitmap für großes Icon stretchen
        b = Picture1.ScaleWidth: h = Picture1.ScaleHeight
        Picture2.BackColor = &HE0E0E0  'Hintergrundsfarbe
        Picture2.AutoRedraw = True
        If Not stretch Then
          If Picture1.Width < Picture2.Width And _
                        Picture1.Height < Picture2.Height Then
             Picture2.PaintPicture Picture1.Picture, _
             (Picture2.ScaleWidth / 2) - (Picture1.ScaleWidth / 2), _
             (Picture2.ScaleHeight / 2) - (Picture1.ScaleHeight / 2 _
             ) ', iconb, iconh, 0, 0, b * 2, h * 2
 
          ElseIf h > b Then                       'Höhe
             bz = b / (h / iconh)
             x0 = (iconb - bz) / 2   ' zentrieren
             Picture2.PaintPicture Picture1.Picture, x0, 0, _
                                       iconb, iconh, 0, 0, h, h
          ElseIf b = h Then
             Picture2.PaintPicture Picture1.Picture, 0, 0, _
                                       iconb, iconh, 0, 0, b, h
          ElseIf b > h Then                  'Breite
             hz = h / (b / iconb)
             y0 = (iconh - hz) / 2
             Picture2.PaintPicture Picture1.Picture, 0, y0, _
                                       iconb, iconh, 0, 0, b, b
          End If
       Else
          Picture2.PaintPicture Picture1.Picture, 0, 0, _
                                       iconb, iconh, 0, 0, b, h
       End If
       Picture2.Refresh: Picture2.AutoRedraw = False
       ListImagesBig.ListImages.Add i, , Picture2.Image
       Picture2.Picture = LoadPicture(): Picture2.Cls
        'dasselbe für kleines Icons
        Picture3.BackColor = RGB(255, 255, 255)
        Picture3.AutoRedraw = True
        Picture3.PaintPicture Picture1.Picture, 0, 0, _
                                       siconb, siconh, 0, 0, b, h
        Picture3.Refresh: Picture3.AutoRedraw = False
        ListImagesSmall.ListImages.Add i, , Picture3.Image
        If i = 1 Then
          ListV.Icons = ListImagesBig
          ListV.SmallIcons = ListImagesSmall
        End If
        'ListView-Einträge: Name, Datum, Größe
        Set litem = ListV.ListItems.Add(, , filnam, i, i)
        litem.SubItems(1) = Space(10 - Len(Str(fil.Size))) & _
                                                          fil.Size
        litem.SubItems(2) = Format(fil.DateLastModified, _
                                                "yy-mm-dd  hh:nn")
        litem.SubItems(3) = Space(6 - Len(Str(b))) & b
        litem.SubItems(4) = Space(6 - Len(Str(h))) & h
        Summe = litem.Index
        If Summe < 2 Then
           StBar.Panels(1).Text = Summe & "   Bilddatei"
        Else
            StBar.Panels(1).Text = Summe & "   Bilddateien"
        End If
        StBar.Panels(2).Text = "  Bilder werden geladen"
        If (i Mod 5) = 0 And Timer - lastupdate > 2 Then
          DoEvents: If stop_read Then Exit For
          lastupdate = Timer
        End If
      End If
    End If
  Next
  If Summe = 0 Then StBar.Panels(1).Text = " 0  Objekt(e)"
  StBar.Panels(2).Text = "Kein Objekt markiert"
  mnuStop.Enabled = False
  MousePointer = 0
End Sub

 
Private Sub ListV_DblClick()
    MsgBox (ListV.ListItems(selected_index) + vbCrLf + _
                "Hier könnte eine Form geöffnet werden!"), _
                vbInformation, "Thumbnails"
End Sub

 
Private Sub ListV_MouseDown(Button As Integer, Shift As Integer, _
                                         X As Single, Y As Single)
            'Popup-Menü Datei
  If Button = vbRightButton Then
    PopMenu = True
  End If
End Sub

 
Private Sub ListV_Click()
  On Error Resume Next
  Dim Path$, Datei$
  Path$ = Dir1.Path
  If Right(Path, 1) <> "\" Then Path = Path + "\"
  If selected_index <> "" Then _
                 Datei$ = Path$ + ListV.ListItems(selected_index)
  StBar.Panels(2).Text = " Adresse: " & Datei$
  'Mit diesem Trick läßt sich der Rechtsklick als Click-Event
  'mit PopMenu verwirklichen ;-)
  If PopMenu = True Then
     Me.PopupMenu mnuView
     MsgBox (ListV.ListItems(selected_index) + vbCrLf + _
     "Click-Event und PopMenu ;-)"), vbInformation, "Thumbnails"
  End If
  PopMenu = False
End Sub

 
          ' neue Fenstergröße
Private Sub Form_Resize()
  Dim f As Form
  If WindowState = vbMinimized Then Exit Sub
          ' das sind Twips (ScaleMode=1 für Formular)
  If Width < 3000 Then Width = 3000: Exit Sub
  If Height < 2250 Then Height = 2250: Exit Sub
  SplitLine.Top = 400
  Dir1.Top = 400
  ListV.Top = 400
  If SplitLine.Left > ScaleWidth - 1500 Then
    ChangeSplitting ScaleWidth - 1500
  End If
  Dir1.Height = ScaleHeight - Dir1.Top - StBar.Height
  ListV.Height = ScaleHeight - ListV.Top - StBar.Height
  ListV.Width = ScaleWidth - ListV.Left - 45
  Drive1.Width = ScaleWidth - 180
  SplitLine.Height = ScaleHeight - SplitLine.Top - StBar.Height
End Sub

 
' Schiebebalken zwischen Dir1 und ListView verändern
Private Sub Dir1_DragDrop(Source As Control, X As Single, Y As Single)
  ChangeSplitting Dir1.Left + X
End Sub

Private Sub ListV_DragDrop(Source As Control, X As Single, Y As Single)
  ChangeSplitting ListV.Left + X
End Sub

Sub ChangeSplitting(X)
  If X < 50 Then X = 50
  If X > ScaleWidth - 50 Then X = ScaleWidth - 50
  Dir1.Width = X - 30
  SplitLine.Left = X
  ListV.Left = SplitLine.Left + SplitLine.Width
  ListV.Width = ScaleWidth - ListV.Left
End Sub