ListIconGadget schnell mit 3700 Einträge füllen
- silbersurfer
- Beiträge: 174
- Registriert: 06.07.2014 12:21
Re: ListIconGadget schnell mit 3700 Einträge füllen
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
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
Re: ListIconGadget schnell mit 3700 Einträge füllen
silbersurfer hat geschrieben:Wie kann man dort normale Icons gleich mit einbinden ?
Code: Alles auswählen
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()
- silbersurfer
- Beiträge: 174
- Registriert: 06.07.2014 12:21
Re: ListIconGadget schnell mit 3700 Einträge füllen
Super danke Shardik
werde das mal genauer mir anschauen
werde das mal genauer mir anschauen
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.70 LTS / Aktuelles Projekt PureCommander
- silbersurfer
- Beiträge: 174
- Registriert: 06.07.2014 12:21
Re: ListIconGadget schnell mit 3700 Einträge füllen
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:
Und hier jetzt mit Thread und den besagten Fehler:
könnt ihr den Fehler Bestätigen?
Ihr sollte wenn möglich ein Verzeichnis mit Bildern auswählen
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
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
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
Re: ListIconGadget schnell mit 3700 Einträge füllen
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."
- silbersurfer
- Beiträge: 174
- Registriert: 06.07.2014 12:21
Re: ListIconGadget schnell mit 3700 Einträge füllen
@dige
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
hm also keine fehlenden oder falschen Icons die bei dir angezeigt werden.Mit PB 5.70 x86 und x64 und Threadsafe läuft es auf Windows 10 korrekt..
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
- silbersurfer
- Beiträge: 174
- Registriert: 06.07.2014 12:21
Re: ListIconGadget schnell mit 3700 Einträge füllen
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
Edit: geht leider doch nicht !
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
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
Zuletzt geändert von silbersurfer am 04.05.2019 10:52, insgesamt 1-mal geändert.
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.70 LTS / Aktuelles Projekt PureCommander
- HeX0R
- Beiträge: 2960
- Registriert: 10.09.2004 09:59
- Computerausstattung: AMD Ryzen 7 5800X
96Gig Ram
NVIDIA GEFORCE RTX 3060TI/8Gig
Win10 64Bit
G19 Tastatur
2x 24" + 1x27" Monitore
Glorious O Wireless Maus
PB 3.x-PB 6.x
Oculus Quest 2 - Kontaktdaten:
Re: ListIconGadget schnell mit 3700 Einträge füllen
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?
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?
{Home}.:|:.{Codes}.:|:.{Downloads}.:|:.{History Viewer Online}
Re: ListIconGadget schnell mit 3700 Einträge füllen
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
Re: ListIconGadget schnell mit 3700 Einträge füllen
Huhu Hex0r,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?
die Daten kannst du nicht mehr per SetGadgetItemData setzen, wohl aber in deinem Array. Das Gleiche kannst du auch mit der Farbe machen.
Code: Alles auswählen
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()
Zuletzt geändert von edel am 11.05.2019 19:33, insgesamt 1-mal geändert.