Aktuelle Zeit: 18.09.2019 16:02

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 34 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3, 4  Nächste
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.70 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.70 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.70 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, mein Wecker funktioniert nicht! Der weckert immer zu früh."


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.70 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:
Edit: geht leider doch nicht !
  • keine sichtbare Anzeige im listGadget wärend ein Drop über dem Gadget bewegt wird
  • beim droppen hängt sich das Programm auf

Hat einer von den Api-Profis hier einen Lösungsansatz ?


Bild

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


Zuletzt geändert von silbersurfer am 04.05.2019 10:52, insgesamt 1-mal geändert.

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

Registriert: 10.09.2004 09:59
Ich bräuchte mal einen Schubs.
Habe das Ding von Edel in ein Programm von mir eingebaut und bin schon mal schwer beeindruckt von der Geschwindigkeit.

Allerdings funktionieren jetzt zwei Dinge nicht mehr (vermutlich wegen dem #LVS_OWNERDATA?), die ich aber dringend brauchen würde:
1.) Ich kann den Hintergrund einzelner Zeilen nicht mehr einfärben (SetGadgetItemColor())
2.) Ich kann keine Daten mehr in einzelnen Zeilen speichern (SetGadgetItemData())

Leider weiss ich nicht mal wirklich wonach ich suchen sollte (finde immer nur .NET Lösungen), oder kann ein WinAPI Guru mir mal eben auf die Sprünge helfen?

_________________
Link tot?
Ändere h3x0r.ath.cx in hex0rs.coderbu.de und alles wird gut.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: ListIconGadget schnell mit 3700 Einträge füllen
BeitragVerfasst: 03.05.2019 21:28 
Offline
Admin
Benutzeravatar

Registriert: 05.10.2006 18:55
Wohnort: Deutschland::Berlin()
Da die Einträge im Callback während der Laufzeit angezeigt werden (nur die sichtbaren Zeilen (deshalb ist es auch so schnell)), musst du die Funktionen mit WinAPI soweit ich weiß auch selber erstellen. Z.B.: https://www.purebasic.fr/english/viewto ... 923#p24923

_________________
BildBildBildBild BildBild


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

Registriert: 28.07.2005 12:39
HeX0R hat geschrieben:
Ich bräuchte mal einen Schubs.
Habe das Ding von Edel in ein Programm von mir eingebaut und bin schon mal schwer beeindruckt von der Geschwindigkeit.

Allerdings funktionieren jetzt zwei Dinge nicht mehr (vermutlich wegen dem #LVS_OWNERDATA?), die ich aber dringend brauchen würde:
1.) Ich kann den Hintergrund einzelner Zeilen nicht mehr einfärben (SetGadgetItemColor())
2.) Ich kann keine Daten mehr in einzelnen Zeilen speichern (SetGadgetItemData())

Leider weiss ich nicht mal wirklich wonach ich suchen sollte (finde immer nur .NET Lösungen), oder kann ein WinAPI Guru mir mal eben auf die Sprünge helfen?


Huhu Hex0r,

die Daten kannst du nicht mehr per SetGadgetItemData setzen, wohl aber in deinem Array. Das Gleiche kannst du auch mit der Farbe machen.

Code:
EnableExplicit

Structure struct
  a.s
  b.s
  c.s
  d.s
  myData.i
  myColor.i
EndStructure

#ARRAY_SIZE = 20
#ImageCount = 3

Global Dim List.struct(#ARRAY_SIZE)

Procedure mySetGadgetItemData(Index, Value)
  List(Index)\myData = Value
EndProcedure

Procedure mySetGadgetItemColor(Index, Value)
  List(Index)\myColor = Value
EndProcedure

Procedure myGetGadgetItemData(Index)
  ProcedureReturn List(Index)\myData
EndProcedure

Procedure Callback(hwnd, msg, wparam, lparam)
  Protected *hdr.NMHDR
  Protected *di.NMLVDISPINFO
  Protected str.i
  Protected *lvcd.NMLVCUSTOMDRAW
  Protected *item.struct
 
  If msg = #WM_NOTIFY
    *hdr = lparam
   
    If *hdr\code = #NM_CUSTOMDRAW
      *lvcd = *hdr     
     
      If *lvcd\nmcd\dwDrawStage = #CDDS_PREPAINT
        ProcedureReturn #CDRF_NOTIFYITEMDRAW
      EndIf
     
      If *lvcd\nmcd\dwDrawStage = #CDDS_ITEMPREPAINT
        ProcedureReturn #CDRF_NOTIFYSUBITEMDRAW
      EndIf
     
      If *lvcd\nmcd\dwDrawStage = #CDDS_SUBITEMPREPAINT       
       
        *item = List(*lvcd\nmcd\dwItemSpec)       
        *lvcd\clrText = RGB(255-Red(*item\myColor), 255-Green(*item\myColor), 255-Blue(*item\myColor))
        *lvcd\clrTextBk = *item\myColor         
       
        ProcedureReturn #CDRF_DODEFAULT
      EndIf       
    EndIf
   
    If *hdr\code = #LVN_GETDISPINFO
      *di = lparam     
     
      Select *di\item\iSubItem
        Case 0         
          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 - 1
    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)\myColor = #White       
  Next

EndProcedure

Procedure Main()
  Protected EventID
  Protected index
 
  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)
   
    mySetGadgetItemData(3, 123456)
   
    mySetGadgetItemColor(3, RGB(0, 0, 255))   
    mySetGadgetItemColor(1, RGB(255, 255, 100))   
    mySetGadgetItemColor(#ARRAY_SIZE -1 , RGB(255, 0, 100))   
   
    Repeat     
      EventID = WaitWindowEvent()
     
      If EventID = #PB_Event_Gadget And EventType() = #PB_EventType_Change
       
        If EventGadget() = 1
         
          index = GetGadgetState(1)
         
          If index <> -1
            Debug myGetGadgetItemData(index)
          EndIf         
         
        EndIf
       
      EndIf
     
    Until  EventID = #PB_Event_CloseWindow
  EndIf
 
EndProcedure:End Main()

_________________
Suche


Zuletzt geändert von edel am 11.05.2019 19:33, insgesamt 1-mal geändert.

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

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 8 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