PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

virtual list view, ListIcongadget zum Anzeigen vieler Daten

https://www.purebasic.fr/german/viewtopic.php?t=19105

Seite 1 von 2

virtual list view, ListIcongadget zum Anzeigen vieler Daten

Verfasst: 10.02.2009 21:33
von hjbremer
Manchmal liest man hier im Forum, das Laden von sehr vielen Daten dauert lange. Nun je nach Code kann es schon etwas dauern 10000 oder 20 000 Zeilen zu laden.

Mit einem Virtual List View kann man 500000 und mehr Datensätze anzeigen. Allerdings gibt es auch Nachteile wie z.b. keine Checkboxes, hab ich zumindest nicht zum Funktionieren gebracht. Auch einige andere PB Befehle gehen nicht. Vorsicht ist bei Getgadgetitemtext angebracht. Liegt ev. aber an meinem Code. Dafür habe ich ItemLesen und SubItemlesen.

Programm starten und zuerst den Button Testdatei erstellen drücken. Anzahl Datensätze eingeben und fertig.

Ich arbeite mit fester Satzlänge ohne DateiHeader, weil dies am einfachsten ist. Aber alle Formate sind sicher möglich, ist halt nur eine Fleißarbeit.

Hinweis: Dies ist ein Democode ! der nur zeigen soll wie man auf riesige Datenmengen zugreifen kann. incl. markieren, übernehmen und suchen
Ich im Code das Ganze auf 1 Million Datensätze begrenzt, weil das wären ca 112 MB, aber mehr ist natürlich möglich.

Kleine Erklärung:
Die Struktur lvdaten und hier besonders die StuctureUnion Anweisung bewirkt, das man lvdaten\p einen Speicherbereich zuweist, der einen kompletten Datensatz aufnehmen kann. In diesen Bereich wird das Subitem kopiert für #LVN_GETDISPINFO und kann auch mit lvdaten\s abgefragt werden.
Nun, das kann man sicher auch anders lösen und vielleicht auch besser, aber ich wollte es einmal so ausprobieren.

kleines Problem: Eine Suchfunktion
Ich komme mit LVM_FINDITEM und LVN_ODFINDITEM nicht klar. Schuld sind Meine mangelnden Englischkenntnisse oder meine Blödheit oder..
Ich habe nun eine simple For ItemLesen Next Schleife benutzt. Dauert halt etwas länger.
Wer weiß wie es mit LVN_ODFINDITEM geht?

Code: Alles auswählen

Declare FeldDatenLesen()
Declare LV_AnzahlSelect(pbnr, liste(1))      ;
Declare LV_Eingabe(pbnr,ea,pbnr2=0,vorgabe$="")
Declare LV_FindAllItem(such$)
Declare LV_FindItem(such$, start)
Declare LV_setRowtoMid(pbnr, zeile)
Declare SubItemLesen(item, subitem)
Declare WriteTestdatei(dat$, max)
Declare myWindowCallback(hwnd, message, wParam, lParam) 
Declare.s ItemLesen(item)

Structure felddaten
 laenge.i
 offset.i
 name.s
 colbreite.i
EndStructure

Structure mylvdaten
 StructureUnion
  p.i
  s.s
 EndStructureUnion
 flag.i
 lvdnr.i
 lvhwnd.i
 satzlg.i
 feldanz.i
 satzanz.i
EndStructure

; ---------------------------------------------

