Listicongadget Spalte merken + markieren wenn sortiert wurde

[hjbremer]

da dies nur eine Demo ist, kein Protected und ähnliches. Und außerdem interressierts eh kaum einen und die es gebrauchen können, müssens halt selbst dazu schreiben.

Code: Alles auswählen

Declare ListeHeaderSort(spalte)
Declare WindowCallback(hWnd, message, wParam, lParam)
Declare.s Demodaten()

Enumeration
 #but1
 #but2
 #but3
 #lvg1
 #win1 
 #font1
EndEnumeration

Global hdflag, lvid1, hdid1

LoadFont(#font1, "Arial", 11)

OpenWindow(#win1,0,0,900,480,"ListIcon Gadget",#PB_Window_SystemMenu|1) 
  
  SetWindowCallback(@WindowCallback()) 
       
  ButtonGadget(#but1,10,430,80,45,"tue nix")
  ButtonGadget(#but2,120,430,80,45,"tue nix")
  ButtonGadget(#but3,230,430,80,45,"tue nix")
  
  lvflags = #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect
  lvflags | #PB_ListIcon_MultiSelect | #PB_ListIcon_CheckBoxes
  lvid1 = ListIconGadget(#lvg1,10,10,600,400,"LV1 Spalte 0",70,lvflags)
  hdid1 = SendMessage_(lvid1, #LVM_GETHEADER, 0, 0)
  
   AddGadgetColumn(#lvg1,1,"Spalte 1",155) 
   AddGadgetColumn(#lvg1,2,"Spalte 2",155) 
   AddGadgetColumn(#lvg1,3,"Spalte 3",155) 
   SetGadgetFont(#lvg1,FontID(#font1))
   
   ;wenn farbig, funktioniert Column markieren optisch nicht, intern aber
   ;SetGadgetColor(#lvg1, #PB_Gadget_BackColor, #Yellow)
  
  HideGadget(#lvg1, 1)  
  For i = 0 To 196 
    AddGadgetItem(#lvg1, -1, RSet(Str(i),3) + #LF$ + Demodaten())           
  Next
  HideGadget(#lvg1, 0)  
  
;=====================================================

Repeat

  event = WaitWindowEvent() 
  
  If Event = #PB_Event_Gadget Or Event = #PB_Event_Menu 
          
      welcherButton = EventGadget() 
  
      Select welcherButton
      
            Case #but1: SendMessage_(lvid1, #LVM_SETSELECTEDCOLUMN , 0, 0)
                        SendMessage_(lvid1, #WM_SETREDRAW, #True, 0) 
                        InvalidateRect_(lvid1, 0, #True)  
                        
            Case #but2: SendMessage_(lvid1, #LVM_SETSELECTEDCOLUMN , 1, 0)
                        SendMessage_(lvid1, #WM_SETREDRAW, #True, 0) 
                        InvalidateRect_(lvid1, 0, #True)  
                                    
            Case #but3: Debug SendMessage_(lvid1, #LVM_GETSELECTEDCOLUMN , 0, 0)

      EndSelect
  
  EndIf

Until event = #PB_Event_CloseWindow 

End 

;=====================================================

Procedure ListeHeaderSort(spalte)
  
  ;letzte Sortierung merken
  hdflag = 1   ;gibt Header frei siehe Callback
  
  hd.hd_item
  hd\mask = #HDI_LPARAM
  SendMessage_(hdid1, #HDM_GETITEM, spalte, @hd)
  
  If hd\lparam = spalte
     hd\lparam = -1
     sortoption = #PB_Sort_Ascending 
  Else
     hd\lparam = spalte
     sortoption = #PB_Sort_Descending
  EndIf   
  SendMessage_(hdid1, #HDM_SETITEM, spalte, @hd)
  
  hdflag = 0   ;sperrt Header wieder
  
  cols = SendMessage_(hdid1, #HDM_GETITEMCOUNT, 0, 0)
  
  ;Sortieren 
  sorttiefe = 25
  datenanzahl = CountGadgetItems(#lvg1) -1
  Dim daten$(datenanzahl+1)
  For j = 0 To datenanzahl 
      x$ = LSet(GetGadgetItemText(#lvg1, j, spalte), sorttiefe) 
      For k = 0 To cols - 1
          i$ = GetGadgetItemText(#lvg1, j, k)
          x$ + i$ + #LF$
      Next  
      daten$(j) = x$   ;:Debug daten$(j)
  Next

  SortArray(daten$(),sortoption,0,datenanzahl)
  
  ;zurückschreiben
  SendMessage_(lvid1, #WM_SETREDRAW, #False, 0)
  
  ClearGadgetItems(#lvg1) 
  datenposi = 1 + sorttiefe
  For j = 0 To datenanzahl 
    x$ = Mid(daten$(j), datenposi)
    AddGadgetItem(#lvg1,-1, x$)
  Next
  
  SendMessage_(lvid1, #LVM_SETSELECTEDCOLUMN , spalte, 0) 
  SendMessage_(lvid1, #WM_SETREDRAW, #True, 0) 
  InvalidateRect_(lvid1, 0, #True) 
    
EndProcedure

Procedure WindowCallback(hWnd, message, wParam, lParam)
result = #PB_ProcessPureBasicEvents 

  Select message
      
      Case #WM_NOTIFY 
          
          ;diese Struktur sagt von welchem Gadget und was ist wo passiert
          *nmhdr.NMHDR = lParam
                                     
          ;Header von #lvg1
          If *nmhdr\hwndFrom = hdid1
                              
             Select *nmhdr\code                 
                                     
                Case #NM_RCLICK                     
                                           
                Case #HDN_ITEMCLICK 
                     *nmhd.NMHEADER = lParam
                     ListeHeaderSort(*nmhd\iItem)                     
                        
                Case #HDN_ITEMCHANGING
                     ;Headerbreite ändern verbieten
                     If hdflag = 0
                        result = #True
                     EndIf                    
                     
             EndSelect   
          EndIf   
         
  EndSelect 
  
ProcedureReturn result 
EndProcedure 

Procedure.s Demodaten()
Dim x$(4,4)
Restore DemoDaten

For j = 0 To 4
  For k = 0 To 4
    Read.s x$(j,k)
  Next
  text$ + x$(j,Random(4))
  If j = 1: text$ + #LF$: EndIf
  If j = 2: text$ + Str(Random(199)+1) + #LF$: EndIf
Next

ProcedureReturn text$

DataSection
DemoDaten:
Data.s "Otto ", "Mike ", "Hans-Jürgen ", "Ulrike ", "Familie "
Data.s "Meier", "Bremer", "Müller", "Holzfäller", "Rappel"
Data.s "Dorfstr. ", "Hauptstr. ", "Malerstr. ", "Neustr. ", "Baumweg "
Data.s "12345 ", "35793 ", "48265 ", "72561 ", "55127 "
Data.s "Wieda", "Bremen", "Kuhdorf", "Neustadt", "Bonn"
EndDataSection       
EndProcedure