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
