Vor einiger Zeit war im englischem Forum ein gutes kurzes Beispiel und ich dachte mir versuche es doch mal wieder.
Ein Virtuelles ListIconGadget kurz VLV, kann sehr große Datenmengen anzeigen (100 Millionen Zeilen) aber leider unterstützt PB dies nicht.
Ebenfalls kann man fast alle Befehle für das ListIconGadget vergessen, denn es speichert die Daten nicht mehr selbst und das ist
der entscheidende Punkt.
Kurze Rede langer Sinn, jeder weiß das ein ListIconGadget ab ca 10000 Zeilen langsam wird. Die Lösung kann ein Virtuelles ListIconGadget sein.
Es kommt darauf an was für Daten es sind. Sind es "fünf hundert tausend" Daten die sortiert werden müssen ? dann sollten Sie nicht weiterlesen. Nicht meine Klasse.
Aber fortlaufende Daten wie Kontodaten, laufende Meßergebnisse, laufende Einnahmen etc. also alles was in der Reihenfolge nicht oder selten verändert wird,
kann man recht einfach proggen. Insbesondere wenn man auf Speicherplatzsparende Datenformate verzichtet und mit fester Satzlänge arbeitet.
Die Daten können dann sehr einfach von Festplatte gelesen werden.
Das folgende Beispiel setzt dies um und zeigt was möglich ist mit einfachen Mitteln. Das einzige wirkliche Problem ist der Umgang mit neuen Daten. Sollen diese am
Anfang der Liste stehen so wie ich Annehme es die meisten von uns gewohnt sind oder am Ende.
Am Ende wäre simpel, man hängt die Daten einfach an die Datei an. Am Anfang bedeutet man muß den Dateiinhalt verschieben. Ich habe mich in diesem Programm
für Daten am Anfang entschieden. Vor allem weil ich es so gewohnt bin und die Zeit die mein alter Rechner braucht um Daten via eigenem Code zu verschieben im
Rahmen bleibt. Für je 50000 Datensätze a 100 Bytes braucht meine Windowskiste mit seinem Intel Core I3 knapp 200 Millisekunden. Und das reicht mir.
Es folgt zuerst ein Progrämchen um die Daten zu erstellen. Dann das Mainprogramm. Erstellen Sie am Besten ein eigenes Verzeichnis dafür.
Vermeiden Sie Dateinamen mit 2 Endungen z.B. Text.txt.old , mein Windows 10 oder PB 5.72 oder die DropBox hatte Probleme damit.
Im übrigen nobody is perfekt. Fehler gibts umsonst (hoffe nicht), Fragen sind willkommen - nur nicht wie sortiere ich das (da fängt das Wissen oder der Aufwand an)
Daten erstellen
Code: Alles auswählen
Dim vorname.s(10): Dim nachname.s(10)
For j = 0 To 10: Read.s vorname(j): Next
For j = 0 To 10: Read.s nachname(j): Next
#lfdnr = 7
#plzlg = 5
#datelg = 10
#name1lg = 30
#name2lg = 30
#euro1lg = 10
#trenn = #LF$
mask$ = "%dd.%mm.%yyyy"
datewert = Date() ;ParseDate(mask$, "01.01.1995")
vlvFile$ = "vlvtest2.txt"
CreateFile(1, vlvFile$, #PB_Ascii)
For j = 100000 To 0 Step -1 ;wenn mehr Daten dann MOD() für Datum erhöhen
plznr = Random(99999, 10000): k1 = Random(10): k2 = Random(10)
cent = Random(458888, 345)
euro1$ = StrD(cent/100, 2)
satz$ = RSet(Str(j), #lfdnr, "0") + #trenn
satz$ + FormatDate(mask$, datewert) + #trenn
satz$ + LSet(Str(plznr), #plzlg, " ") + #trenn
satz$ + LSet(vorname(k1), #name1lg, " ") + #trenn
If j = 39990
satz$ + LSet("Lastdata", #name2lg, " ") + #trenn
ElseIf j = 49990
satz$ + LSet("Lastdata", #name2lg, " ") + #trenn
Else
satz$ + LSet(nachname(k2), #name2lg, " ") + #trenn
EndIf
satz$ + LSet(euro1$, #euro1lg, " ") + #trenn
If Mod(j, 10) = 0: datewert = AddDate(datewert, #PB_Date_Day, -1): EndIf
WriteString(1, satz$)
Next
CloseFile(1)
OpenPreferences("virlvtest.prf", #PB_Preference_GroupSeparator)
PreferenceGroup("virlvtest Diverses")
WritePreferenceString("vlvFile", vlvFile$)
PreferenceGroup("virlvtest Feldlängen")
WritePreferenceInteger("trenn", #LF)
WritePreferenceInteger("LfdNr", #lfdnr)
WritePreferenceInteger("Date", #datelg)
WritePreferenceInteger("PLZ", #plzlg)
WritePreferenceInteger("Name1", #name1lg)
WritePreferenceInteger("Name2", #name2lg)
WritePreferenceInteger("Euro1", #euro1lg)
ClosePreferences()
DataSection
Data.s "Hans ", "Otto ", "Werner ", "Mike", "Eva ", "Rita ", "Erna ", "Gabi", "Bernd ", "Lotte ", "Ralf "
Data.s "Meier ", "König ", "Bradow ", "Filda", "Rogal ", "Nebel ", "Dorf ", "Stadt", "Folmer ", "Gruber ", "Zabel "
EndDataSection
Code: Alles auswählen
;by HJBremer Juni 2023 V1.00 - Demo für Ein Virtuelles ListIconGadget
;Quelle Callback: https://www.purebasic.fr/english/viewtopic.php?t=75211
;weitere https://www.purebasic.fr/english/viewtopic.php?t=76419&start=30 - nicht getestet aber ev. gut
;Lesen: https://learn.microsoft.com/en-us/windows/win32/controls/list-view-controls-overview#virtual-list-view-style
;geschrieben mit PB 5.72 x64 Windows 10
#LVSICF_NOINVALIDATEALL = 1 ;nicht in PB definiert, für #LVM_SETITEMCOUNT
#LVSICF_NOSCROLL = 2 ;nicht in PB definiert, für #LVM_SETITEMCOUNT
EnableExplicit
;Programm
Enumeration 200
#window
#statusbar
#mainliste
#spin
#strg1: #strg2: #strg3: #strg4: #strg5: #strg6: #butchg: #butnew
#strgsuch: #such1: #such2
#buttest
EndEnumeration
#vlvdatnr = 1 ;Mainfile Dateinummer für Openfile() etc.
Global vlvFile$
Global lastselect, lastsearch$, datemask$ = "%dd.%mm.%yyyy"
Global feldtrenn$, satzlaenge
Global feldlg_Lfdnr, feldlg_Date, feldlg_PLZ, feldlg_Name1, feldlg_Name2, feldlg_Euro1
Procedure.i PreferenceFile(flag=0)
OpenPreferences("virlvtest.prf", #PB_Preference_GroupSeparator)
If flag = 0
PreferenceGroup("virlvtest Diverses")
vlvFile$ = ReadPreferenceString("vlvFile", "")
lastselect = ReadPreferenceInteger("Select", 10)
lastsearch$ = ReadPreferenceString("Search", "")
PreferenceGroup("virlvtest Feldlängen")
feldtrenn$ = Chr(ReadPreferenceInteger("trenn", #LF))
feldlg_Lfdnr = ReadPreferenceInteger("LfdNr", 9)
feldlg_Date = ReadPreferenceInteger("Date", 10)
feldlg_PLZ = ReadPreferenceInteger("PLZ", 5)
feldlg_Name1 = ReadPreferenceInteger("Name1", 30)
feldlg_Name2 = ReadPreferenceInteger("Name2", 30)
feldlg_Euro1 = ReadPreferenceInteger("Euro1", 10)
;Satzlänge + 2 wenn WriteStringN() für EOL
satzlaenge = 6 ;6 mal feldtrenn$
satzlaenge + feldlg_Lfdnr + feldlg_Date + feldlg_PLZ
satzlaenge + feldlg_Name1 + feldlg_Name2 + feldlg_Euro1
Else
PreferenceGroup("virlvtest Diverses")
WritePreferenceString("Search", lastsearch$)
WritePreferenceInteger("Select", GetGadgetState(#mainliste))
EndIf
ClosePreferences()
EndProcedure
Procedure.s ReadStringLine(file, item, length)
;file = PB DateiNr
;item = DatensatzNr in Liste/Datei
;length = feste Satzlänge
If item < 0: ProcedureReturn: EndIf
Protected posi ;Position relativ zum Anfang der Datei.
Protected line$ ;Datensatz
Protected datlg = Lof(file) ;Dateigröße
posi = item * length
If posi < datlg
FileSeek(file, posi)
line$ = ReadString(file, #PB_Ascii|#PB_File_IgnoreEOL, length) ;liest ganzen satz
EndIf
ProcedureReturn line$
EndProcedure
Procedure.s MakeChgItem()
Protected satz$
satz$ = GetGadgetText(#strg1) + feldtrenn$
satz$ + GetGadgetText(#strg2) + feldtrenn$
satz$ + LSet(GetGadgetText(#strg3), feldlg_PLZ, " ") + feldtrenn$
satz$ + LSet(GetGadgetText(#strg4), feldlg_Name1, " ") + feldtrenn$
satz$ + LSet(GetGadgetText(#strg5), feldlg_Name2, " ") + feldtrenn$
satz$ + LSet(GetGadgetText(#strg6), feldlg_Euro1, " ") + feldtrenn$
ProcedureReturn satz$
EndProcedure
Procedure.s MakeNewItem(lastlfdnr)
Protected satz$
Protected lfdnr$ = RSet(Str(lastlfdnr+1), feldlg_Lfdnr, "0")
Protected datum$ = FormatDate(datemask$, Date())
satz$ = lfdnr$ + feldtrenn$
satz$ + datum$ + feldtrenn$
satz$ + LSet(GetGadgetText(#strg3), feldlg_PLZ, " ") + feldtrenn$
satz$ + LSet(GetGadgetText(#strg4), feldlg_Name1, " ") + feldtrenn$
satz$ + LSet(GetGadgetText(#strg5), feldlg_Name2, " ") + feldtrenn$
satz$ + LSet(GetGadgetText(#strg6), feldlg_Euro1, " ") + feldtrenn$
ProcedureReturn satz$
EndProcedure
Procedure.i ModifyItem(file, item)
;Global: satzlaenge
Protected satz$ = MakeChgItem()
If Len(satz$) = satzlaenge ;zur Sicherheit abfragen
FileSeek(file, item * satzlaenge)
WriteString(file, satz$, #PB_Ascii)
SendMessage_(GadgetID(#mainliste), #LVM_UPDATE, item, 0) ;erzwingt Änderung anzeigen
EndIf
EndProcedure
Procedure.i AddNewItem(file)
;neue Daten werden an den Anfang der Datei gesetzt und die alten Daten dahinter geschrieben
;Global: vlvFile$, satzlaenge, feldtrenn$
Protected old, itemcount, ms = ElapsedMilliseconds()
Protected line$ = ReadStringLine(file, 0, satzlaenge)
Protected lfdnr = Val(StringField(line$, 1, feldtrenn$))
Protected satz$ = MakeNewItem(lfdnr)
;Liste deaktivieren, Datenquelle schliessen
SendMessage_(GadgetID(#mainliste), #WM_SETREDRAW, #False, 0)
SendMessage_(GadgetID(#mainliste), #LVM_SETITEMCOUNT, 0, 0)
CloseFile(file)
;Datenquelle neu
DeleteFile("xold.txt") ;Löschen wenn vorhanden
RenameFile(vlvFile$, "xold.txt") ;Original wird old
CreateFile(file, vlvFile$, #PB_Ascii) ;Original neu erstellen
WriteString(file, satz$, #PB_Ascii) ; neue Daten
old = ReadFile(#PB_Any, "xold.txt", #PB_Ascii) ;old zum lesen öffnen
Protected block$, length = satzlaenge * 200 ;length größer bringt nicht viel
While Eof(old) = 0
block$ = ReadString(old, #PB_Ascii|#PB_File_IgnoreEOL, length)
WriteString(file, block$, #PB_Ascii)
Wend
CloseFile(old)
CloseFile(file)
;Liste aktivieren
OpenFile(file, vlvFile$, #PB_Ascii)
itemCount = Lof(file) / satzlaenge
SendMessage_(GadgetID(#mainliste), #LVM_SETITEMCOUNT, itemCount, 0)
SendMessage_(GadgetID(#mainliste), #WM_SETREDRAW, #True, 0)
SetGadgetState(#mainliste, 0)
StatusBarText(#statusbar, 0, Str(ElapsedMilliseconds() - ms), 4)
StatusBarText(#statusbar, 1, Str(Lof(file) / satzlaenge), 4)
EndProcedure
Procedure.i SearchText(file, search$, startitem=0, anzahlitem = 100)
;durchsucht eine Datei in Abschnitten einer bestimmten Anzahl von Datensätzen
;file = PB Dateinr
;search$ = Text der enthalten sein muß
;startitem = ab welchem Datensatz suchen
;anzahlitem = wieviele Datensätze auf einmal lesen
; anzahlitem * satzlaenge sollte nicht größer sein als ca 16000, ab da wird Findstring() langsamer
; anzahlitem zu klein machen ist ebenfalls nix gut, denn dann wird die Schleife zu oft aufgerufen
Protected txt$
Protected posi ;Ergebnis von FindString
Protected item = -1 ;item in Datei wenn gefunden
Protected length = satzlaenge * anzahlitem ;Länge zu lesender Datenblock
FileSeek(file, startitem * satzlaenge) ;
While Eof(file) = 0
txt$ = ReadString(file, #PB_Ascii|#PB_File_IgnoreEOL, length)
posi = FindString(txt$, search$)
If posi
item = startitem + (posi / satzlaenge)
Break
Else
startitem + anzahlitem
EndIf
Wend
ProcedureReturn item
EndProcedure
Procedure WindowCallback(hwnd, msg, wParam, lParam)
;benötigt globale Variablen: satzlaenge + feldtrenn$
Protected result = #PB_ProcessPureBasicEvents
Static line.s, field.s
Select msg
Case #WM_NOTIFY
Protected *nmh.NMHDR = lParam
If *nmh\idFrom = #mainliste
Select *nmh\code
Case #LVN_GETDISPINFO
Protected *nmlvdi.NMLVDISPINFO = lParam
If *nmlvdi\item\mask & #LVIF_TEXT
line = ReadStringLine(#vlvdatnr, *nmlvdi\item\iItem, satzlaenge) ;liest ganzen Satz
field = RTrim(StringField(line, *nmlvdi\item\iSubItem+1, feldtrenn$)) ;+1 weil Stringfield ab 1
*nmlvdi\item\pszText = @field
EndIf
EndSelect
EndIf
EndSelect
ProcedureReturn result
EndProcedure
;-OpenWindow
PreferenceFile()
Define itemCount, x = 10, y = 10
Define lvflags = #LVS_OWNERDATA | #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection
If OpenWindow(#window, 100, 100, 800, 666, "V ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetWindowCallback(@WindowCallback())
CreateStatusBar(#statusbar, WindowID(#window))
AddStatusBarField(#PB_Ignore)
AddStatusBarField(120)
StatusBarText(#statusbar, 0, "vlv Demo by HJBremer Juni 2023", #PB_StatusBar_Center) ;Center = 4
ListIconGadget(#mainliste, x, y, 780, 390, "Lfdnr", 66, lvflags)
AddGadgetColumn(#mainliste, 1, "Item", 80)
AddGadgetColumn(#mainliste, 2, "Plz", 66)
AddGadgetColumn(#mainliste, 3, "Name 1", 150)
AddGadgetColumn(#mainliste, 4, "Name 2", 150)
AddGadgetColumn(#mainliste, 5, "Euro", 100)
SetWindowTheme_(GadgetID(#mainliste), "explorer", 0)
y = 420
TextGadget(#strg1, x, y, 65, 22, "", #WS_BORDER|#SS_CENTERIMAGE|#SS_CENTER) : y + 30
TextGadget(#strg2, x, y, 65, 22, "", #WS_BORDER|#SS_CENTERIMAGE|#SS_CENTER) : y + 30
StringGadget(#strg3, x, y, 99, 22, "") : y + 30
StringGadget(#strg4, x, y, 99, 22, "") : y + 30
StringGadget(#strg5, x, y, 99, 22, "") : y + 30
StringGadget(#strg6, x, y, 99, 22, "") : y + 30
SetGadgetColor(#strg1, #PB_Gadget_BackColor, $f9f9f9)
SetGadgetColor(#strg2, #PB_Gadget_BackColor, $f9f9f9)
ButtonGadget(#butchg, x, y, 150, 22, "ändern")
ButtonGadget(#butnew, x+180, y, 150, 22, "neu")
x = 120: y = 420
SpinGadget(#spin, x, y, 99, 22, 0, 10, #PB_Spin_Numeric) : x + 230
StringGadget(#strgsuch, x, y, 99, 22, lastsearch$) : y + 30
ButtonGadget(#such1, x, y, 99, 22, "Suchen") : y + 30
ButtonGadget(#such2, x, y, 99, 22, "weiter Suchen") : y + 60
;ButtonGadget(#buttest, 350, y, 99, 22, "test")
;Datenquelle
OpenFile(#vlvdatnr, vlvFile$, #PB_Ascii) ;muß immer geöffnet sein
itemCount = Lof(#vlvdatnr) / satzlaenge ; max 100 Millionen
SendMessage_(GadgetID(#mainliste), #LVM_SETITEMCOUNT, itemCount, #LVSICF_NOINVALIDATEALL)
StatusBarText(#statusbar, 1, "itemCount " + itemCount, 4)
;-los gehts
SetActiveGadget(#mainliste)
SetGadgetState(#mainliste, lastselect) ;scrollt to lastselect
SetGadgetAttribute(#spin, #PB_Spin_Maximum, itemCount)
SetGadgetState(#spin, lastselect)
Define event, item, satz$, search$, findpos
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case #mainliste
If EventType() = #PB_EventType_LeftClick
item = GetGadgetState(#mainliste)
StatusBarText(#statusbar, 0, "Item: " + Str(item), 4)
;satz aus Datei lesen incl Leerzeichen, da feste Satzlänge wurde mit Leerzeichen gespeichert
satz$ = ReadStringLine(#vlvdatnr, item, satzlaenge) ;liest satz aus Datei incl Leerzeichen
SetGadgetText(#strg1, Trim(StringField(satz$, 1, feldtrenn$))) ;leerzeichen entfernen
SetGadgetText(#strg2, Trim(StringField(satz$, 2, feldtrenn$)))
SetGadgetText(#strg3, Trim(StringField(satz$, 3, feldtrenn$)))
SetGadgetText(#strg4, Trim(StringField(satz$, 4, feldtrenn$)))
SetGadgetText(#strg5, Trim(StringField(satz$, 5, feldtrenn$)))
SetGadgetText(#strg6, Trim(StringField(satz$, 6, feldtrenn$)))
SetGadgetText(#butchg, "ändern Item " + Str(item))
EndIf
Case #butchg : ModifyItem(#vlvdatnr, item)
Case #butnew : AddNewItem(#vlvdatnr)
Case #spin
If EventType() = #PB_EventType_Change
item = GetGadgetState(#spin)
SetGadgetState(#mainliste, item)
EndIf
;- suchen
Case #such1
Define ms = ElapsedMilliseconds()
StatusBarText(#statusbar, 0, "")
search$ = GetGadgetText(#strgsuch): lastsearch$ = search$
findpos = SearchText(#vlvdatnr, search$)
If findpos > -1
SetGadgetState(#mainliste, findpos)
Else
StatusBarText(#statusbar, 0, "not found: " + search$, 4)
EndIf
StatusBarText(#statusbar, 0, Str(ElapsedMilliseconds()-ms), 4)
Case #such2
StatusBarText(#statusbar, 0, "")
findpos = SearchText(#vlvdatnr, search$, findpos+1)
If findpos > -1
SetGadgetState(#mainliste, findpos)
Else
StatusBarText(#statusbar, 0, "not found: " + search$, 4)
EndIf
Case #buttest:
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
EndIf
CloseFile(#vlvdatnr)
PreferenceFile(1)