Aktuelle Zeit: 21.04.2019 08:25

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 27 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3
Autor Nachricht
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 01.04.2019 20:34 
Offline
Benutzeravatar

Registriert: 06.07.2014 12:21
Sorry das diesen Thread wieder ausgrabe,
ich habe eine frage bezüglich @edel seinen code für das befüllen vom ListIconGadget.
Wie kann man dort normale Icons gleich mit einbinden ? Ich habe das für checkboxen gesehen aber bin da nicht richtig schlau daraus geworden.
Ich würde das gerne für Verzeichnisse einlesen nutzen u.s.w.

Wäre super wenn jemand da noch eine Idee hat.

Gruß Silbersurfer

_________________
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.60 LTS / Aktuelles Projekt PureCommander


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 02.04.2019 14:18 
Offline
Benutzeravatar

Registriert: 25.01.2005 12:19
silbersurfer hat geschrieben:
Wie kann man dort normale Icons gleich mit einbinden ?

Code:
EnableExplicit

Structure struct
  a.s
  b.s
  c.s
  d.s
  IconID.I
EndStructure

#ARRAY_SIZE = 37000
#ImageCount = 3

Global Dim List.struct(#ARRAY_SIZE)

Global IconBlue = CreateImage(#PB_Any, 16, 16, 32, #Blue)
Global IconGreen = CreateImage(#PB_Any, 16, 16, 32, #Green)
Global IconRed = CreateImage(#PB_Any, 16, 16, 32, #Red)
Global ImageList = ImageList_Create_(16, 16, #ILC_COLOR32, 0, #ImageCount)


Procedure Callback(hwnd, msg, wparam, lparam)
  Protected *hdr.NMHDR
  Protected *di.NMLVDISPINFO
  Protected str.i
 
  If msg = #WM_NOTIFY
    *hdr = lparam
 
    If *hdr\code = #LVN_GETDISPINFO
      *di = lparam     
     
      Select *di\item\iSubItem
        Case 0
          If List(*di\item\iItem)\IconID <> -1
            *di\item\iImage = List(*di\item\iItem)\IconID
          EndIf

          str.i = @List(*di\item\iItem)\a
        Case 1
          str.i = @List(*di\item\iItem)\b
        Case 2
          str.i = @List(*di\item\iItem)\c
        Case 3
          str.i = @List(*di\item\iItem)\d
      EndSelect
     
      *di\item\pszText = str

      ProcedureReturn #True
    EndIf
   
  EndIf
 
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure InitArray()
  Protected a
  Protected IconID.I

  For a = 0 To #ARRAY_SIZE   
    List(a)\a = "Hallo " + Str(a)
    List(a)\b = "Pure " + Str(a)
    List(a)\c = "Basic " + Str(a)
    List(a)\d = "Welt " + Str(a)
    List(a)\IconID = -1
  Next

  IconID = ImageList_Add_(ImageList, ImageID(IconRed), 0)
  List(1)\IconID = IconID

  IconID = ImageList_Add_(ImageList, ImageID(IconGreen), 0)
  List(3)\IconID = IconID

  IconID = ImageList_Add_(ImageList, ImageID(IconBlue), 0)
  List(5)\IconID = IconID
EndProcedure

Procedure Main()
  Protected EventID
 
  InitArray()
 
  If OpenWindow(0, 0, 0, 500, 400, "Window", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
    SetWindowCallback(@Callback(), 0)

    ListIconGadget(1, 10, 10, 480, 380, "Spalte 1", 100, #LVS_OWNERDATA | #PB_ListIcon_FullRowSelect)
    AddGadgetColumn(1, 1, "Spalte 2", 100)
    AddGadgetColumn(1, 2, "Spalte 3", 100)
    AddGadgetColumn(1, 3, "Spalte 4", 100)
   
    SendMessage_(GadgetID(1), #LVM_SETITEMCOUNT, #ARRAY_SIZE, 0)
    SendMessage_(GadgetID(1), #LVM_SETIMAGELIST, #LVSIL_SMALL, ImageList)

    Repeat     
    Until WaitWindowEvent() = #PB_Event_CloseWindow
   
  EndIf
 
EndProcedure:End Main()


Du kannst Dir auch dieses Beispiel von Sparkie ansehen.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 02.04.2019 15:02 
Offline
Benutzeravatar

Registriert: 06.07.2014 12:21
Super danke Shardik
werde das mal genauer mir anschauen :allright: :allright:

_________________
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.60 LTS / Aktuelles Projekt PureCommander


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 06.04.2019 09:47 
Offline
Benutzeravatar

Registriert: 06.07.2014 12:21
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:
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:
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

_________________
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.60 LTS / Aktuelles Projekt PureCommander


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 08.04.2019 09:55 
Offline
Benutzeravatar

Registriert: 08.09.2004 08:53
Mit PB 5.70 x86 und x64 und Threadsafe läuft es auf Windows 10 korrekt..

_________________
"Papa, ich laufe schneller, dann ist es nicht so weit."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 09.04.2019 15:03 
Offline
Benutzeravatar

Registriert: 06.07.2014 12:21
@dige
Zitat:
Mit PB 5.70 x86 und x64 und Threadsafe läuft es auf Windows 10 korrekt..

hm also keine fehlenden oder falschen Icons die bei dir angezeigt werden.

Bei mir habe ich das auch lösen können, indem ich im Hauptthread ShSHGetFileInfo_ einmal ausgeführt,
und ein paar Icons vorab schon mal geladen habe.
In den Microsoft Docs für ShSHGetFileInfo habe ich auch gelesen das wenn der Befehl im Thread gestartet wird dieser im Haupthread registriert sein soll !
Was genau damit gemeit ist weiß ich bis jetzt noch nicht genau, aber so wie jetzt ist, läuft es auch mir.

Gruß Silbersurfer

_________________
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.60 LTS / Aktuelles Projekt PureCommander


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 14.04.2019 11:50 
Offline
Benutzeravatar

Registriert: 06.07.2014 12:21
Hallo Leute,
ich bin es schon wieder einmal, und habe noch eine frage an die API Profis hier im Board.
Dank Shardik seiner hilfe und edel seinen coolen Code für schelles einlesen der List Elemente
habe ich das in meinen laufenden Projekt einbinden können.
Nun habe ich aber noch ein Problem, und zwar kann ich nicht mehr die Drag&Drop befehele von Pure Basic für diese Gadgets
nutzen, ich hoffe das mir hier einer von euch weiterhelfen kann.

Edit: Sorry hat sich erledigt, es geht doch mit den Hauseigenen Befehlen :oops: :oops: :oops:

Bild

_________________
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.60 LTS / Aktuelles Projekt PureCommander


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 27 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 9 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye