Hallo,
folgender Sachverhalt. In einer Datenbank sind Bilder enthalten.
Auf der Form befindet sich ein Listview Steuerelement.
Wenn nun ein Datensatz gewechselt wird, und in der Datenbank sind Bilder vorhanden, so sollen sie als Tumbnail in der Listview angezeigt werden. Beim Klick auf das Tumbnail, wird dann eine neue Form geöffnet und das Bild dann dort in voller Grösse angezeigt. Soweit funktioniert auch alles. Nur die Darstellung im Listview schaut furchtbar aus!
Es lässt sich schwer beschreiben. Aber die Umrandungen von den Bildern, werden als weisse Striche dargestellt! Schaue ich mir das Bild dann aber in normaler Grösse an (Beim Klick auf das Bild) schaut es völlig normal aus!
Weiss jemand wie ich das umgehen kann oder woran das liegt?
Hier der relev. Code
Public Function ZeigeBild(L As ListView, I As ImageList, ID As Integer) As Boolean
'L = das Listview Element
'I = Die dazugehörige ImageList
'ID = Verweis in der DB welches Bild geladen wird
On Error Resume Next
Dim RST As New ADODB.Recordset
Dim sFile As String
Dim vRet As Variant
Dim PicItem As ListItem
Dim vData As Long
L.ListItems.Clear
L.Icons = Nothing
I.ListImages.Clear
I.ImageHeight = 96
I.ImageWidth = 96
I.MaskColor = True
I.BackColor = vbWhite
vData = 1
Call RunSql("SELECT \*FROM Picture WHERE Index=" & ID & ";", RST)
If RST.RecordCount = 0 Then Exit Function
RST.MoveFirst
Do While Not RST.EOF
vRet = RST.Fields("Bild").Value
If IsNull(vRet) Or Trim(CStr(vRet)) = "" Then
Set Temp.Image3.Picture = Temp.noPicture.Picture
Else
If Not (Showpicture(Temp.Image3, CStr(vRet))) Then Set Temp.Image3.Picture = Temp.noPicture.Picture
End If
I.ListImages.Add , , Temp.Image3.Picture
Set L.Icons = I
If CStr(RST.Fields("Description").Value) = "" Then
vRet = "Bild " & CStr(vData)
Else
vRet = RST.Fields("Description").Value
End If
Set PicItem = L.ListItems.Add(, , CStr(vRet), I.ListImages.Count)
Set vRet = Nothing
PicItem.SubItems(1) = CStr(RST.Fields("Typ").Value)
PicItem.SubItems(2) = CStr(RST.Fields("Mime").Value)
PicItem.SubItems(3) = CStr(vData)
vData = vData + 1
RST.MoveNext
Loop
L.Icons = I
ZeigeBild = True
On Error GoTo 0
End Function
Public Function Showpicture(Picture As Control, ByVal sInhalt As String) As Boolean
Dim f As Integer
Dim sFile As String
sFile = GetTempFile("PIC")
f = FreeFile
Open sFile For Output As #f
Print #f, sInhalt;
Close #f
Picture.Picture = LoadPicture(sFile)
Kill sFile
Showpicture = True
End Function
Public Function GetTempFile(Syntax As String) As String
Dim myTempFileName As String
myTempFileName = Space$(256)
Call GetTempFileName(Environ("TEMP"), Syntax, 0&, myTempFileName)
GetTempFile = Left$(myTempFileName, InStr(myTempFileName, Chr$(0)) - 1)
End Function
MfG Alex