Hallo Leute,
erstmal danke an Shardik, das mit dem Icons läuft.
Nun habe ich aber ein kleines Problem, welches ich mir nicht richtig erklären kann.
solange ich ohne Thread ein Verzeichnis und deren Icons auslese läuft alles wie gewollt,
lasse ich das aber über einen Thread auslesen, werden bei mir manche Icons nicht mehr ausgelesen z.b. für (PNG, AVI, JPG) und auch nur die
woran kann das liegen ?
hier ein lauffähiges Beispiel einmal ohne Thread:
Code: Alles auswählen
EnableExplicit
Structure File ; File Infomation
Name.s : Datum.s : Typ.s : Size.s : FileA.i : pos.i : Image.i : Attibut.i
EndStructure
Global Dim Dummy.file(0)
Procedure Callback(hwnd, msg, wparam, lparam)
Protected *hdr.NMHDR, *di.NMLVDISPINFO, str.i
If msg = #WM_NOTIFY
*hdr = lparam
If *hdr\code = #LVN_GETDISPINFO
*di = lparam
Select *di\item\iSubItem ; Structur auslesen
Case 0
If dummy(*di\item\iItem)\Image<>-1 ; Icons überprüfen
*di\item\iImage =dummy(*di\item\iItem)\Image
EndIf
str.i = @dummy(*di\item\iItem)\Name
Case 1
str.i = @dummy(*di\item\iItem)\Typ
Case 2
str.i = @dummy(*di\item\iItem)\Datum
Case 3
str.i = @dummy(*di\item\iItem)\Size
EndSelect
*di\item\pszText = str
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure VerzeichnisEinlesen (Gadget,Pfad.s,Array this.file(1))
Protected file.i,Icon.SHFILEINFO, Imagelist
ImageList_Destroy_(Imagelist) : imagelist = ImageList_Create_(16, 16, #ILC_COLOR32, 100, 1000 )
If ExamineDirectory(0,Pfad, "*.*")
;Verzeichnis öffnen und einlesen
While NextDirectoryEntry(0)
;Folder im liste eintragen
If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory And DirectoryEntryName(0)<>"."
With this(file)
\Image =-1
\FileA =1
\Name =DirectoryEntryName(0)
SHGetFileInfo_(Pfad+\Name, 0, @Icon.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_TYPENAME|#SHGFI_ICON |#SHGFI_SMALLICON)
\Datum =" "
\Size =" "
\Typ ="Folder"
\Image = ImageList_AddIcon_(imagelist,icon\hIcon) : DestroyIcon_(icon\hIcon)
EndWith
ReDim this(ArraySize(this())+1) : file+1
;dateien im liste eintragen
ElseIf DirectoryEntryType(0)=#PB_DirectoryEntry_File And DirectoryEntryName(0)<>"."
With this(file)
\Image =-1
\FileA =2
\Name =DirectoryEntryName(0)
SHGetFileInfo_(Pfad+\Name, 0, @Icon.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_TYPENAME|#SHGFI_ICON |#SHGFI_SMALLICON)
\Datum =FormatDate("%dd.%mm.%yyyy"+" %hh:%ii:%ss",DirectoryEntryDate(0,#PB_Date_Created))
\Size =Str(DirectoryEntrySize(0)/1024)
\Typ =GetExtensionPart(Pfad+\Name)
\Image = ImageList_AddIcon_(imagelist,icon\hIcon) : DestroyIcon_(icon\hIcon)
ReDim this(ArraySize(this())+1) : file+1
EndWith
EndIf
Wend
SendMessage_(GadgetID(Gadget), #LVM_SETIMAGELIST, #LVSIL_SMALL, imagelist)
ProcedureReturn imagelist
Else
ProcedureReturn #False
EndIf
EndProcedure
If OpenWindow(0, 0, 0, 500, 430, "Window", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(1, 10, 10, 480, 380, "Name", 100, #LVS_OWNERDATA | #PB_ListIcon_FullRowSelect | #PB_ListIcon_HeaderDragDrop)
StringGadget(2,10,400,370,20,"")
ButtonGadget(3,390,400,100,20,"Auflisten")
AddGadgetColumn(1, 1, "Datei Typ", 100)
AddGadgetColumn(1, 2, "Datum", 100)
AddGadgetColumn(1, 3, "Größe", 100)
Define Pfad.s="D:\"
SetGadgetText(2,Pfad)
;callback für das ListIconGadget
SetWindowCallback(@Callback(), 0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
Case 3
Select EventType()
Case #PB_EventType_LeftClick
;Verzeichnis einlesen und Imageliste erstellen
ReDim Dummy(0)
Define Imagelist =VerzeichnisEinlesen(1,GetGadgetText(2),Dummy())
Define Anzahl =ArraySize(dummy())-1
;übergeben der erstellten Einträge auf das ListIconGadget
SendMessage_(GadgetID(1), #LVM_SETITEMCOUNT, anzahl, 0)
EndSelect
EndSelect
EndSelect
ForEver
EndIf
Und hier jetzt mit Thread und den besagten Fehler:
Code: Alles auswählen
EnableExplicit
Structure File ; File Infomation
Name.s : Datum.s : Typ.s : Size.s : FileA.i : pos.i : Image.i : Attibut.i
EndStructure
Structure Thread ; Thread für ListGadget
Gadget.i : ImagelistID.i
Pfad.s
stop.i : Finish.i
Thread.i
mutex.i
EndStructure
Global Dim Dummy.file(0)
Define.Thread Mein
Procedure Iconsauslesen(*this.thread)
Protected Icon.SHFILEINFO, i.i, Anzahl.i=ArraySize(dummy())-1,count.i
Debug "thread Gestartet"
With *this
LockMutex(\mutex)
For i = 0 To Anzahl
SHGetFileInfo_(\Pfad+dummy(i)\Name, 0, @Icon.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_TYPENAME|#SHGFI_ICON |#SHGFI_SMALLICON)
dummy(i)\Image=ImageList_AddIcon_(\ImagelistID,icon\hIcon) : DestroyIcon_(icon\hIcon)
dummy(i)\Typ= PeekS(@icon\szTypeName,80)
count+1 : If count=>21 : count=0 : SendMessage_(GadgetID(\Gadget), #LVM_SETIMAGELIST, #LVSIL_SMALL, \ImagelistID) : EndIf
Next
UnlockMutex(\mutex)
If Count<21 And count>=0
SendMessage_(GadgetID(\Gadget), #LVM_SETIMAGELIST, #LVSIL_SMALL, \ImagelistID)
EndIf
EndWith
Debug "Thread Gestoppt"
EndProcedure
Procedure Callback(hwnd, msg, wparam, lparam)
Protected *hdr.NMHDR, *di.NMLVDISPINFO, str.i
If msg = #WM_NOTIFY
*hdr = lparam
If *hdr\code = #LVN_GETDISPINFO
*di = lparam
Select *di\item\iSubItem ; Structur auslesen
Case 0
If dummy(*di\item\iItem)\Image<>-1 ; Icons überprüfen
*di\item\iImage =dummy(*di\item\iItem)\Image
EndIf
str.i = @dummy(*di\item\iItem)\Name
Case 1
str.i = @dummy(*di\item\iItem)\Typ
Case 2
str.i = @dummy(*di\item\iItem)\Datum
Case 3
str.i = @dummy(*di\item\iItem)\Size
EndSelect
*di\item\pszText = str
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure VerzeichnisEinlesenThread (Gadget,Pfad.s,Array this.file(1))
Protected file.i, Imagelist
ImageList_Destroy_(Imagelist) : imagelist = ImageList_Create_(16, 16, #ILC_COLOR32, 100, 1000 )
If ExamineDirectory(0,Pfad, "*.*")
;Verzeichnis öffnen und einlesen
While NextDirectoryEntry(0)
;Folder im liste eintragen
If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory And DirectoryEntryName(0)<>"."
With this(file)
\Image =-1
\FileA =1
\Name =DirectoryEntryName(0)
\Datum =" "
\Size =" "
\Typ ="Folder"
EndWith
ReDim this(ArraySize(this())+1) : file+1
;dateien im liste eintragen
ElseIf DirectoryEntryType(0)=#PB_DirectoryEntry_File And DirectoryEntryName(0)<>"."
With this(file)
\Image =-1
\FileA =2
\Name =DirectoryEntryName(0)
\Datum =FormatDate("%dd.%mm.%yyyy"+" %hh:%ii:%ss",DirectoryEntryDate(0,#PB_Date_Created))
\Size =Str(DirectoryEntrySize(0)/1024)
\Typ =GetExtensionPart(Pfad+\Name)
ReDim this(ArraySize(this())+1) : file+1
EndWith
EndIf
Wend
SendMessage_(GadgetID(Gadget), #LVM_SETIMAGELIST, #LVSIL_SMALL, imagelist)
ProcedureReturn imagelist
Else
ProcedureReturn #False
EndIf
EndProcedure
If OpenWindow(0, 0, 0, 500, 430, "Window", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(1, 10, 10, 480, 380, "Name", 100, #LVS_OWNERDATA | #PB_ListIcon_FullRowSelect | #PB_ListIcon_HeaderDragDrop)
StringGadget(2,10,400,370,20,"")
ButtonGadget(3,390,400,100,20,"Auflisten")
AddGadgetColumn(1, 1, "Datei Typ", 100)
AddGadgetColumn(1, 2, "Datum", 100)
AddGadgetColumn(1, 3, "Größe", 100)
Define Pfad.s="D:\"
SetGadgetText(2,Pfad)
;callback für das ListIconGadget
SetWindowCallback(@Callback(), 0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
Case 3
Select EventType()
Case #PB_EventType_LeftClick
;Verzeichnis einlesen und Imageliste erstellen
ReDim Dummy(0)
Define Imagelist =VerzeichnisEinlesenThread(1,GetGadgetText(2),Dummy())
Define Anzahl =ArraySize(dummy())-1
;thread starten
Mein\Gadget=1
Mein\ImagelistID=Imagelist
Mein\mutex=CreateMutex()
Mein\Pfad=GetGadgetText(2)
CreateThread(@Iconsauslesen(),mein)
;übergeben der erstellten Einträge auf das ListIconGadget
SendMessage_(GadgetID(1), #LVM_SETITEMCOUNT, anzahl, 0)
EndSelect
EndSelect
EndSelect
ForEver
EndIf
könnt ihr den Fehler Bestätigen?
Ihr sollte wenn möglich ein Verzeichnis mit Bildern auswählen