1. Die neue PB Version
2. Der alte Code war unübersichtlich geworden und schlecht zu warten.
Diesen alten Code habe ich überarbeitet (praktisch neu geschrieben) und möchte es allen Anfängern zur Verfügung stellen. Der hier vorgestellte Code für die Demo-Version ist eine abgespeckte Version meines Originals.
Das Programm besteht aus 2 Teilen. Main + Prozeduren, wegen des Zeilenlimits in der Demoversion.
Am Besten man erstellt ein Projekt.
Eine Hilfedatei erhält man hier https://www.dropbox.com/s/srhte1dqh1kmebo/miniadr.chm (wenns funktioniert)
Die Hilfe ist allerdings für die Vollversion.
Nach dem Herunterladen, muß die Hilfedatei einmal per Hand aufgerufen werden und das Häkchen bei immer bestätigen entfernt werden oder über 'Eigenschaften-Sicherheit' Zulassen übernehmen.
MiniAdrDemo-Main.pb
Code: Alles auswählen
;MiniAdrDemo-Main.pb - 02.2013
#msg_version = "MiniAdr ab PB 5.1 DemoVersion" + #LF$ + "2009/2013 - V.1.07" + #LF$ + "HJBremer"
#buttonbr = 125
#buttonhh = 22
#fieldmax = 14
#Black = 0 ;in der PB Demoversion nicht definiert
#White = $FFFFFF
Enumeration 1 ;Fenster, Menus und Gadgets etc numerieren
#window_main: #window_input: #list_nr: #popup_main
#menu_01
#menu_load: #menu_save: #menu_save2
#menu_kill: #menu_mark: #menu_nomark: #menu_print: #menu_sort
#menu_50
#menu_new: #menu_edit: #menu_ftyp: #menu_width: #menu_head
#menu_99
#menu_searchF3: #menu_searchF4
#menu_progende: #menu_proginfo: #menu_proghelp
#prn_spin1: #prn_spin2: #prn_spin3: #prn_all: #prn_sel1: #prn_sel2
#input_box1: #input_box2: #input_box3: #sort_gk: #sort_up: #sort_dw
#input_go: #input_break: #input_clear: #input_return: #input_date: #input_help
EndEnumeration
Structure WindowSize
x.i
y.i
br.i
hh.i
EndStructure
Structure InputField
name.s ;Spaltenname
br.i ;Breite in der Liste + Eingabe
strgnr.i ;PbNr des EingabeStringGadgets
textnr.i ;PbNr des EingabeTextGadgets
typ.i ;Feldtyp 48-57=Zahl, 35=#Datum, 84=Text
EndStructure
Structure Programmvariablen
filename.s
main.WindowSize ;MainWindowposition + Größe
input.WindowSize ;InputWindowposition
inputmode.i ;Menuauswahl
dataset.s ;letzter geladener, bearbeiteter Datensatz
searchword.s ;für Suche im ganzen Datensatz
founditem.i ;für Suche
lastfocus.i ;
lastdate.i ;für DateGadget,
oldgadgetlist.i ;da InputWindow zerstört wird, zurück zur vorherigen Gadgetlist
prnsize.i ;lupe macht den Druck größer/kleiner
prnfields.i ;bis zu welchem Feld wird gedruckt
datemask.s
Array sortfieldnr.i(3) ;nach welchen Feldern wird sortiert
Array field.InputField(0) ;enthält Daten für Eingabefelder, wird beim Laden dimensioniert
EndStructure
EnableExplicit ;alle Variablen müssen deklariert werden
Global prgv.Programmvariablen
IncludeFile "MiniAdrDemo-Procs.pb"
;MiniAdrDemo-Main.pb
Procedure.i MainIni(mode$ = "read")
Protected j, iniok = OpenPreferences("MiniAdr.ini")
If iniok = 0: CreatePreferences("MiniAdr.ini"): EndIf
If mode$ = "write"
WritePreferenceString ("Lastfile", prgv\filename)
Else
prgv\filename = ReadPreferenceString ("Lastfile", "Test.csv")
EndIf
ClosePreferences()
EndProcedure
Procedure.i MainWindow()
LoadFont(0, "Arial", 9): SetGadgetFont(#PB_Default, FontID(0))
Protected flags
flags = #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget
OpenWindow(#window_main, 0, 0, 0, 0, "MiniAdr (PB 5.1 x86)", flags)
CreateStatusBar(0, WindowID(#window_main))
AddStatusBarField(#PB_Ignore): AddStatusBarField(88)
CreateMenu(0, WindowID(#window_main))
MenuTitle("&Datei")
MenuItem( #menu_load, "&Öffnen / Neu" + #TAB$ + "Strg+O")
MenuItem( #menu_save, "&Speichern" + #TAB$ + "Strg+S")
MenuItem( #menu_save2, "Speichern &als...")
MenuBar()
MenuItem( #menu_print, "&Drucken")
MenuBar()
MenuItem( #menu_progende, "&Beenden" + #TAB$ + "Alt+F4")
MenuTitle("&Bearbeiten")
MenuItem( #menu_new, "&Neu" + #TAB$ + "Strg+N")
MenuItem( #menu_edit, "&Ändern" + #TAB$ + "DblClick")
MenuItem( #menu_kill, "&Löschen")
MenuBar()
MenuItem( #menu_searchF4, "&Suchen" + #TAB$ + "Strg+F / F4")
MenuItem( #menu_searchF3, "&Weitersuchen" + #TAB$ + "F3")
MenuBar()
MenuItem( #menu_mark, "alle Daten &markieren" + #TAB$ + "Strg+A")
MenuItem( #menu_nomark,"Markierung l&öschen")
MenuBar()
MenuItem( #menu_sort, "&Sortieren")
MenuTitle("&Einstellungen")
MenuItem( #menu_ftyp, "&Feldtyp")
MenuItem( #menu_head, "&Spaltentitel")
MenuItem( #menu_width, "Spalten&breite")
MenuTitle("&Sonstiges")
MenuItem( #menu_proginfo, "&Info")
CreatePopupMenu(#popup_main)
MenuItem( #menu_new, "&Neu")
MenuItem( #menu_edit, "&Ändern")
MenuItem( #menu_kill, "&Löschen")
AddKeyboardShortcut(#window_main, #PB_Shortcut_Control|#PB_Shortcut_O , #menu_load)
AddKeyboardShortcut(#window_main, #PB_Shortcut_Control|#PB_Shortcut_S , #menu_save)
AddKeyboardShortcut(#window_main, #PB_Shortcut_Alt |#PB_Shortcut_F4, #menu_progende)
AddKeyboardShortcut(#window_main, #PB_Shortcut_Control|#PB_Shortcut_N , #menu_new)
AddKeyboardShortcut(#window_main, #PB_Shortcut_Control|#PB_Shortcut_A , #menu_mark)
AddKeyboardShortcut(#window_main, #PB_Shortcut_Control|#PB_Shortcut_F , #menu_searchF4)
AddKeyboardShortcut(#window_main, #PB_Shortcut_F4, #menu_searchF4)
AddKeyboardShortcut(#window_main, #PB_Shortcut_F3, #menu_searchF3)
AddKeyboardShortcut(#window_main, #PB_Shortcut_F1, #menu_proghelp)
HideWindow(#window_main, 0)
ListFileLoad() ;Lastfile automatisch laden bei Programmstart
EndProcedure
Procedure.i MainEvent()
With prgv
Protected j, k, nr, close = #False
Repeat
Protected event = WaitWindowEvent() ;was ist passiert
Protected window = EventWindow() ;welches Fenster
Protected gadget = EventGadget() ;welches Gadget (Button, Liste etc)
Protected eventtyp = EventType() ;
Protected menupoint = EventMenu() ;welches Menuitem
If window = #window_main
Select event
Case #PB_Event_MoveWindow
\main\x = WindowX(#window_main)
\main\y = WindowY(#window_main)
Case #PB_Event_SizeWindow
\main\br = WindowWidth(#window_main)
\main\hh = WindowHeight(#window_main)
ResizeGadget(#list_nr, #PB_Ignore, #PB_Ignore, \main\br, \main\hh - StatusBarHeight(0) - MenuHeight())
Case #PB_Event_Gadget
If gadget = #list_nr
Select eventtyp
Case #PB_EventType_LeftDoubleClick: InputEvaluate(#menu_edit)
Case #PB_EventType_RightClick: DisplayPopupMenu(#popup_main, WindowID(#window_main))
Case #PB_EventType_LeftClick: StatusBarText(0, 1, "Satz: " + Str(GetGadgetState(#list_nr) + 1))
Case #PB_EventType_Change: StatusBarText(0, 1, "Satz: " + Str(GetGadgetState(#list_nr) + 1))
EndSelect
EndIf
Case #PB_Event_Menu
Select menupoint
Case #menu_01 To #menu_99: InputEvaluate(menupoint)
Case #menu_searchF4: InputEvaluate(menupoint)
Case #menu_searchF3: DataSearchNext()
Case #menu_progende: ListFileSave(): close = #True
Case #menu_proghelp: OpenHelp("miniadr.chm", "Fenster.html")
Case #menu_proginfo: MessageRequester("Information", #msg_version)
EndSelect
Case #PB_Event_CloseWindow: close = #True
EndSelect
ElseIf window = #window_input
Select event
Case #PB_Event_MoveWindow
\input\x = WindowX(#window_input)
\input\y = WindowY(#window_input)
Case #PB_Event_Gadget, #PB_Event_Menu ;Gadgetevent oder Menuevent vom Shortcut
Select gadget
Case #input_go: InputAnalyze()
Case #input_break: InputWindowClose()
Case #input_help: OpenHelp("miniadr.chm", "Neu.html")
Case #input_clear:
SetActiveGadget(\field(1)\strgnr)
For j = 1 To #fieldmax: SetGadgetText(\field(j)\strgnr, ""): Next
Case #input_date:
SetGadgetText(\field(\lastfocus)\strgnr, GetGadgetText(#input_date))
\lastdate = ParseDate(\datemask, GetGadgetText(#input_date))
Case #input_return
For j = 1 To #fieldmax
If GetActiveGadget() = \field(j)\strgnr
j + 1
Select \inputmode
Case #menu_new, #menu_edit
While GetGadgetItemAttribute(#list_nr, 0, #PB_ListIcon_ColumnWidth, j) = 0
j + 1
If j > #fieldmax: j = 1: EndIf
Wend
EndSelect
If j > #fieldmax: j = 1: EndIf
SetActiveGadget(\field(j)\strgnr)
Break
EndIf
Next
Default ;Prüfen ob ein Stringgadget und wenn ja, lastfocus zuweisen
Select eventtyp
Case #PB_EventType_LostFocus
nr = GetStringGadgetIndex(gadget)
If nr
\lastfocus = nr
Select \inputmode ;wird in InputEvaluate() gesetzt
Case #menu_width: SetColumnWidth(nr)
Case #menu_edit, #menu_new: InputStringCheck(nr)
EndSelect
EndIf
EndSelect
EndSelect
Case #PB_Event_CloseWindow: InputWindowClose()
EndSelect
EndIf
Until close = #True
EndWith
EndProcedure
MainIni()
MainWindow()
MainEvent()
MainIni("write")
ListFileIni("write")
DataSection
Data_DemoDaten: ;Spalte null wird nur für Checkbox benutzt, optisch nicht vorhanden
Data.s "leer,Vorname,Nachname,Plz/Ort,Strasse,Geb.Tag,Tel.,Handy,Info 1,Info 2,Info 3,Info 4"
EndDataSection
Code: Alles auswählen
;MiniAdrDemo-Procs.pb - 02.2013
Procedure.s DataListGetItem(iitem)
Protected isubitem, item$ = ""
For isubitem = 0 To #fieldmax
item$ + GetGadgetItemText(#list_nr, iitem, isubitem) + #LF$
Next
ProcedureReturn item$
EndProcedure
Procedure.i ListFileIni(mode$)
With prgv
Protected j, br, i$, vg$
Protected dat$ = \filename + ".ini"
Protected iniok = OpenPreferences(dat$)
If iniok = 0: CreatePreferences(dat$): EndIf
If mode$ = "write"
PreferenceGroup("Allgemein")
WritePreferenceInteger("WindowX", \main\x)
WritePreferenceInteger("WindowY", \main\y)
WritePreferenceInteger("WindowB", \main\br)
WritePreferenceInteger("WindowH", \main\hh)
WritePreferenceInteger("InputX", \input\x)
WritePreferenceInteger("InputY", \input\y)
WritePreferenceString ("Datemask", \datemask)
WritePreferenceInteger("PrintSize", \prnsize)
WritePreferenceInteger("PrintFields", \prnfields)
PreferenceGroup("Datei")
For j = 0 To #fieldmax
br = GetGadgetItemAttribute(#list_nr, 0, #PB_ListIcon_ColumnWidth, j)
WritePreferenceInteger("Feld " + Str(j), br)
Next
For j = 0 To #fieldmax
WritePreferenceInteger("Typ " + Str(j), \field(j)\typ)
Next
ElseIf mode$ = "read"
PreferenceGroup("Allgemein")
\main\x = ReadPreferenceInteger("WindowX", 200)
\main\y = ReadPreferenceInteger("WindowY", 100)
\main\br = ReadPreferenceInteger("WindowB", 800)
\main\hh = ReadPreferenceInteger("WindowH", 500)
\input\x = ReadPreferenceInteger("InputX", 300)
\input\y = ReadPreferenceInteger("InputY", 300)
\datemask = ReadPreferenceString ("Datemask", "%dd.%mm.%yyyy")
\prnsize = ReadPreferenceInteger("PrintSize", 15)
\prnfields = ReadPreferenceInteger("PrintFields", 10)
PreferenceGroup("Datei")
For j = 0 To #fieldmax
If j = 0: br = 0: Else: br = 99: EndIf ;Vorgabe für br
\field(j)\br = ReadPreferenceInteger("Feld " + Str(j), br)
\field(j)\typ = ReadPreferenceInteger("Typ " + Str(j), 84)
Next
EndIf
EndWith
ClosePreferences()
EndProcedure
Procedure.i DataListCreate(daten$ = "")
Protected j, flags
With prgv
flags = #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_HeaderDragDrop
flags | #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_MultiSelect|#PB_ListIcon_CheckBoxes
If IsGadget(#list_nr): FreeGadget(#list_nr): EndIf
ListIconGadget(#list_nr, 0, 0, 0, 0, "", 0, flags)
HideGadget(#list_nr, 1) ;für schnelleres Laden/Anzeigen der Liste
If daten$ = ""
Restore Data_DemoDaten: Read.s daten$
ReplaceString(daten$, "," , #LF$, #PB_String_InPlace)
EndIf
Dim \field(#fieldmax)
ListFileIni("read")
For j = 0 To #fieldmax
\field(j)\name = StringField(daten$, j+1, #LF$)
AddGadgetColumn(#list_nr, j, \field(j)\name, \field(j)\br)
Next
ResizeWindow(#window_main, \main\x, \main\y, \main\br, \main\hh)
ResizeGadget(#list_nr, 0, 0, \main\br, \main\hh - StatusBarHeight(0) - MenuHeight())
EndWith
ProcedureReturn 1
EndProcedure
Procedure.s ListFileSelect(flag, dat$ = "")
Protected file$ = prgv\filename
Protected patt$ = "Csv (*.csv)|*.csv|Text (*.txt)|*.txt|Alle Dateien (*.*)|*.*"
If flag = 0
file$ = OpenFileRequester("Laden: Datei auswählen oder neuen Namen eingeben", file$, patt$, 0)
Else
file$ = SaveFileRequester("Speichern: Datei auswählen oder neuen Namen eingeben", file$, patt$, 0)
EndIf
ProcedureReturn file$
EndProcedure
Procedure.i ListFileLoad(mode = 0)
Protected file$, daten$, header = #False
If mode
file$ = ListFileSelect(0, prgv\filename)
If file$ = "": ProcedureReturn: EndIf
If file$: prgv\filename = file$: EndIf
EndIf
If ReadFile(0, prgv\filename)
;wenn Datei vorhanden
While Eof(0) = 0
daten$ = ReadString(0)
ReplaceString(daten$, #TAB$, #LF$, #PB_String_InPlace)
If header = #False
header = DataListCreate(daten$) ;gibt #true zurück
Else
AddGadgetItem(#list_nr, -1, daten$)
EndIf
Wend
CloseFile(0)
Else
;wenn Datei Nicht vorhanden
DataListCreate()
EndIf
HideGadget(#list_nr, 0)
StatusBarText(0, 0, prgv\filename)
StatusBarText(0, 1, "")
EndProcedure
Procedure.i ListFileSave(mode = #menu_save)
Protected file$, item, satz$
ListFileIni("write")
If mode = #menu_save2
file$ = ListFileSelect(1, prgv\filename)
If file$ = "": ProcedureReturn: EndIf
If file$: prgv\filename = file$: EndIf
EndIf
If GetExtensionPart(prgv\filename) = "": prgv\filename + ".csv": EndIf
If CreateFile(0, prgv\filename)
For item = -1 To CountGadgetItems(#list_nr) - 1 ;incl Header
satz$ = DataListGetItem(item)
ReplaceString(satz$, #LF$, #TAB$, #PB_String_InPlace)
WriteStringN(0, satz$)
Next
CloseFile(0)
ListFileIni("write")
EndIf
StatusBarText(0, 0, prgv\filename + " " + Str(item))
EndProcedure
Procedure.i DataListSort()
Protected j, k, item$, subitem$
Protected sortfield, sortoption = 0, itemlg = 30
Protected dataposi = 1 + (itemlg * 3)
Protected itemcount = CountGadgetItems(#list_nr) - 1 ;z.B. 9 Daten = 0 - 8
If itemcount < 0: ProcedureReturn: EndIf
Dim sort$(3): Dim daten$(itemcount) ;ab null
prgv\sortfieldnr(1) = GetGadgetState(#input_box1) + 1 ;Listbox beginnt bei null
prgv\sortfieldnr(2) = GetGadgetState(#input_box2) + 1 ;also ist Spalte 1 hier null
prgv\sortfieldnr(3) = GetGadgetState(#input_box3) + 1 ;also + 1 in der Liste
For j = 0 To itemcount
item$ = DataListGetItem(j)
For k = 1 To 3
sortfield = prgv\sortfieldnr(k)
subitem$ = StringField(item$, sortfield + 1, #LF$) ;StringField beginnt bei 1
Select prgv\field(sortfield)\typ
Case 35: subitem$ = Mid(subitem$,7,4) + Mid(subitem$,4,2) + Mid(subitem$,1,2)
sort$(k) = LSet(subitem$, itemlg) ;Datum umgedreht
Case 48 To 57: sort$(k) = RSet(subitem$, itemlg) ;Zahl
Default: sort$(k) = LSet(subitem$, itemlg) ;Text
EndSelect
Next
daten$(j) = sort$(1) + sort$(2) + sort$(3) + item$ ;3 Sortfelder + ganzer Datensatz
Next
If GetGadgetState(#sort_gk) = 0: sortoption = #PB_Sort_NoCase: EndIf
If GetGadgetState(#sort_dw) = 1: sortoption = #PB_Sort_Descending|sortoption: EndIf
SortArray(daten$(), sortoption)
HideGadget(#list_nr, 1): ClearGadgetItems(#list_nr)
For j = 0 To itemcount
item$ = Mid(daten$(j), dataposi) ;die 3 Sortfelder entfernen
AddGadgetItem(#list_nr,-1, item$)
Next
HideGadget(#list_nr, 0)
EndProcedure
Procedure.i DataSearch(abitem = 0)
Protected item, satz$, msg, ok = #False
For item = abitem To CountGadgetItems(#list_nr) - 1
satz$ = DataListGetItem(item)
If prgv\inputmode = #menu_searchF4
If FindString(satz$, prgv\searchword, 1, #PB_String_NoCase)
ok = #True: prgv\founditem = item
SetGadgetState(#list_nr, item): SetActiveGadget(#list_nr): Break
EndIf
EndIf
Next
ProcedureReturn ok
EndProcedure
Procedure.i DataSearchNext()
weitersuchen:
If DataSearch(prgv\founditem + 1) = #False
Protected info$ = "Keine Daten gefunden!" + #LF$ + #LF$ + "von Beginn an weitersuchen ?"
If MessageRequester("Information", info$, #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
prgv\founditem = -1
Goto weitersuchen ;dies ist ein locales Label und ist die einfachste Lösung der Schleife
EndIf
EndIf
EndProcedure
Procedure.i PrintListRow(item, x, y, faktor.f)
Protected item$ = DataListGetItem(item)
Protected isubitem, subitem$, br, leftmargin = x
For isubitem = 1 To prgv\prnfields
subitem$ = StringField(item$, isubitem + 1, #LF$)
DrawText(x, y, subitem$, #Black, #White)
br + GetGadgetItemAttribute(#list_nr, 0, #PB_ListIcon_ColumnWidth, isubitem)
x = leftmargin + (br * faktor)
Next
EndProcedure
Procedure.i PrintList()
Protected deskwidth, pagewidth, pageheight
Protected linespacing, leftmargin, topmargin, x, y
Protected faktor.f, dpmm.f, lupe.f = prgv\prnsize / 10
Protected copies, itempropage, iitem, lfdnr
Protected fontbold, fontnormal, headline, infowidth, infoposx, infoposy, infonr
Protected prnall = GetGadgetState(#prn_all)
Protected prnsel = GetGadgetState(#prn_sel1)
Protected itemanz = CountGadgetItems(#list_nr) - 1
If Bool(prnall = 0 And prnsel = 0): prnsel = 2: EndIf
If DefaultPrinter()
ExamineDesktops()
deskwidth = DesktopWidth(0)
pagewidth = PrinterPageWidth()
pageheight = PrinterPageHeight()
If pagewidth < pageheight ;Normal A4
faktor = (pagewidth / deskwidth) * lupe: dpmm = pagewidth / 210 ;210mm A4 = Dots pro mm
Else ;Querformat A4
faktor = (pageheight / deskwidth) * lupe: dpmm = pageheight / 210
EndIf
fontbold = LoadFont(#PB_Any, "Arial", 10 * faktor, #PB_Font_Bold)
fontnormal = LoadFont(#PB_Any, "Arial", 10 * faktor)
If StartDrawing(PrinterOutput())
DrawingFont(FontID(fontbold))
linespacing = TextHeight("X") + 5
infowidth = TextWidth("Seite 123")
StopDrawing()
EndIf
topmargin = 10 * dpmm ;ca 10 mm für Linker und oberer Rand, Seiteninfo zählt nicht
leftmargin = 11 * dpmm
infoposx = pagewidth - infowidth: infoposy = topmargin - linespacing - 5
itempropage = (pageheight - topmargin - topmargin - linespacing) / linespacing
For copies = 1 To GetGadgetState(#prn_spin3) ;Liste wie oft drucken
x = leftmargin: y = topmargin
lfdnr = 0: infonr = 0: headline = #True
If StartPrinting("Miniadr" + Str(copies))
If StartDrawing(PrinterOutput())
For iitem = 0 To itemanz
If headline = #True ;Listen-Überschrift drucken
headline = #False
DrawingFont(FontID(fontnormal)): infonr + 1
DrawText(infoposx, infoposy, "Seite " + Str(infonr), #Black, #White)
DrawingFont(FontID(fontbold))
PrintListRow(-1, x, y, faktor): y + linespacing ;Header
EndIf
DrawingFont(FontID(fontnormal))
If prnall
PrintListRow(iitem, x, y, faktor): y + linespacing: lfdnr + 1
ElseIf prnsel = 1
If GetGadgetItemState(#list_nr, iitem) & #PB_ListIcon_Selected
PrintListRow(iitem, x, y, faktor): y + linespacing: lfdnr + 1
EndIf
ElseIf prnsel = 2
If GetGadgetItemState(#list_nr, iitem) & #PB_ListIcon_Checked
PrintListRow(iitem, x, y, faktor): y + linespacing: lfdnr + 1
EndIf
EndIf
If Mod(lfdnr, itempropage) = itempropage - 1 ; minus 1, weil lfdnr ab null
headline = #True: y = topmargin ; lfdnr % itempropage geht auch
NewPrinterPage()
EndIf
Next iitem
StopDrawing()
EndIf
StopPrinting()
EndIf
Next copies
FreeFont(fontbold): FreeFont(fontnormal)
EndIf
EndProcedure
Procedure.i InputWindow(info$, datensatz$ = "")
With prgv
Protected flags = #PB_Window_Tool|#PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_NoGadgets
\input\br = 450
\input\hh = 60 + (#fieldmax * (#buttonhh + 5))
OpenWindow(#window_input, \input\x, \input\y, \input\br, \input\hh, info$, flags, WindowID(#window_main))
\oldgadgetlist = UseGadgetList(WindowID(#window_input)) ;!!!
\lastfocus = 1 ;zur Sicherheit auf 1 setzen
Protected j, i$, v$, br = 60
Protected x , y = 15, x1 = 10, x2 = x1 + br + 5, x3
Protected textbr, strgbr, strgbrmax = \input\br - x1 - 25 - #buttonbr - br
Select \inputmode
Case #menu_50 To #menu_99
For j = 1 To #fieldmax
strgbr = GetGadgetItemAttribute(#list_nr, 0, #PB_ListIcon_ColumnWidth, j)
textbr = br
\field(j)\br = strgbr
If strgbr > strgbrmax: strgbr = strgbrmax: EndIf
i$ = \field(j)\name
v$ = StringField(datensatz$, j + 1, #LF$)
Select \inputmode
Case #menu_ftyp: strgbr = 99
Case #menu_head: If strgbr = 0: strgbr = br: EndIf
Case #menu_width: If strgbr = 0: strgbr = br: EndIf: v$ = Str(\field(j)\br)
EndSelect
If strgbr = 0: textbr = 0: EndIf
\field(j)\textnr = TextGadget (#PB_Any, x1, y + 5, textbr, #buttonhh, i$, #PB_Text_Right)
\field(j)\strgnr = StringGadget(#PB_Any, x2, y + 0, strgbr, #buttonhh, v$)
Select prgv\field(j)\typ
Case 48 To 57: SetGadgetColor(prgv\field(j)\textnr, #PB_Gadget_FrontColor, $007722)
Case 35: SetGadgetColor(prgv\field(j)\textnr, #PB_Gadget_FrontColor, $7c0000)
Default: SetGadgetColor(prgv\field(j)\textnr, #PB_Gadget_FrontColor, 0)
EndSelect
If strgbr: y + #buttonhh + 5: EndIf
Next
SetActiveGadget(\field(1)\strgnr)
AddKeyboardShortcut(#window_input, #PB_Shortcut_Return, #input_return)
EndSelect
Select \inputmode
Case #menu_new: info$ = "&Daten Hinzufügen"
Case #menu_print: info$ = "&Drucken"
Case #menu_sort: info$ = "&Start"
Case #menu_head, #menu_edit: info$ = "&Daten Ändern"
Case #menu_ftyp, #menu_width: info$ = "&Speichern"
EndSelect
y = \input\hh - 10 - #buttonhh
x1 = 10
x2 = \input\br / 2
x3 = WindowWidth(#window_input) - #buttonbr - 10
ButtonGadget(#input_go, x1, y, #buttonbr, #buttonhh, info$)
ButtonGadget(#input_break, x3, y, #buttonbr, #buttonhh, "&Abbruch")
AddKeyboardShortcut(#window_input, #PB_Shortcut_Alt|#PB_Shortcut_D, #input_go)
AddKeyboardShortcut(#window_input, #PB_Shortcut_Alt|#PB_Shortcut_S, #input_go)
AddKeyboardShortcut(#window_input, #PB_Shortcut_Alt|#PB_Shortcut_A, #input_break)
AddKeyboardShortcut(#window_input, #PB_Shortcut_Escape, #input_break)
AddKeyboardShortcut(#window_input, #PB_Shortcut_F1, #input_help)
y = 15
Select \inputmode
Case #menu_edit, #menu_new
ButtonGadget(#input_clear, x3, y, #buttonbr, #buttonhh, "Eingaben &Löschen") :y + #buttonhh + 10
DateGadget(#input_date, x3, y, #buttonbr, #buttonhh, \datemask, \lastdate)
AddKeyboardShortcut(#window_input, #PB_Shortcut_Alt|#PB_Shortcut_L, #input_clear)
Case #menu_head
ButtonGadget(#input_clear, x3, y, #buttonbr, #buttonhh, "Eingaben &Löschen"): : y + #buttonhh + 10
AddKeyboardShortcut(#window_input, #PB_Shortcut_Alt|#PB_Shortcut_L, #input_clear)
Case #menu_ftyp
info$ = "T = Text" + #LF$
info$ + "# = Datum" + #LF$ + #LF$
info$ + "0 = Ganzzahl" + #LF$
info$ + "1 - 9 = Zahl mit n Dezimalstellen" + #LF$
TextGadget(#PB_Any, x2, y, #buttonbr + 50, 150, info$)
Case #menu_sort
x = 10: br = (\input\br - 30) / 3
TextGadget(#PB_Any, x, 10, 300, #buttonhh, "Wählen Sie die Sortierreihenfolge")
ListViewGadget(#input_box1, x, 40, br, 250): x + br + 5
ListViewGadget(#input_box2, x, 40, br, 250): x + br + 5
ListViewGadget(#input_box3, x, 40, br, 250)
For j = 1 To #fieldmax
AddGadgetItem (#input_box1, -1, prgv\field(j)\name)
AddGadgetItem (#input_box2, -1, prgv\field(j)\name)
AddGadgetItem (#input_box3, -1, prgv\field(j)\name)
Next
x = 10
OptionGadget (#sort_up, x, 300, #buttonbr, #buttonhh, "aufsteigend")
OptionGadget (#sort_dw, x, 325, #buttonbr, #buttonhh, "absteigend")
SetGadgetState(#sort_up, 1)
x + #buttonbr
CheckBoxGadget(#sort_gk, x, 300, #buttonbr, #buttonhh, "Groß/Kleinschrift")
SetGadgetState(#input_box1, prgv\sortfieldnr(1)-1)
SetGadgetState(#input_box2, prgv\sortfieldnr(2)-1)
SetGadgetState(#input_box3, prgv\sortfieldnr(3)-1)
Case #menu_print
x = 25: y = 15
OptionGadget(#prn_all, x, y, #buttonbr, #buttonhh, "alles drucken"): y + #buttonhh + 10
OptionGadget(#prn_sel1, x, y, #buttonbr, #buttonhh, "Markierung"): y + #buttonhh + 10
OptionGadget(#prn_sel2, x, y, #buttonbr, #buttonhh, "Checkbox")
x = 190: y = 15
SpinGadget(#prn_spin1, x, y, 40, #buttonhh, 10, 25, #PB_Spin_Numeric|#PB_Spin_ReadOnly): y + #buttonhh + 10
SpinGadget(#prn_spin2, x, y, 40, #buttonhh, 1, 99, #PB_Spin_Numeric|#PB_Spin_ReadOnly): y + #buttonhh + 10
SpinGadget(#prn_spin3, x, y, 40, #buttonhh, 1, 99, #PB_Spin_Numeric|#PB_Spin_ReadOnly): y + #buttonhh + 10
x + 5 + 40: y = 15 + 3
TextGadget(#PB_Any, x, y, #buttonbr, #buttonhh, "größer/kleiner"): y + #buttonhh + 10
TextGadget(#PB_Any, x, y, #buttonbr, #buttonhh, "Felder drucken"): y + #buttonhh + 10
TextGadget(#PB_Any, x, y, #buttonbr, #buttonhh, "Anzahl Kopien "): y + #buttonhh + 10
SetGadgetState(#prn_all, 1)
SetGadgetState(#prn_spin1, prgv\prnsize)
SetGadgetState(#prn_spin2, prgv\prnfields)
SetGadgetState(#prn_spin3, 1)
EndSelect
DisableWindow(#window_main, 1)
HideWindow(#window_input, 0)
EndWith
EndProcedure
Procedure.i InputWindowClose()
CloseWindow(#window_input)
DisableWindow(#window_main, 0)
SetActiveGadget(#list_nr)
UseGadgetList(prgv\oldgadgetlist)
EndProcedure
Procedure.i InputEvaluate(menupoint)
With prgv
Protected j, item$, iitem = GetGadgetState(#list_nr)
\inputmode = menupoint
Select menupoint
Case #menu_load: ListFileLoad(1)
Case #menu_save: ListFileSave()
Case #menu_save2: ListFileSave(menupoint)
Case #menu_sort: InputWindow("Sortieren")
Case #menu_print: InputWindow("Drucken")
Case #menu_width: InputWindow("Spaltenbreite")
Case #menu_searchF4
\searchword = InputRequester("Suchen", "Suchbegriff: ", \searchword)
If \searchword
If DataSearch() = #False
MessageRequester("Information", "Keine Daten gefunden!")
EndIf
EndIf
Case #menu_ftyp
item$ = #LF$
For j = 1 To #fieldmax
item$ + Chr(\field(j)\typ) + #LF$
Next
InputWindow("Feldtyp", item$)
Case #menu_head
item$ = DataListGetItem(-1): InputWindow("Titel + Farben", item$)
Case #menu_mark
For iitem = 0 To CountGadgetItems(#list_nr) - 1
SetGadgetItemState(#list_nr, iitem, #PB_ListIcon_Selected)
Next
Case #menu_nomark
For iitem = 0 To CountGadgetItems(#list_nr) - 1
SetGadgetItemState(#list_nr, iitem, 0)
Next
Case #menu_new
If iitem = -1
\dataset = ""
Else
\dataset = DataListGetItem(iitem)
EndIf
InputWindow("Neu", \dataset)
Case #menu_edit
If iitem > -1
\dataset = DataListGetItem(iitem)
InputWindow("Ändern", \dataset)
Else
MessageRequester("Information", "Keine Daten markiert!")
EndIf
Case #menu_kill
If iitem > -1
j = MessageRequester("Löschen", "markierte Daten löschen ?", #PB_MessageRequester_YesNo)
If j = #PB_MessageRequester_Yes
While GetGadgetState(#list_nr) > -1
iitem = GetGadgetState(#list_nr)
RemoveGadgetItem(#list_nr, iitem)
Wend
SetGadgetState(#list_nr, iitem - 1)
If iitem - 1 < 0: SetGadgetState(#list_nr, iitem): EndIf
EndIf
Else
MessageRequester("Information", "Keine Daten markiert!")
EndIf
EndSelect
EndWith
EndProcedure
Procedure.i InputAnalyze()
With prgv
Protected j, isubitem, item$, iitem = GetGadgetState(#list_nr)
Select \inputmode ;wird in InputEvaluate() gesetzt
Case #menu_print
\prnsize = GetGadgetState(#prn_spin1)
\prnfields = GetGadgetState(#prn_spin2)
SetGadgetText(#input_go, "Druck startet")
PrintList()
InputWindowClose()
Case #menu_width: InputWindowClose()
Case #menu_sort: DataListSort(): InputWindowClose()
Case #menu_head
For isubitem = 1 To #fieldmax
item$ = GetGadgetText(\field(isubitem)\strgnr)
SetGadgetItemText(#list_nr, -1, item$, isubitem)
\field(isubitem)\name = item$
Next
InputWindowClose()
Case #menu_new ;Neuen Satz oben hinzufügen
\dataset = #LF$
For isubitem = 1 To #fieldmax
item$ = GetGadgetText(\field(isubitem)\strgnr): \dataset + item$ + #LF$
Next
AddGadgetItem(#list_nr, 0, \dataset)
SetGadgetState(#list_nr, 0): SetActiveGadget(\field(1)\strgnr)
Case #menu_ftyp
For isubitem = 1 To #fieldmax
item$ = UCase(Trim(GetGadgetText(\field(isubitem)\strgnr)))
Select Asc(item$)
Case 35, 48 To 57 ; #,0-9
Default: item$ = "T"
EndSelect
\field(isubitem)\typ = Asc(item$)
Next
InputWindowClose()
Case #menu_edit ;Ändern
For isubitem = 1 To #fieldmax
item$ = GetGadgetText(\field(isubitem)\strgnr)
SetGadgetItemText(#list_nr, iitem, item$, isubitem)
Next
SetGadgetState(#list_nr, iitem): InputWindowClose()
EndSelect
EndWith
EndProcedure
Procedure.i InputStringCheck(nr)
Protected i$, nb
Protected gadget = prgv\field(nr)\strgnr
Protected feldtyp = prgv\field(nr)\typ
Select feldtyp
Case 48 To 57 ;eine Zahl ohne/mit Decimalstellen
nb = feldtyp - 48: i$ = GetGadgetText(gadget)
ReplaceString(i$, "," , "." , #PB_String_InPlace)
i$ = StrF(ValF(i$), nb): SetGadgetText(gadget, i$)
EndSelect
EndProcedure
Procedure.i SetColumnWidth(nr)
Protected gadget = prgv\field(nr)\strgnr
Protected feldbr = Val(GetGadgetText(gadget))
prgv\field(nr)\br = feldbr
SetGadgetItemAttribute(#list_nr, 0, #PB_ListIcon_ColumnWidth, feldbr, nr)
If feldbr < 30: feldbr = 30: EndIf
ResizeGadget(gadget, #PB_Ignore, #PB_Ignore, feldbr, #PB_Ignore)
EndProcedure
Procedure.i GetStringGadgetIndex(gadget)
;Prüft ob gadget ein EingabeStringGadget ist
;wenn ja, wird Index zurückgegeben (1-#fieldmax)
Protected j, nr = 0
For j = 1 To #fieldmax
If prgv\field(j)\strgnr = gadget: nr = j: Break: EndIf
Next
ProcedureReturn nr
EndProcedure
Häkchen weg nicht vergessen