Hallo herpes(???),
ich hab das auch schon mal programmiert. Dazu hatte ich in einem Formular eine PictureBox, die als Container für viele kleine ImageBoxen (als Array) fungiert hat. Ich hab allerdings die Pfadnamen der Bilder aus einer Datenbank gelesen. Die Kernfunktion findest du unten.
Grüße, Tom
’ ---------------------------------------------------------------------------
’ Funktion: füllePBox
’ Beschreibung: Füllt PictureBox mit Bildern aus akt. Kategorie
’ ---------------------------------------------------------------------------
Public Function füllePBox(ByVal frm As Form, ByVal pb As PictureBox, ByVal key As String, ByVal feld As String) As Long
Dim wrkJet As Workspace, db As Database, bld As Recordset
Dim keyStr As String, n As Long, breit As Integer
Dim bild As String, zeilenGesamt As Integer, zeilenSichtbar As Integer
’ für Thumbnails
Dim newLeft As Integer
Dim newTop As Double
Dim newLblTop As Double
’ Startwerte setzen
zeilenGesamt = 1
zeilenSichtbar = 1
newLeft = g_abstand_X
newTop = CDbl(g_abstand_X)
newLblTop = frm.imgName(0).Top
breit = frm.imgBox(0).width + g_abstand_X
g_cancelLoad = False
’ erstes Array-Item in pBox unsichtbar machen
frm.imgBox(0).Visible = False
frm.imgName(0).Visible = False
’ vorhandene pBox leeren
If frm.imgBox.Count > 1 Then 'if there are more than one images then
For n = 1 To frm.imgBox.Count - 1 'make the picture control
If Not frm.imgBox(n) Is Nothing Then Unload frm.imgBox(n)
If Not frm.imgName(n) Is Nothing Then Unload frm.imgName(n)
Next
End If
’ Datenbank und Recordset setzen
Set wrkJet = CreateWorkspace("", „admin“, „“, dbUseJet)
Set db = wrkJet.OpenDatabase(g_datenbank)
Set bld = db.OpenRecordset(„tbl_Bilder“)
’ ermittle Primkey der Kategorie (in Key des TreeNode versteckt)
n = Len(key) - InStr(key, „_“)
keyStr = Right(key, n)
’ falls PrimKey nicht ermittelt, diesen auf 0 setzen (z.B. bei Kategorien-Root)
If n = Len(key) Then keyStr = „0“
’ Abfrage nach Bildern
Set bld = db.OpenRecordset("SELECT * FROM tbl_Bilder WHERE " & feld & " = " & keyStr)
’ nur wenn’s auch Bilder gibt
If bld.RecordCount > 0 Then
’ Schleife über die Bilder
While Not bld.EOF
’ vor dem hinzufügen des nächsten Bildes Ereignisse abarbeiten
’ und prüfen, ob Abbruch gewünscht sit
DoEvents
If g_cancelLoad Then GoTo halt
’ Bildname und -pfad setzen
bild = bld![B\_Pfad] & „“ & bld![B\_Name]
’ Bild und Label zur PictureBox hinzufügen
If bld.RecordCount > 1 Then Load frm.imgBox(bld.RecordCount - 1)
If bld.RecordCount > 1 Then Load frm.imgName(bld.RecordCount - 1)
’ Bilname in Tooltip setzen
frm.imgBox(bld.RecordCount - 1).ToolTipText = bld![B\_Name]
’ Position links
frm.imgBox(bld.RecordCount - 1).Left = newLeft
frm.imgName(bld.RecordCount - 1).Left = newLeft
’ Position oben
frm.imgBox(bld.RecordCount - 1).Top = newTop
frm.imgName(bld.RecordCount - 1).Top = newLblTop
’ Bild laden und zeigen
frm.imgBox(bld.RecordCount - 1).Picture = LoadPicture(g_thumbDir & „“ & bld![B\_PK] & „.bmp“)
frm.imgBox(bld.RecordCount - 1).Visible = True
’ Label mit Bildnamen besetzen und darstellen
If Len(bld![B\_Name]) frm.pBox.width Then
’ links
newLeft = g_abstand_X
’ oben
newTop = newTop + frm.imgBox(0).height + g_abstand_Y
newLblTop = newLblTop + frm.imgBox(0).height + g_abstand_Y
’ Zeilen zählen
zeilenGesamt = zeilenGesamt + 1
If (newTop + frm.imgBox(0).height + g_abstand_Y) zeilenSichtbar Then
frm.fScrollBar.Max = zeilenGesamt - zeilenSichtbar + 1
Else
frm.fScrollBar.Max = 1
End If
If frm.fScrollBar.Max = 1 Then
frm.fScrollBar.LargeChange = 1
ElseIf frm.fScrollBar.Max > zeilenSichtbar Then
frm.fScrollBar.LargeChange = zeilenSichtbar
Else
frm.fScrollBar.LargeChange = frm.fScrollBar.Max - 1
End If
frm.fScrollBar.Value = 1
'Debug.Print "Zeilen (g,s): " & zeilenGesamt & „,“ & zeilenSichtbar
'Debug.Print "ScrollBar (m,lc): " & frm.fScrollBar.Max & „,“ & frm.fScrollBar.LargeChange
’ refresh the picture control
pb.Refresh
End Function
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]