fontid = FontID(LoadFont(#PB_Any,"Courier New",8))

dat$ = "test.dat"

lvdaten.mylvdaten
Dim felddaten.felddaten(0)

FeldDatenLesen()

; ---------------------------------------------
;es funktioniert nicht 
; Checkboxen ? 
; SetGadgetItemColor 
; SetGadgetItemText 
; GetGadgetItemText !! es scheint nur zu funktionieren !! dafür SubItemLesen nehmen

lvdaten\lvdnr = OpenFile(#PB_Any, dat$)
lvdaten\satzanz = Lof(lvdaten\lvdnr) / lvdaten\satzlg

hwnd = OpenWindow(0, 50, 50, 820, 660, "V-Listview", #PB_Window_SystemMenu) 
     CreateGadgetList(hwnd) 
     infopbnr = CreateStatusBar(#PB_Any, hwnd)

     showpbnr = EditorGadget(#PB_Any, 10,410,800,150,#PB_Editor_ReadOnly)
                SetGadgetFont(showpbnr,fontid)
                showidnr = GadgetID(showpbnr)
     
     strgpbnr = StringGadget(#PB_Any,  0,  0, 90,40,"")
                HideGadget(strgpbnr,1) 
     bt0pbnr = ButtonGadget(#PB_Any, 10,580, 90,40,"Anzeigefeld löschen",#PB_Button_MultiLine)
     bt1pbnr = ButtonGadget(#PB_Any,110,580, 90,40,"markierte Items übernehmen",#PB_Button_MultiLine)
     bt2pbnr = ButtonGadget(#PB_Any,210,580, 90,40,"Scroll to          ",#PB_Button_MultiLine)
     bt3pbnr = ButtonGadget(#PB_Any,310,580, 90,40,"Find               ",#PB_Button_MultiLine)
     bt4pbnr = ButtonGadget(#PB_Any,410,580, 90,40,"Find next          ",#PB_Button_MultiLine)
     bt5pbnr = ButtonGadget(#PB_Any,510,580, 90,40,"Find alle          ",#PB_Button_MultiLine)
     bt9pbnr = ButtonGadget(#PB_Any,710,580, 90,40,"Testdatei erstellen",#PB_Button_MultiLine)
          
     lvflag = #LVS_OWNERDATA|#PB_ListIcon_GridLines|#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection
     lvpbnr = ListIconGadget(#PB_Any, 10,2,785,390, felddaten(1)\name, felddaten(1)\colbreite, lvflag)
     lvdaten\lvhwnd = GadgetID(lvpbnr)
     
     For j = 1 To lvdaten\feldanz - 1
      AddGadgetColumn(lvpbnr,j,felddaten(j+1)\name,felddaten(j+1)\colbreite)
     Next
     
     ;Reihenfolge von SendMessage muß so sein
     SendMessage_(lvdaten\lvhwnd, #LVM_SETCOLUMNWIDTH, 4, #LVSCW_AUTOSIZE_USEHEADER) 
     SendMessage_(lvdaten\lvhwnd, #LVM_SETITEMCOUNT, lvdaten\satzanz, 0) 
  
     SetWindowCallback(@myWindowCallback()) 
     
     SetGadgetColor(lvpbnr, #PB_Gadget_BackColor, #Yellow)
     SetGadgetColor(lvpbnr, #PB_Gadget_FrontColor, #Blue)
     SetGadgetColor(lvpbnr, #PB_Gadget_LineColor, #Red)
     
     SetGadgetFont(lvpbnr,fontid)     
     StatusBarText(infopbnr, 0, dat$ + " - Anzahl: "+Str(lvdaten\satzanz),4)     
               
Repeat 
    event = WaitWindowEvent() 
    Select event 
          Case #PB_Event_Gadget 
            Select EventGadget() 
              ;in Liste geklickt
              Case lvpbnr 
                  If EventType() = #PB_EventType_LeftClick 
                      ;wo in Liste geklickt ?
                      GetCursorPos_(p.POINT) 
                      MapWindowPoints_(0,lvdaten\lvhwnd,p,1) 
                      HitInfo.LVHITTESTINFO 
                      Hitinfo\pt\x = p\x 
                      HitInfo\pt\y = p\y 
                      SendMessage_(lvdaten\lvhwnd,#LVM_SUBITEMHITTEST ,0,HitInfo) 
                      If hitinfo\iitem = -1:hitinfo\iitem = 0:EndIf
                      If hitinfo\isubitem = -1:hitinfo\isubitem = 0:EndIf
                      row = hitinfo\iitem
                      col = hitinfo\isubitem + 1
                      ;subitem anzeigen
                      SubItemLesen(row, col)
                      AddGadgetItem(showpbnr,-1, lvdaten\s)
                      SendMessage_(showidnr,#EM_SCROLL,#SB_BOTTOM,0)                                        
                      ;erste markierte Zeile ist ?                   
                      nr = GetGadgetState(lvpbnr) + 1                  
                      StatusBarText(infopbnr, 0, "1.markierte ZeilenNr.ist: "+Str(nr),4)
                  EndIf
              
              ;Anzeigefeld löschen
              Case bt0pbnr
                  ClearGadgetItemList(showpbnr)   
              
              ;markierte Zeilen anzeigen      
              Case bt1pbnr        
                  DisableGadget(showpbnr,1)
                  StatusBarText(infopbnr, 0, "bitte warten",4)
                  Dim liste(0)
                  LV_AnzahlSelect(lvpbnr,liste())   
                  For j = 1 To liste(0)  ;in liste(0) steht die Anzahl der markierten Zeilen
                    nr = liste(j)
                    AddGadgetItem(showpbnr,-1,ItemLesen(nr))
                  Next
                  SendMessage_(showidnr,#EM_SCROLL,#SB_BOTTOM,0)
                  DisableGadget(showpbnr,0)
                  StatusBarText(infopbnr, 0, "Anzahl: "+Str(liste(0)),4)

              ;Scroll to
              Case bt2pbnr
                  LV_Eingabe(strgpbnr,1,bt2pbnr)
                  
              ;Find 
              Case bt3pbnr
                  lastfind = -1
                  If Not such$: such$ = "Ute Kaufmann": EndIf
                  LV_Eingabe(strgpbnr,1,bt3pbnr, such$)
              
              ;Find next            
              Case bt4pbnr
                  If lastfind > -1
                     lastfind = LV_FindItem(such$, lastfind+1) 
                  EndIf
                  
              ;Find all
              Case bt5pbnr
                  lastfind = -1
                  If Not such$: such$ = "Ute Kaufmann": EndIf
                  LV_Eingabe(strgpbnr,1,bt5pbnr, such$)
              
              ;Testdatei erstellen               
              Case bt9pbnr
                  LV_Eingabe(strgpbnr,1,bt9pbnr)
              
            EndSelect 
      Case #WM_KEYDOWN
            If EventwParam() = #VK_RETURN
               If EventGadget() = strgpbnr
                  gadget = LV_Eingabe(strgpbnr,0) 
                  such$   = GetGadgetText(strgpbnr)
                  eingabe = Val(GetGadgetText(strgpbnr))
                  Select gadget
                    
                    ;Scroll to
                    Case bt2pbnr: 
                      If eingabe < 1: eingabe = 1: EndIf
                      If eingabe > lvdaten\satzanz: eingabe = lvdaten\satzanz: EndIf
                      LV_setRowtoMid(lvpbnr, eingabe)
                      SetGadgetState(lvpbnr,eingabe-1) 
                    
                    ;Find
                    Case bt3pbnr:
                      SetGadgetState(lvpbnr,-1)
                      lastfind = LV_FindItem(such$,1)
                    
                    ;Find All
                    Case bt5pbnr:
                      SetGadgetState(lvpbnr,-1)
                      LV_FindAllItem(such$)
                    
                    ;Testdatei erstellen 
                    Case bt9pbnr: ;auf 1 Million begrenzt = 112 MB
                      If eingabe < 100: eingabe = 100: EndIf
                      If eingabe > 1000000: eingabe = 1000000: EndIf
                      CloseFile(lvdaten\lvdnr)
                      StatusBarText(infopbnr, 0, dat$ + " wird erstellt",4)
                      WriteTestdatei(dat$, eingabe) 
                      lvdaten\lvdnr = OpenFile(#PB_Any, dat$)
                      lvdaten\satzanz = Lof(lvdaten\lvdnr) / lvdaten\satzlg              
                      SendMessage_(lvdaten\lvhwnd, #LVM_SETITEMCOUNT, lvdaten\satzanz, 0)
                      StatusBarText(infopbnr, 0, dat$ + " - Anzahl: "+Str(lvdaten\satzanz),4)
                  EndSelect
               EndIf
            EndIf
    EndSelect 
Until event = #PB_Event_CloseWindow 

CloseFile(lvdaten\lvdnr)

End

; ---------------------------------------------
Procedure myWindowCallback(hwnd, message, wParam, lParam) 
  
  Shared lvdaten.mylvdaten 
  
  result = #PB_ProcessPureBasicEvents 
  
  If message=#WM_NOTIFY 
     *nmlv.NM_LISTVIEW = lParam 
    
     If *nmlv\hdr\hwndFrom = lvdaten\lvhwnd 
        If *nmlv\hdr\code = #LVN_GETDISPINFO 
           
           *lvdi.LV_DISPINFO = lParam 
          
           ; Item text zuweisen
           If *lvdi\item\mask & #LVIF_TEXT 
              SubItemLesen(*lvdi\item\iItem, *lvdi\item\iSubItem+1)         
              *lvdi\item\pszText = lvdaten\p 
           EndIf 
        
;         ElseIf *nmlv\hdr\code = #LVN_ODFINDITEM 
;            Debug "W" 
;            *findinfo.NMLVFINDITEM = lParam
;            ;und nun wie weiter ?
           
        EndIf      
     EndIf 
  EndIf 

ProcedureReturn result 
EndProcedure 

Procedure.s ItemLesen(item)

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten  ;länge von lvdaten = Satzlänge

x$ = Space(lvdaten\satzlg) 
FileSeek(lvdaten\lvdnr, lvdaten\satzlg * item)     ;Dateizeiger auf item
ReadData(lvdaten\lvdnr, @x$, lvdaten\satzlg)   

ProcedureReturn x$
EndProcedure

Procedure SubItemLesen(item, subitem)

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten  ;länge von lvdaten = Satzlänge

bytepos = (lvdaten\satzlg * item) + felddaten(subitem)\offset

FileSeek(lvdaten\lvdnr, bytepos)                               ;Dateizeiger auf subitem
ReadData(lvdaten\lvdnr, lvdaten\p, felddaten(subitem)\laenge)  ;subitem lesen 
PokeC(lvdaten\p + felddaten(subitem)\laenge,0)                 ;NullChar setzen, dadurch Rest abtrennen

;rechte Leerzeichen entfernen durch Poke NullChar, 
;nur nötig wenn Columns zu klein, es erscheinen dann die AbkürzungsPunkte
   a$ = lvdaten\s
   lg =Len(RTrim(a$)): PokeC(lvdaten\p + lg,0)

;Debug lvdaten\s
EndProcedure

Procedure FeldDatenLesen()

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten

Restore Daten

satzlg = 0
felddaten(0)\offset = 0

Read lvdaten\feldanz
ReDim felddaten.felddaten(lvdaten\feldanz)

For j = 1 To lvdaten\feldanz
  felddaten(j)\offset = felddaten(j-1)\offset + felddaten(j-1)\laenge   
  Read felddaten(j)\laenge 
  satzlg + felddaten(j)\laenge
Next

For j = 1 To lvdaten\feldanz: Read felddaten(j)\name: Next
For j = 1 To lvdaten\feldanz: felddaten(j)\colbreite = felddaten(j)\laenge * 6: Next

lvdaten\satzlg = satzlg
lvdaten\p = AllocateMemory(lvdaten\satzlg+1)

EndProcedure

Procedure LV_AnzahlSelect(pbnr, liste(1))      ;16.10.07

                  
   id = GadgetID(pbnr)
   
   ;suchanz = Anzahl der selektierten Zeilen
   suchanz = SendMessage_(id, #LVM_GETSELECTEDCOUNT, 0, 0)

   Dim liste(suchanz)       ;hier kommen die Zeilennummern hinein
   liste(0)=suchanz
   
   If suchanz > 0
        n=GetGadgetState(pbnr)  ;n ist die Startposi von #LVM_GETNEXTITEM
        liste(1)=n              ; darum müssen diese 2 Zeilen sein
        For j=2 To suchanz
             n = SendMessage_(id,#LVM_GETNEXTITEM,n,#LVNI_SELECTED)              
             liste(j) = n
        Next 
        ;For j=1 To suchanz:Debug liste(j):Next
    EndIf
        
EndProcedure

Procedure LV_setRowtoMid(pbnr, zeile)
  
  idnr = GadgetID(pbnr)
  SendMessage_(idnr,#LVM_GETITEMRECT,0,r.RECT) 
  listitemhh = r\bottom - r\top          
  
  listmitte = SendMessage_(idnr,#LVM_GETCOUNTPERPAGE	,0,0) / 2                                  
  listtop   = SendMessage_(idnr,#LVM_GETTOPINDEX,0,0)                   
  
  listabstand2 = listitemhh * zeile 
  listabstand1 = listitemhh * (listtop + listmitte)           
  listdiff     = listabstand2 - listabstand1                  
  
  SendMessage_(idnr, #LVM_SCROLL, 0, listdiff)      

EndProcedure

Procedure LV_Eingabe(pbnr,ea,pbnr2=0,vorgabe$="")
Static oldpbnr2
If ea 
  x = GadgetX(pbnr2)
  y = GadgetY(pbnr2)
  HideGadget(pbnr2,1)
  ResizeGadget(pbnr,x,y,#PB_Ignore,#PB_Ignore)
  HideGadget(pbnr,0)
  SetGadgetText(pbnr,vorgabe$)
  SetActiveGadget(pbnr)
  oldpbnr2 = pbnr2 
Else
  HideGadget(oldpbnr2,0)
  HideGadget(pbnr,1)
EndIf  
ProcedureReturn oldpbnr2
EndProcedure
Procedure LV_FindItem(such$, start)

Shared lvpbnr
Shared infopbnr
Shared lvdaten.mylvdaten

  StatusBarText(infopbnr, 0, "bitte warten",4)
  For j = start To lvdaten\satzanz
    x$ = ItemLesen(j)
    If FindString(x$, such$,1)
       lastfind = j
       LV_setRowtoMid(lvpbnr, j)
       SetGadgetItemState(lvpbnr,j,1)
       Break
    Else
       lastfind = -1
    EndIf
  Next
  StatusBarText(infopbnr, 0, "Zeile: "+Str(lastfind+1),4)

ProcedureReturn lastfind
EndProcedure
Procedure LV_FindAllItem(such$)

Shared lvpbnr
Shared infopbnr
Shared lvdaten.mylvdaten

  StatusBarText(infopbnr, 0, "bitte warten",4)
  For j = 1 To lvdaten\satzanz
    x$ = ItemLesen(j)
    If FindString(x$, such$,1)
       i + 1
       LV_setRowtoMid(lvpbnr, j)      ;ohne geht schneller
       SetGadgetItemState(lvpbnr,j,1)
    EndIf
  Next
  StatusBarText(infopbnr, 0, "Anzahl: "+Str(i),4)
EndProcedure

Procedure WriteTestdatei(dat$, max)

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten

anz = 5
Dim vornamew.s(anz)
Dim vornamem.s(anz)
Dim nachname.s(anz)
Dim strasse.s(anz)
Dim stadt.s(anz)

Restore Daten1
For j = 0 To anz: Read vornamew(j): Next
For j = 0 To anz: Read vornamem(j): Next
For j = 0 To anz: Read nachname(j): Next
For j = 0 To anz: Read strasse(j):  Next
For j = 0 To anz: Read stadt(j):    Next

dnr = CreateFile(#PB_Any, dat$)

For i = 1 To max
  
  If Random(1)
    titel$ = "Frau"
    name$ = vornamew(Random(anz)) + nachname(Random(anz))
  Else
    titel$ = "Herr"
    name$ = vornamem(Random(anz)) + nachname(Random(anz))
  EndIf
  
  strasse$ = strasse(Random(anz)) + Str(Random(998) + 1)
  plzort$ = Str(Random(89999) + 10000) + stadt(Random(anz))
  
  x+1
  nummer$ = RSet(Str(x),10,"0")
  
  fillmemory_(lvdaten\p,lvdaten\satzlg,32)
  CopyMemory(@titel$,   lvdaten\p + felddaten(1)\offset, Len(titel$))
  CopyMemory(@name$,    lvdaten\p + felddaten(2)\offset, Len(name$))
  CopyMemory(@strasse$, lvdaten\p + felddaten(3)\offset, Len(strasse$))
  CopyMemory(@plzort$,  lvdaten\p + felddaten(4)\offset, Len(plzort$))
  CopyMemory(@nummer$,  lvdaten\p + felddaten(5)\offset, Len(nummer$))
  
  WriteData(dnr, lvdaten\p, lvdaten\satzlg)
        
Next

CloseFile(dnr)

EndProcedure

DataSection
Daten:
Data.i 5
Data.i 10,30,30,30,15
Data.s "Anrede","Name","Strasse","Ort","Nummer"
Daten1:
Data.s "Beate ","Erna ","Anke ","Ute ","Christa ","Hella "
Data.s "Rainer ","Holger ","Otto ","Bernd ","Werner ","Anton "
Data.s "Schulze","Meier","Holzauge","Müller","Kraft","Kaufmann"
Data.s "Schulstr. ","Hauptstr. ","Wiesenweg ","Mühlenstr. ","Hofweg ","Am Redder "
Data.s " Wiesbaden"," Hamburg"," Bonn"," Freiberg"," Köln"," Kleinkleckersdorf"
EndDataSection

Verfasst: 10.02.2009 22:19
von Rings
Der code lässt sich leider nicht mit 4.3 compilieren..... :cry:

Verfasst: 10.02.2009 22:43
von hjbremer
was gibt es denn für Fehlermeldungen ?

vielleicht fehlendes Schlüsselwort Array bei Parameterübergabe ?
das gibts in 4.2 ja nicht

Verfasst: 10.02.2009 22:56
von Kiffi
Anpassungen für PB V4.3:

Zeile 3:

Code: Alles auswählen

Declare LV_AnzahlSelect(pbnr, array liste(1))      ;
Zeile 295:

Code: Alles auswählen

  For j = 1 To lvdaten\feldanz: Read.s felddaten(j)\name: Next
Zeile 303:

Code: Alles auswählen

Procedure LV_AnzahlSelect(pbnr, array liste(1))      ;16.10.07
Zeile 413ff:

Code: Alles auswählen

  For j = 0 To anz: Read.s vornamew(j): Next
  For j = 0 To anz: Read.s vornamem(j): Next
  For j = 0 To anz: Read.s Nachname(j): Next
  For j = 0 To anz: Read.s strasse(j):  Next
  For j = 0 To anz: Read.s stadt(j):    Next
@hjbremer: Danke für den Code! :allright:

Grüße ... Kiffi

Verfasst: 10.02.2009 23:04
von ts-soft
Sobald ich ins leere ListView klicke gibts nen IMA:
264 : FileSeek(lvdaten\lvdnr, bytepos) ;Dateizeiger auf subitem

Egal ob 4.20 oder 4.30

Da fehlt wohl ein check!

Verfasst: 11.02.2009 13:52
von Andesdaf
danke für den Code, hjbremer :D

Verfasst: 11.02.2009 18:56
von hjbremer
TS-SOFT, du sollst ja auch zuerst -> Testdatei erstellen drücken <- :mrgreen:

ansonsten hast du recht :D

Verfasst: 11.02.2009 19:00
von ts-soft
hjbremer hat geschrieben:TS-SOFT, du sollst ja auch zuerst -> Testdatei erstellen drücken <- :mrgreen:
Als vorsichtiger Windows-User, drücke ich erstmal da, wo nicht viel/nichts
passieren kann :mrgreen: , also ins leere Control. Das es ausgerechet dort
gleich knallt kann ich ja nicht Wissen :wink:

Verfasst: 11.02.2009 23:28
von hjbremer
ts-soft hat geschrieben:Als vorsichtiger Windows-User
Für den vorsichtigen User, die entsprechende FileSeek Abfrage.
und nun der Code für PB 4.3 x86
Plus noch ein paar Änderungen:
Bei den Spalten wird ab null gezählt. Das Testdatenformat beinhaltet Feldtrenner und Satzende Zeichen. Sinnigerweise die Gleichen die man für ein normales Listicongadget braucht. Entsprechend wurde das Anzeigefeld in ein normales Listicongadget geändert.

Wer schon mit dem vorherigen Code gespielt und eine Test.dat hat, und nun die Anzeige verschoben ist, erstellt mit dem Button unten rechts einfach eine neue Datei.

Code: Alles auswählen

Declare FeldDatenLesen()
Declare LV_AnzahlSelect(pbnr, Array liste(1))      ;
Declare LV_Eingabe(pbnr,ea,pbnr2=0,vorgabe$="")
Declare LV_FindAllItem(such$)
Declare LV_FindItem(such$, start)
Declare LV_setRowtoMid(pbnr, zeile)
Declare SubItemLesen(item, subitem)
Declare WriteTestdatei(dat$, max)
Declare myWindowCallback(hwnd, message, wParam, lParam) 
Declare.s ItemLesen(item)

;PB 4.3 X86 - Windows XP

Structure felddaten
 laenge.i
 offset.i
 name.s
 colbreite.i
EndStructure

Structure mylvdaten
 StructureUnion
  p.i
  s.s
 EndStructureUnion
 flag.i
 lvdnr.i
 lvhwnd.i
 datlg.i
 satzlg.i
 satzanz.i
 satzende.w
 feldtr.w
 feldanz.i
EndStructure

; ---------------------------------------------

dat$ = "test.dat"

lvdaten.mylvdaten
Dim felddaten.felddaten(0)

FeldDatenLesen()

; ---------------------------------------------
;es funktioniert nicht 
; Checkboxen ? 
; SetGadgetItemColor 
; SetGadgetItemText 
; GetGadgetItemText !! es scheint nur zu funktionieren ?!! dafür SubItemLesen nehmen

lvdaten\lvdnr = OpenFile(#PB_Any, dat$)
lvdaten\datlg = Lof(lvdaten\lvdnr)
lvdaten\satzanz = lvdaten\datlg / lvdaten\satzlg

hwnd = OpenWindow(0, 50, 50, 810, 660, "V-Listview", #PB_Window_SystemMenu) 
      
     infopbnr= CreateStatusBar(#PB_Any, hwnd)
     strgpbnr= StringGadget(#PB_Any,  0,  0, 90,40,""): HideGadget(strgpbnr,1) 
     bt0pbnr = ButtonGadget(#PB_Any, 10,580, 90,40,"Anzeigefeld löschen",#PB_Button_MultiLine)
     bt1pbnr = ButtonGadget(#PB_Any,110,580, 90,40,"markierte Items übernehmen",#PB_Button_MultiLine)
     bt2pbnr = ButtonGadget(#PB_Any,210,580, 90,40,"Scroll to          ",#PB_Button_MultiLine)
     bt3pbnr = ButtonGadget(#PB_Any,310,580, 90,40,"Find               ",#PB_Button_MultiLine)
     bt4pbnr = ButtonGadget(#PB_Any,410,580, 90,40,"Find next          ",#PB_Button_MultiLine)
     bt5pbnr = ButtonGadget(#PB_Any,510,580, 90,40,"Find alle          ",#PB_Button_MultiLine)
     bt6pbnr = ButtonGadget(#PB_Any,610,580, 90,40,"Select oben löschen",#PB_Button_MultiLine)
     bt9pbnr = ButtonGadget(#PB_Any,710,580, 90,40,"Testdatei erstellen",#PB_Button_MultiLine)
          
     ;Liste unten
     lvflag = #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection
     showpbnr = ListIconGadget(#PB_Any, 10,410,785,150,felddaten(0)\name, felddaten(0)\colbreite, lvflag)
                showidnr = GadgetID(showpbnr)
                fontid = FontID(LoadFont(#PB_Any,"Arial",9))
                SetGadgetFont(showpbnr,fontid)
     
     For j = 1 To lvdaten\feldanz 
      AddGadgetColumn(showpbnr,j,felddaten(j)\name,felddaten(j)\colbreite)
     Next
     SendMessage_(showidnr, #LVM_SETCOLUMNWIDTH, 4, #LVSCW_AUTOSIZE_USEHEADER) 

     ;Liste oben
     lvflag = #LVS_OWNERDATA|#PB_ListIcon_GridLines|#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection
     lvpbnr = ListIconGadget(#PB_Any, 10,2,785,390, felddaten(0)\name, felddaten(0)\colbreite, lvflag)
              lvdaten\lvhwnd = GadgetID(lvpbnr)
              ;fontid = FontID(LoadFont(#PB_Any,"Courier New",8))
              ;SetGadgetFont(lvpbnr,fontid)

     For j = 1 To lvdaten\feldanz 
      AddGadgetColumn(lvpbnr,j,felddaten(j)\name,felddaten(j)\colbreite)
     Next
     
     ;Reihenfolge von SendMessage muß so sein
     ;Breite der letzten Column anpassen
     SendMessage_(lvdaten\lvhwnd, #LVM_SETCOLUMNWIDTH, 4, #LVSCW_AUTOSIZE_USEHEADER) 
     
     ;neben dem Callback und ItemLesen ist dies die wichtigste Anweisung
     ;teilt dem ListIconGadget mit wieviele Datensätze zu verwalten sind
     SendMessage_(lvdaten\lvhwnd, #LVM_SETITEMCOUNT, lvdaten\satzanz, 0) 
  
     SetWindowCallback(@myWindowCallback()) 
     
     SetGadgetColor(lvpbnr, #PB_Gadget_BackColor, #Yellow)
     SetGadgetColor(lvpbnr, #PB_Gadget_FrontColor, #Blue)
     SetGadgetColor(lvpbnr, #PB_Gadget_LineColor, #Red)
     
     SetGadgetFont(lvpbnr,fontid)     
     StatusBarText(infopbnr, 0, dat$ + " - Anzahl: "+Str(lvdaten\satzanz),4)     
               
Repeat 
    event = WaitWindowEvent() 
    Select event 
          Case #PB_Event_Gadget 
            Select EventGadget() 
              ;in Liste geklickt
              Case lvpbnr 
                  If EventType() = #PB_EventType_LeftClick 
                      ;wo in Liste geklickt ?
                      GetCursorPos_(p.POINT) 
                      MapWindowPoints_(0,lvdaten\lvhwnd,p,1) 
                      HitInfo.LVHITTESTINFO 
                      Hitinfo\pt\x = p\x 
                      HitInfo\pt\y = p\y 
                      SendMessage_(lvdaten\lvhwnd,#LVM_SUBITEMHITTEST ,0,HitInfo) 
                      
                      ;wenn ListIconGadget zu breit und es wird in die undefinierte Spalte geklickt
                      If hitinfo\iitem = -1:hitinfo\iitem = 0:EndIf
                      If hitinfo\isubitem = -1:hitinfo\isubitem = 0:EndIf
                      
                      ;subitem anzeigen
                      SubItemLesen(hitinfo\iitem, hitinfo\isubitem)
                      If lasthit <> hitinfo\iitem
                       lasthit = hitinfo\iitem
                       lastitem = CountGadgetItems(showpbnr)
                       AddGadgetItem(showpbnr,-1, "")
                      EndIf
                      SetGadgetItemText(showpbnr,lastitem,lvdaten\s,hitinfo\isubitem)
                      SendMessage_(showidnr,#LVM_ENSUREVISIBLE,lastitem,0)                                        
                      ;erste markierte Zeile ist ?                   
                      nr = GetGadgetState(lvpbnr) + 1                  
                      StatusBarText(infopbnr, 0, "1.markierte ZeilenNr.ist: "+Str(nr),4)
                  EndIf
              
              ;Anzeigefeld löschen
              Case bt0pbnr
                  ClearGadgetItems(showpbnr)   
              
              ;markierte Zeilen anzeigen      
              Case bt1pbnr        
                  SendMessage_(showidnr,#WM_SETREDRAW, #False, 0)  ;fast wie Disablegadget
                  StatusBarText(infopbnr, 0, "bitte warten",4)
                  Dim liste(0)
                  LV_AnzahlSelect(lvpbnr,liste())   
                  For j = 1 To liste(0)  ;in liste(0) steht die Anzahl der markierten Zeilen
                    nr = liste(j)
                    AddGadgetItem(showpbnr,-1,ItemLesen(nr))
                  Next
                  SendMessage_(showidnr, #WM_SETREDRAW, #True, 0) 
                  InvalidateRect_(showidnr, 0, #True) 
                  lastitem = CountGadgetItems(showpbnr)-1
                  SendMessage_(showidnr,#LVM_ENSUREVISIBLE,lastitem,0)
                  StatusBarText(infopbnr, 0, "Anzahl: "+Str(liste(0)),4)

              ;Scroll to
              Case bt2pbnr
                  LV_Eingabe(strgpbnr,1,bt2pbnr)
                  
              ;Find 
              Case bt3pbnr
                  lastfind = -1
                  If Not such$: such$ = "Ute Kaufmann": EndIf
                  LV_Eingabe(strgpbnr,1,bt3pbnr, such$)
              
              ;Find next            
              Case bt4pbnr
                  If lastfind > -1
                     lastfind = LV_FindItem(such$, lastfind+1) 
                  EndIf
                  
              ;Find all
              Case bt5pbnr
                  lastfind = -1
                  If Not such$: such$ = "Ute Kaufmann": EndIf
                  LV_Eingabe(strgpbnr,1,bt5pbnr, such$)
              
              ;Select oben löschen
              Case bt6pbnr
                  SetGadgetState(lvpbnr,-1)

              ;Testdatei erstellen               
              Case bt9pbnr
                  LV_Eingabe(strgpbnr,1,bt9pbnr)
              
            EndSelect 
      Case #WM_KEYDOWN
            If EventwParam() = #VK_RETURN
               If EventGadget() = strgpbnr
                  gadget = LV_Eingabe(strgpbnr,0) 
                  such$   = GetGadgetText(strgpbnr)
                  eingabe = Val(GetGadgetText(strgpbnr))
                  Select gadget
                    
                    ;Scroll to
                    Case bt2pbnr: 
                      If eingabe < 1: eingabe = 1: EndIf
                      If eingabe > lvdaten\satzanz: eingabe = lvdaten\satzanz: EndIf
                      LV_setRowtoMid(lvpbnr, eingabe)
                      SetGadgetState(lvpbnr,eingabe-1) 
                    
                    ;Find
                    Case bt3pbnr:
                      SetGadgetState(lvpbnr,-1)
                      lastfind = LV_FindItem(such$,0)
                    
                    ;Find All
                    Case bt5pbnr:
                      SetGadgetState(lvpbnr,-1)
                      LV_FindAllItem(such$)
                    
                    ;Testdatei erstellen 
                    Case bt9pbnr: ;auf 1 Million begrenzt = 112 MB
                      If eingabe < 100: eingabe = 100: EndIf
                      If eingabe > 1000000: eingabe = 1000000: EndIf
                      CloseFile(lvdaten\lvdnr)
                      StatusBarText(infopbnr, 0, dat$ + " wird erstellt",4)
                      WriteTestdatei(dat$, eingabe) 
                      lvdaten\lvdnr = OpenFile(#PB_Any, dat$)
                      lvdaten\datlg = Lof(lvdaten\lvdnr)
                      lvdaten\satzanz = lvdaten\datlg / lvdaten\satzlg              
                      SendMessage_(lvdaten\lvhwnd, #LVM_SETITEMCOUNT, lvdaten\satzanz, 0)
                      StatusBarText(infopbnr, 0, dat$ + " - Anzahl: "+Str(lvdaten\satzanz),4)
                      SetGadgetState(lvpbnr,-1)
                  EndSelect
               EndIf
            EndIf
    EndSelect 
Until event = #PB_Event_CloseWindow 

CloseFile(lvdaten\lvdnr)

End

; ---------------------------------------------
Procedure myWindowCallback(hwnd, message, wParam, lParam) 
  
  Shared lvdaten.mylvdaten   
  result = #PB_ProcessPureBasicEvents 
  
  If message=#WM_NOTIFY 
     ;Header sperren, egal welche Liste
     *nmhd.NMHEADER = lParam 
     If *nmhd\hdr\code = #HDN_ITEMCHANGING: result = #True: EndIf 

     ;Liste oben
     *nmlv.NM_LISTVIEW = lParam 
     If *nmlv\hdr\hwndFrom = lvdaten\lvhwnd 
        If *nmlv\hdr\code = #LVN_GETDISPINFO 
           
           ; Item text zuweisen
           *lvdi.LV_DISPINFO = lParam 
           If *lvdi\item\mask & #LVIF_TEXT 
              SubItemLesen(*lvdi\item\iItem, *lvdi\item\iSubItem)         
              *lvdi\item\pszText = lvdaten\p  ;pointer auf subitem
           EndIf
                         
        EndIf      
     EndIf 
  EndIf 

ProcedureReturn result 
EndProcedure 

Procedure SubItemLesen(item, subitem)

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten  ;Speicherbereich von lvdaten = Satzlänge

bytepos = (lvdaten\satzlg * item) + felddaten(subitem)\offset
If bytepos < lvdaten\datlg
 FileSeek(lvdaten\lvdnr, bytepos)                               ;Dateizeiger auf subitem
 ReadData(lvdaten\lvdnr, lvdaten\p, felddaten(subitem)\laenge)  ;subitem lesen 
EndIf

;da in den Testdaten bereits NullChar vorhanden, 
;ist folgender Code nicht mehr nötig
;außer man benutzt ein anderes Datenformat, dann ev. doch wieder
;NullChar setzen, dadurch Rest abtrennen
;    PokeC(lvdaten\p + felddaten(subitem)\laenge,0)                 
;rechte Leerzeichen entfernen durch Poke NullChar, 
;    a$ = lvdaten\s
;    lg =Len(RTrim(a$)): PokeC(lvdaten\p + lg,0)

;Debug lvdaten\s
EndProcedure
Procedure.s ItemLesen(item)

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten  ;länge von lvdaten = Satzlänge

x$ = Space(lvdaten\satzlg) 

bytepos = lvdaten\satzlg * item
If bytepos < lvdaten\datlg
 FileSeek(lvdaten\lvdnr, bytepos)     ;Dateizeiger auf item
 ReadData(lvdaten\lvdnr, @x$, lvdaten\satzlg)   
EndIf

;NullChar entfernen
For j = 0 To lvdaten\satzlg-1
 If Not PeekC(@x$+j): PokeC(@x$+j,32): EndIf  ;:Debug PeekC(@x$+j)
Next

ProcedureReturn x$
EndProcedure

Procedure LV_AnzahlSelect(pbnr, Array liste(1))      ;16.10.07

                  
   id = GadgetID(pbnr)
   
   ;suchanz = Anzahl der selektierten Zeilen
   suchanz = SendMessage_(id, #LVM_GETSELECTEDCOUNT, 0, 0)

   Dim liste(suchanz)       ;hier kommen die Zeilennummern hinein
   liste(0)=suchanz
   
   If suchanz > 0
        n=GetGadgetState(pbnr)  ;n ist die Startposi von #LVM_GETNEXTITEM
        liste(1)=n              ; darum müssen diese 2 Zeilen sein
        For j=2 To suchanz
             n = SendMessage_(id,#LVM_GETNEXTITEM,n,#LVNI_SELECTED)              
             liste(j) = n
        Next 
        ;For j=1 To suchanz:Debug liste(j):Next
    EndIf
        
EndProcedure
Procedure LV_setRowtoMid(pbnr, zeile)
  
  idnr = GadgetID(pbnr)
  SendMessage_(idnr,#LVM_GETITEMRECT,0,r.RECT) 
  listitemhh = r\bottom - r\top          
  
  listmitte = SendMessage_(idnr,#LVM_GETCOUNTPERPAGE	,0,0) / 2                                  
  listtop   = SendMessage_(idnr,#LVM_GETTOPINDEX,0,0)                   
  
  listabstand2 = listitemhh * zeile 
  listabstand1 = listitemhh * (listtop + listmitte)           
  listdiff     = listabstand2 - listabstand1                  
  
  SendMessage_(idnr, #LVM_SCROLL, 0, listdiff)      

EndProcedure
Procedure LV_Eingabe(pbnr,ea,pbnr2=0,vorgabe$="")
Static oldpbnr2
If ea 
  x = GadgetX(pbnr2)
  y = GadgetY(pbnr2)
  HideGadget(pbnr2,1)
  ResizeGadget(pbnr,x,y,#PB_Ignore,#PB_Ignore)
  HideGadget(pbnr,0)
  SetGadgetText(pbnr,vorgabe$)
  SetActiveGadget(pbnr)
  SendMessage_(GadgetID(pbnr),#EM_SETSEL,0,Len(vorgabe$))
  oldpbnr2 = pbnr2 
Else
  HideGadget(oldpbnr2,0)
  HideGadget(pbnr,1)
EndIf  
ProcedureReturn oldpbnr2
EndProcedure
Procedure LV_FindItem(such$, start)

Shared lvpbnr
Shared infopbnr
Shared lvdaten.mylvdaten

  StatusBarText(infopbnr, 0, "bitte warten",4)
  For j = start To lvdaten\satzanz
    x$ = ItemLesen(j)
    If FindString(x$, such$,1)
       lastfind = j
       LV_setRowtoMid(lvpbnr, j)
       SetGadgetItemState(lvpbnr,j,1)
       Break
    Else
       lastfind = -1
    EndIf
  Next
  StatusBarText(infopbnr, 0, "Zeile: "+Str(lastfind+1),4)

ProcedureReturn lastfind
EndProcedure
Procedure LV_FindAllItem(such$)

Shared lvpbnr
Shared infopbnr
Shared lvdaten.mylvdaten
  StatusBarText(infopbnr, 0, "bitte warten",4)
  For j = 0 To lvdaten\satzanz -1
    x$ = ItemLesen(j)
    If FindString(x$, such$,1)
       i + 1
       LV_setRowtoMid(lvpbnr, j)      ;ohne geht es 10% schneller
       SetGadgetItemState(lvpbnr,j,1)
    EndIf
  Next
  StatusBarText(infopbnr, 0, "Anzahl: "+Str(i),4)
EndProcedure

Procedure FeldDatenLesen()

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten

Restore FeldDaten

Read.w lvdaten\satzende
Read.w lvdaten\feldtr
Read.i lvdaten\feldanz
ReDim  felddaten.felddaten(lvdaten\feldanz)

lvdaten\feldanz - 1  ;wenn bei Data eine 5 steht, bei 5 Feldern = 0,1,2,3,4 
lvdaten\satzlg = 0

For j = 0 To lvdaten\feldanz
  Read felddaten(j)\laenge 
  lvdaten\satzlg + SizeOf(lvdaten\feldtr) + felddaten(j)\laenge
Next
lvdaten\satzlg + SizeOf(lvdaten\satzende)

felddaten(0)\offset = 0       ;offset Feld 0
For j = 1 To lvdaten\feldanz  ;offset Feld 1-4
  felddaten(j)\offset = felddaten(j-1)\offset + SizeOf(lvdaten\feldtr) + felddaten(j-1)\laenge   
Next

For j = 0 To lvdaten\feldanz: Read.s felddaten(j)\name: Next

;die * 6 ist ausgedacht, je nach Font auch größer
For j = 0 To lvdaten\feldanz: felddaten(j)\colbreite = felddaten(j)\laenge * 6: Next

;zeiger auf Speicherbereich für einen Datensatz, incl. SatzendeChar
lvdaten\p = AllocateMemory(lvdaten\satzlg)  ;AllocateMemory initialisiert mit NullChar

EndProcedure
Procedure WriteTestdatei(dat$, max)

Shared felddaten.felddaten()
Shared lvdaten.mylvdaten

anz = 5              ; 0,1,2,3,4,5 = 6; siehe Datas
Dim vornamew.s(anz)
Dim vornamem.s(anz)
Dim nachname.s(anz)
Dim strasse.s(anz)
Dim stadt.s(anz)

Restore DatenTestdatei
For j = 0 To anz: Read.s vornamew(j): Next
For j = 0 To anz: Read.s vornamem(j): Next
For j = 0 To anz: Read.s nachname(j): Next
For j = 0 To anz: Read.s strasse(j):  Next
For j = 0 To anz: Read.s stadt(j):    Next

pfeldtr = @lvdaten\feldtr: lgfeldtr = SizeOf(lvdaten\feldtr)
psatzende = @lvdaten\satzende: lgsatzende = SizeOf(lvdaten\satzende)

dnr = CreateFile(#PB_Any, dat$)

For i = 1 To max
  
  If Random(1)
    titel$ = "Frau"
    name$ = vornamew(Random(anz)) + nachname(Random(anz))
  Else
    titel$ = "Herr"
    name$ = vornamem(Random(anz)) + nachname(Random(anz))
  EndIf
  
  strasse$ = strasse(Random(anz)) + Str(Random(998) + 1)
  plzort$ = Str(Random(89999) + 10000) + stadt(Random(anz))
  
  x+1
  nummer$ = RSet(Str(x),10,"0")
  
  fillmemory_(lvdaten\p,lvdaten\satzlg,0)
  CopyMemory(@titel$,   lvdaten\p + felddaten(0)\offset, Len(titel$))
  CopyMemory(@name$,    lvdaten\p + felddaten(1)\offset, Len(name$))
  CopyMemory(@strasse$, lvdaten\p + felddaten(2)\offset, Len(strasse$))
  CopyMemory(@plzort$,  lvdaten\p + felddaten(3)\offset, Len(plzort$))
  CopyMemory(@nummer$,  lvdaten\p + felddaten(4)\offset, Len(nummer$))
  
  ;Feldtrenner und Satzende Char einsetzen
  For j = 0 To lvdaten\feldanz
      CopyMemory(pfeldtr,  lvdaten\p + felddaten(j)\offset + felddaten(j)\laenge, lgfeldtr)
  Next
  CopyMemory(psatzende,  lvdaten\p + lvdaten\satzlg - lgsatzende, lgsatzende)
  
  WriteData(dnr, lvdaten\p, lvdaten\satzlg)
        
Next

CloseFile(dnr)

DataSection
DatenTestdatei:
Data.s "Beate ","Erna ","Anke ","Ute ","Christa ","Hella "
Data.s "Rainer ","Holger ","Otto ","Bernd ","Werner ","Anton "
Data.s "Schulze","Meier","Holzauge","Müller","Kraft","Kaufmann"
Data.s "Schulstr. ","Hauptstr. ","Wiesenweg ","Mühlenstr. ","Hofweg ","Am Redder "
Data.s " Wiesbaden"," Hamburg"," Bonn"," Freiberg"," Köln"," Kleinkleckersdorf"
EndDataSection

EndProcedure

DataSection
FeldDaten:
Data.w $0d00            ;Satzende    wird umgedreht gespeichert also 00 13
Data.w $0a00            ;Feldtrenner
Data.i 5                ;Feldanzahl
Data.i 10,30,30,30,15   ;Feldlängen
Data.s "Anrede","Name","Strasse","Ort","Nummer"  ;Feldname
EndDataSection
PS: wenn man in Zeile 86 das Semikolon wegmacht, dann passiert bei mir etwas sehr Komisches. Obwohl SetGadgetFont in Zeile 87 weiter auskommentiert ist, ändert sich der Font der Liste.

Ist das bei euch auch so ?

PSPS: hat schon einer eine schnellere Suchfunktion ?

Verfasst: 12.02.2009 20:25
von Andesdaf
hjbremer hat geschrieben:PS: wenn man in Zeile 86 das Semikolon wegmacht, dann passiert bei mir etwas sehr Komisches. Obwohl SetGadgetFont in Zeile 87 weiter auskommentiert ist, ändert sich der Font der Liste.

Ist das bei euch auch so ?
Ja, bei mir auch aber wird nicht auf Zeile 107 noch mal fontid aufgerufen?
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de