ListIconGadget schnell mit 3700 Einträge füllen

Für allgemeine Fragen zur Programmierung mit PureBasic.
Benutzeravatar
silbersurfer
Beiträge: 174
Registriert: 06.07.2014 12:21

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von silbersurfer »

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
Benutzeravatar
Shardik
Beiträge: 738
Registriert: 25.01.2005 12:19

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von Shardik »

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()
Du kannst Dir auch dieses Beispiel von Sparkie ansehen.
Benutzeravatar
silbersurfer
Beiträge: 174
Registriert: 06.07.2014 12:21

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von silbersurfer »

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
Benutzeravatar
silbersurfer
Beiträge: 174
Registriert: 06.07.2014 12:21

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von silbersurfer »

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
Intel Quad Core 3,2 Ghz - GTX 1060 - BlitzBasic Plus 1.48 , PureBasic 5.70 LTS / Aktuelles Projekt PureCommander
Benutzeravatar
dige
Beiträge: 1182
Registriert: 08.09.2004 08:53

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von dige »

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."
Benutzeravatar
silbersurfer
Beiträge: 174
Registriert: 06.07.2014 12:21

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von silbersurfer »

@dige
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
Benutzeravatar
silbersurfer
Beiträge: 174
Registriert: 06.07.2014 12:21

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von silbersurfer »

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
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
Benutzeravatar
HeX0R
Beiträge: 2954
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

Beitrag von HeX0R »

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?
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von RSBasic »

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
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
edel
Beiträge: 3667
Registriert: 28.07.2005 12:39
Computerausstattung: GameBoy
Kontaktdaten:

Re: ListIconGadget schnell mit 3700 Einträge füllen

Beitrag von edel »

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: 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.
Antworten