simple Adressverwaltung für PB Demoversion 4.3 x86

hjbremer · Beitrag von **hjbremer** » 28.04.2009 23:07

Hallo,
letztens hat hier im Anfängerforum jemand gefragt, wie man Daten / Variablen für eine Adressverwaltung abspeichert.
Im Verlauf der Antworten stellte sich heraus, das er die DemoVersion hat.

Nun ich fragte mich, ist es möglich mit der DemoVersion eine Adressverwaltung zu schreiben ?

Hier das Ergebnis.

Da das hier als < Nicht nur für mich persönlich ein "Abturner" > gesehen wird, hatte ich den Code entfernt.

Nun etwas überarbeitet, aber den "Abturner" Grund trotzdem nicht eingebaut, dafür die Prozeduren ans Ende gesetzt, damit auch jeder merkt, wozu die Declare Anweisungen gut sind.

Sollten noch Fehler drin sein, nun nobody is perfect.
Da die Demoversion nur 600 Zeilen zuläßt und dieser Code 575 Zeilen hat, ist kaum noch Platz für eigene Sachen. Allerdings kann man noch Leerzeilen entfernen bzw. etliche Befehle in eine Zeile zusammenfassen.

Wer dieses Grundgerüst einer Adressverwaltung benutzen und mehr Funktionen will, kommt um die Vollversion eh nicht herum.

Code: Alles auswählen

Declare DatenIni()
Declare DatenListe()
Declare DatenNeu()
Declare DatenSortierenAuswahl()
Declare DatenSortierenEnde()
Declare DatenSortierenStart()
Declare DatenSuchListe()
Declare DatenSuchListeClose()
Declare DatenSuchen(abitem)
Declare Datenaendern()
Declare Datenload(flag=0)
Declare Datenloeschen()
Declare Datensave(flag=0)
Declare DatensuchenFirst(modus)
Declare DatensuchenNext()
Declare EingabeEnde()
Declare EingabeFenster(info$,vorgabe$,item)
Declare EingabeLeer()
Declare EingabeOk()
Declare Eingabecheck(pbnr)
Declare TasteReturn()
Declare VergleicheSatz(q$,s$)
Declare.s DateiAuswahl(flag=0,dat$="")
Declare.s Datensatzholen(item)

; Konstanten und Import Befehl nur für die Demoversion nötig
 #LF$ = Chr(10): #TAB$ = Chr(9): #WM_KEYDOWN = 256: #VK_RETURN = 13
 #WS_POPUPWINDOW = 2156396544: #LVM_ENSUREVISIBLE = 4115: #EM_SETSEL = 177
 #MB_ICONEXCLAMATION = 48: #MB_ICONASTERISK = 64
 Import "USER32.lib" 
  SendMessage_(a.l,b.l,c.l,d.l) As "_SendMessageA" 
 EndImport

Enumeration  
#menu_load: #menu_save: #menu_save1: #menu_ende
#menu_neu: #menu_edit: #menu_kill: #menu_such1: #menu_such2: #menu_suchN
#menu_sort: #menu_info
#window_main: #list_nr
#window_sort: #listbox1: #listbox2: #listbox3
#sortstart: #sortende: #sortgk: #sortup: #sortdw
#window_eingabe
#eingabe_leer: #eingabe_save: #eingabe_ende
#eingabe_scb1: #eingabe_scb2
#window_liste: #suchliste: #suchlisteclose
EndEnumeration

#version = "MiniAdress von HJ Bremer" + #LF$ + "® Mai 2009 - Version 1.03"
#suchart1 = "alle Eingaben enthalten"

Structure myProgrammvariablen
  dateiname.s
  desktopbreite.i     ;Breite des Monitors in Pixel
  desktophoehe.i      ;Höhe
  feldanzahl.i        ;
  feldnamen.s[21]     ;Platz für Felder reservieren = 0 - 20
  feldbreite.i[21]    ;wir benutzen Feld null allerdings nicht
  eingabepbnr.i[21]   ;für Identnummern der StringGadgets = Eingabefelder
  gesamtbreite.i      ;alle feldbreiten addiert
  buttonbr.i          ;Buttonbreite
  buttonhh.i          ;
  datensatz.s         ;letzter geladener, bearbeiteter Datensatz
  eingabeitem.i       ;
  suchmodus.i         ;enthalten im gazen Datensatz oder im Feld
  suchwort.s
  suchsatz.s
  suchitem.i
  suchgk.i            ;bei Suche Groß/Kleinschrift beachten
  suchlv.i
  suchart.s           ;für verschiedene Sucharten, in dieser Version nur eine
EndStructure

Global prgv.myProgrammvariablen

Macro WinZeile(i)  ;zur Berechnung der Gadgetzeile im Eingabefenster
  10+((i)*30)      ;i muß in Klammern stehen, weil i z.B. j-1 sein kann
EndMacro

; Programmoberfläche definieren----------------------
DatenIni()
OpenWindow(#window_main, 0, 0, 0, 500, "MiniAdress (PB 4.3 x86)", #PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
 
    ListIconGadget(#list_nr, 0, 0, 0, 0, "", 0, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
    For j = 1 To prgv\feldanzahl
      AddGadgetColumn(#list_nr, j, prgv\feldnamen[j], prgv\feldbreite[j])
    Next

    CreateStatusBar(0, WindowID(#window_main))
      AddStatusBarField(prgv\gesamtbreite/2)
      AddStatusBarField(prgv\gesamtbreite/2)
    
    wx = (prgv\desktopbreite - prgv\gesamtbreite) / 2
    ResizeWindow(#window_main, wx, #PB_Ignore, prgv\gesamtbreite, #PB_Ignore)
    
    CreateMenu(0, WindowID(#window_main))
      MenuTitle("&Datei")
        MenuItem( #menu_load, "Ö&ffnen / Neu" + #TAB$ + "Strg+O")
        MenuItem( #menu_save, "&Speichern" + #TAB$ + "Strg+S")
        MenuItem( #menu_save1, "Speichern &als...")
        MenuBar()
        MenuItem( #menu_ende, "&Beenden" + #TAB$ + "Alt+F4")
      MenuTitle("&Bearbeiten")
        MenuItem( #menu_neu, "&Neu" + #TAB$ + "Strg+N")
        MenuItem( #menu_edit, "&ändern")
        MenuItem( #menu_kill,"&löschen")
      MenuTitle("&Suchen")
        MenuItem( #menu_such1, "&Suchen" + #TAB$ + "Strg+F / F4")
        MenuItem( #menu_such2, "Suchen im &Feld")
        MenuItem( #menu_suchN, "&Weitersuchen" + #TAB$ + "F3")
      MenuTitle("S&ortieren")
        MenuItem( #menu_sort, "sortieren")
      MenuTitle("&Info")
        MenuItem( #menu_info, "Info")
      
    listhoehe = 500 - StatusBarHeight(0) - MenuHeight() 
    ResizeGadget(#list_nr, #PB_Ignore, #PB_Ignore, prgv\gesamtbreite, listhoehe)      
      
    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_ende)
    AddKeyboardShortcut(#window_main, #PB_Shortcut_Control|#PB_Shortcut_N , #menu_neu)
    AddKeyboardShortcut(#window_main, #PB_Shortcut_Control|#PB_Shortcut_F , #menu_such1)
    AddKeyboardShortcut(#window_main,                      #PB_Shortcut_F4, #menu_such1)
    AddKeyboardShortcut(#window_main,                      #PB_Shortcut_F3, #menu_suchN)

    ;Datenload(1) ;Datei automatisch laden bei Programmstart

; Eingabeschleife--------------------------------------------
Repeat: event = WaitWindowEvent() ;:Debug event 
 Select event          
     Case #PB_Event_Gadget, #PB_Event_Menu 
          welchesgadget = EventGadget()
          Select welchesgadget
              Case #list_nr:    DatenListe() 
              Case #menu_load:  Datenload()
              Case #menu_save:  Datensave()
              Case #menu_save1: Datensave(1)
              Case #menu_ende:  event = #PB_Event_CloseWindow
              Case #menu_neu:   DatenNeu()
              Case #menu_edit:  Datenaendern()
              Case #menu_kill:  Datenloeschen()
              Case #menu_such1: DatensuchenFirst(1)
              Case #menu_such2: DatensuchenFirst(11)
              Case #menu_suchN: DatensuchenNext()
              Case #menu_sort:  Datensortierenauswahl()
              Case #sortstart:  DatensortierenStart()
              Case #sortende:   DatensortierenEnde()
              Case #menu_info:  MessageRequester("Info", #version)
              Case #eingabe_save: EingabeOk()   
              Case #eingabe_ende: EingabeEnde()   
              Case #eingabe_leer: EingabeLeer() 
              Case #suchlisteclose: DatenSuchlisteClose()
              Case prgv\eingabepbnr[1] To prgv\eingabepbnr[prgv\feldanzahl]
                   Eingabecheck(welchesgadget)                                      
          EndSelect 
     Case #WM_KEYDOWN: TasteReturn()
 EndSelect
Until event = #PB_Event_CloseWindow 
End

;Proceduren
Procedure DatenIni()
With prgv
  ExamineDesktops()
  \desktopbreite = DesktopWidth(0)
  \desktophoehe = DesktopHeight(0) 
  \gesamtbreite = 4 ;Startwert 
  \buttonbr = 80
  \buttonhh = 22
  
  ;Anzahl der Data Strings ermitteln
  For j = ?Data_FeldNamen To ?Data_FeldNamenEnde-1  ;die -1 muß sein, denn im Exefile
     If PeekC(j) = 0: k + 1: EndIf                  ;funktioniert es sonst nicht korrekt.
  Next
  \feldanzahl = k / 2  ;: Debug k
  If k % 2: MessageRequester("Error","Anzahl Data stimmt nicht "+Str(k),#MB_ICONASTERISK): End: EndIf 
  If \feldanzahl > 20: MessageRequester("Error","mehr als 20 Felder",#MB_ICONASTERISK): End: EndIf 
  
  Restore Data_FeldNamen  
  For j = 1 To \feldanzahl
    Read.s \feldnamen[j]
    Read.s breite$: \feldbreite[j] = Val(breite$)
    \gesamtbreite + \feldbreite[j]
  Next 
  If \gesamtbreite > \desktopbreite: \gesamtbreite = \desktopbreite - 50: EndIf 
 
EndWith
EndProcedure

Procedure.s Datensatzholen(item)
  x$ = #LF$: For j = 1 To prgv\feldanzahl: x$ + GetGadgetItemText(#list_nr, item, j) + #LF$: Next
ProcedureReturn x$
EndProcedure

Procedure EingabeFenster(info$,vorgabe$,item)
With prgv
  ;\eingabeitem bestimmt gleichzeitig wofür die Eingabe ist, siehe EingabeOk()
  \eingabeitem = item    
  
  DisableWindow(#window_main,1)
  OpenWindow(#window_eingabe, 0, 0, 0, 0, info$, #PB_Window_ScreenCentered,WindowID(#window_main)) 

  AddKeyboardShortcut(#window_eingabe, #PB_Shortcut_Alt|#PB_Shortcut_L, #eingabe_leer)
  AddKeyboardShortcut(#window_eingabe, #PB_Shortcut_Alt|#PB_Shortcut_A, #eingabe_ende)
  AddKeyboardShortcut(#window_eingabe, #PB_Shortcut_Escape, #eingabe_ende)

  For j = 1 To \feldanzahl
    If j < 11  ;max Feldbreite links
       If \feldbreite[j] > maxbreite: maxbreite = \feldbreite[j]: EndIf
    Else       ;max Feldbreite rechts
       If \feldbreite[j] > maxbreite2: maxbreite2 = \feldbreite[j]: EndIf
    EndIf
  Next

  infolg = 60
  infosp = 10: eingabesp = 5 + infosp + infolg
  infosp2 = 10 + eingabesp + maxbreite: eingabesp2 = 5 + infosp2 + infolg
  windowbreite = 450
  If maxbreite2
     If eingabesp2 + maxbreite2 > windowbreite
        windowbreite = eingabesp2 + maxbreite2 + 20
     EndIf   
  EndIf

  For j = 1 To \feldanzahl    
    k = j
    If j > 10: k - 10: EndIf
    If j = 11: infosp = infosp2: eingabesp = eingabesp2: EndIf    
    TextGadget(#PB_Any, infosp, 3+WinZeile(k-1), infolg, \buttonhh, \feldnamen[j], #PB_Text_Right)
    x$ = StringField(vorgabe$, j+1, #LF$) 
    \eingabepbnr[j] = StringGadget(#PB_Any, eingabesp, WinZeile(k-1), \feldbreite[j], \buttonhh, x$);,#ES_NOHIDESEL)
  Next

  saveinfo$ = "ändern"
  If \eingabeitem = -1
    saveinfo$ = "Hinzufügen"
  ElseIf \eingabeitem = -2
    saveinfo$ = "Suchen"
  EndIf
  
  k = 11  
  ButtonGadget(#eingabe_leer,  10, WinZeile(k), \buttonbr, \buttonhh, "&Leer")
  ButtonGadget(#eingabe_save, 110, WinZeile(k), \buttonbr, \buttonhh, saveinfo$)
  ButtonGadget(#eingabe_ende, 210, WinZeile(k), \buttonbr, \buttonhh, "&Abbruch")
  SetActiveGadget(\eingabepbnr[1])
  SendMessage_(GadgetID(\eingabepbnr[1]),#EM_SETSEL,0,-1)  ;markieren und Cursor ans Ende
  
  If \eingabeitem = -2  ;Sucheingabe
     k + 1
     CheckBoxGadget(#eingabe_scb1,  10, WinZeile(k), \buttonbr*2, \buttonhh, "Groß/Kleinschrift beachten")
     CheckBoxGadget(#eingabe_scb2, 210, WinZeile(k), \buttonbr*2, \buttonhh, "Ausgabe in Liste")
     ;hier ev. Optiongadgets für Sucharten
  EndIf 
  
  windowhoehe = WinZeile(k+2)
  x = (\desktopbreite - windowbreite - 10) / 2 
  y = (\desktophoehe - windowhoehe - 60) / 2 
  ResizeWindow(#window_eingabe, x, y, windowbreite, windowhoehe)
EndWith   
EndProcedure

Procedure EingabeLeer()
  For j = 1 To prgv\feldanzahl: SetGadgetText(prgv\eingabepbnr[j],""): Next
  SetActiveGadget(prgv\eingabepbnr[1])
EndProcedure

Procedure EingabeOk()
With prgv
  ;Eingaben auslesen
  eingabe$ = #LF$: For j = 1 To \feldanzahl: eingabe$ + GetGadgetText(\eingabepbnr[j]) + #LF$: Next
    
  If Len(eingabe$) > \feldanzahl+1  ;es gibt es eine Eingabe in irgendeinem Feld
  
     Select \eingabeitem  ;wird in EingabeFenster gesetzt
         ;Suchen
         Case -2: \suchsatz = eingabe$
                  \suchgk = GetGadgetState(#eingabe_scb1)  ;wenn 1, Groß/Klein beachten 
                  \suchlv = GetGadgetState(#eingabe_scb2)  ;wenn 1, Ausgabe in Liste
                  ;hier ev. Abfrage für Optiongadgets Sucharten
                  \suchart = #suchart1    
                  EingabeEnde()                            
                  If \suchlv: DatenSuchListe(): EndIf
                  \suchitem = DatenSuchen(0)
                  If \suchitem = -1
                     MessageRequester("Information","nix gefunden!",#MB_ICONASTERISK)
                  EndIf  
         ;Neu
         Case -1: \datensatz = eingabe$
                  AddGadgetItem(#list_nr, -1, eingabe$)                  
         ;Ändern
         Case 0 To CountGadgetItems(#list_nr)
                  ;For j = 1 To \feldanzahl
                  ;    x$ = GetGadgetText(\eingabepbnr[j])
                  ;    SetGadgetItemText(#list_nr, \eingabeitem, x$, j)
                  ;Next
                  ;EingabeEnde()
                  ;oder
                  RemoveGadgetItem(#list_nr,\eingabeitem)         ;entfernen
                  AddGadgetItem(#list_nr, \eingabeitem, eingabe$) ;einfügen
                  EingabeEnde()
     EndSelect
  
  Else  ;alle Felder sind leer
     SetActiveGadget(\eingabepbnr[1])
  EndIf
EndWith  
EndProcedure

Procedure EingabeEnde()
  CloseWindow(#window_eingabe): DisableWindow(#window_main,0)
EndProcedure

Procedure Eingabecheck(pbnr)
  If EventType() = #PB_EventType_LostFocus     
     SendMessage_(GadgetID(pbnr),#EM_SETSEL,0,0) ;Markierung aufheben
  EndIf
EndProcedure

Procedure TasteReturn()
  welchesActiveGadget = GetActiveGadget() ;:Debug welchesActiveGadget
  Select welchesActiveGadget
      Case prgv\eingabepbnr[1] To prgv\eingabepbnr[prgv\feldanzahl]
          If EventwParam() = #VK_RETURN
             For j = 1 To prgv\feldanzahl 
                If prgv\eingabepbnr[j] = welchesActiveGadget
                   ;SendMessage_(GadgetID(prgv\eingabepbnr[j]),#EM_SETSEL,0,0) ;Markierung aufhebn
                   j + 1: If j > prgv\feldanzahl: j = 1: EndIf  
                   SetActiveGadget(prgv\eingabepbnr[j])
                   SendMessage_(GadgetID(prgv\eingabepbnr[j]),#EM_SETSEL,0,-1) ;markieren + ans Ende
                   Break
                EndIf
             Next          
          EndIf          
  EndSelect  
EndProcedure          

Procedure VergleicheSatz(q$,s$)
  ok = -1
  For j = 1 To prgv\feldanzahl  
    qitem$ = StringField(q$, j+1, #LF$)  
    sitem$ = StringField(s$, j+1, #LF$)  
    If sitem$
        Select prgv\suchart  ;wird in EingabeOk() gesetzt
          Case #suchart1     ;alle Eingaben enthalten
               If FindString(qitem$, sitem$,1)
                  ok = 1
               Else
                  ok = -1: Break   
               EndIf    
        EndSelect
    EndIf
  Next
ProcedureReturn ok    
EndProcedure

Procedure DatensuchenFirst(modus)
  prgv\suchmodus = modus
  prgv\suchgk = 0
  Select modus
      Case 1
          prgv\suchwort = InputRequester("Suchen","Suchbegriff: ",prgv\suchwort)
          If prgv\suchwort = "": ProcedureReturn: EndIf
          prgv\suchitem = DatenSuchen(0)
          If prgv\suchitem = -1: MessageRequester("Information","nix gefunden!",#MB_ICONASTERISK): EndIf  
      Case 11
          EingabeFenster("Suchen",prgv\suchsatz,-2)          
  EndSelect
EndProcedure

Procedure DatensuchenNext()
weitersuchen:
  prgv\suchitem = DatenSuchen(prgv\suchitem+1)
  If prgv\suchitem = -1
     info$ = "nix mehr gefunden!"+#LF$+#LF$+"von Beginn an weitersuchen ?"
     antwort = MessageRequester("Information",info$,#PB_MessageRequester_YesNo|#MB_ICONEXCLAMATION)
     If antwort = #PB_MessageRequester_Yes: Goto weitersuchen: EndIf
  EndIf
EndProcedure

Procedure DatenSuchen(abitem)
  ok = -1
  SetGadgetState(#list_nr,-1)
  
  Select prgv\suchmodus  ;wird in DatensuchenFirst() gesetzt
      Case 1: ;prgv\suchwort wird in DatensuchenFirst() gesetzt
              For item = abitem To CountGadgetItems(#list_nr) - 1
                  x$ = Datensatzholen(item)
                  s$ = prgv\suchwort
                  If prgv\suchgk = 0: x$ = LCase(x$): s$ = LCase(s$): EndIf
                  If FindString(x$, s$, 1)
                     StatusBarText(0, 1, s$ + " in " + "Satz: " + Str(item+1))
                     SendMessage_(GadgetID(#list_nr),#LVM_ENSUREVISIBLE,item,1)
                     SetGadgetState(#list_nr,item): SetActiveGadget(#list_nr)
                     ok = item: Break    
                  EndIf
              Next
      Case 11 ;prgv\suchsatz wird in EingabeOk() gesetzt
              For item = abitem To CountGadgetItems(#list_nr) - 1
                  x$ = Datensatzholen(item): ori$ = x$
                  s$ = prgv\suchsatz
                  If prgv\suchgk = 0: x$ = LCase(x$): s$ = LCase(s$): EndIf
                  If VergleicheSatz(x$, s$) = 1  
                     If prgv\suchlv
                       AddGadgetItem(#suchliste, -1, Str(item+1) + ori$)
                       ok = item
                     Else
                       StatusBarText(0, 1, "Satz: " + Str(item+1))
                       SendMessage_(GadgetID(#list_nr),#LVM_ENSUREVISIBLE,item,1)
                       SetGadgetState(#list_nr,item): SetActiveGadget(#list_nr)
                       ok = item: Break    
                     EndIf
                  EndIf
              Next              
  EndSelect
ProcedureReturn ok     
EndProcedure

Procedure DatenSuchListe()
  DisableWindow(#window_main,1)
  OpenWindow(#window_liste, 0, 0, 450, 350, "Suchergebnis", #PB_Window_ScreenCentered,WindowID(#window_main)) 
    ListIconGadget(#suchliste, 0, 0, 450, 300, "Nr.", 40, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
    For j = 1 To prgv\feldanzahl
      AddGadgetColumn(#suchliste, j, prgv\feldnamen[j], prgv\feldbreite[j])
    Next
    ButtonGadget(#suchlisteclose, 10, 320, prgv\buttonbr, prgv\buttonhh, "Schließen")
EndProcedure

Procedure DatenSuchListeClose()
  CloseWindow(#window_liste)
  DisableWindow(#window_main,0)
EndProcedure

Procedure DatenNeu()
  EingabeFenster("Neu",prgv\datensatz, -1) ; -1 = ans Ende der Liste
EndProcedure

Procedure Datenaendern()
  item = GetGadgetState(#list_nr)
  If item > -1
    prgv\datensatz = Datensatzholen(item)
    EingabeFenster("Ändern",prgv\datensatz,item)
  Else
    MessageRequester("Information","kein Eintrag markiert!") 
  EndIf 
EndProcedure

Procedure Datenloeschen()
  item = GetGadgetState(#list_nr)
  If item > -1
    prgv\datensatz = Datensatzholen(item)
    RemoveGadgetItem(#list_nr,item): SetGadgetState(#list_nr,item)
  Else
    MessageRequester("Information","kein Eintrag markiert!") 
  EndIf 
EndProcedure

Procedure DatenSortierenAuswahl()
Shared sort1, sort2, sort3
  DisableWindow(#window_main,1)
  OpenWindow(#window_sort, 0, 0, 320, 305, "", #WS_POPUPWINDOW | 1,WindowID(#window_main)) 
  TextGadget(#PB_Any, 10, 10, 300, prgv\buttonhh, "Wählen Sie die Sortierreihenfolge")
  ListViewGadget(#listbox1,  10, 40, 100, 200)
  ListViewGadget(#listbox2, 110, 40, 100, 200)
  ListViewGadget(#listbox3, 210, 40, 100, 200)
  ButtonGadget  (#sortstart, 10, 250, prgv\buttonbr,   prgv\buttonhh, "Start")
  ButtonGadget  (#sortende , 10, 275, prgv\buttonbr,   prgv\buttonhh, "Abbruch")
  CheckBoxGadget(#sortgk,   110, 250, prgv\buttonbr*2, prgv\buttonhh, "Groß/Kleinschrift beachten") 
  OptionGadget  (#sortup,   110, 275, prgv\buttonbr,   prgv\buttonhh, "aufsteigend") 
  OptionGadget  (#sortdw,   210, 275, prgv\buttonbr,   prgv\buttonhh, "absteigend") 
  For j = 1 To prgv\feldanzahl
    AddGadgetItem (#listbox1, -1, prgv\feldnamen[j])   
    AddGadgetItem (#listbox2, -1, prgv\feldnamen[j])   
    AddGadgetItem (#listbox3, -1, prgv\feldnamen[j])   
  Next
  SetGadgetState(#listbox1, sort1)
  SetGadgetState(#listbox2, sort2)
  SetGadgetState(#listbox3, sort3) 
EndProcedure

Procedure DatenSortierenStart()
Shared sort1, sort2, sort3
  sort1 = GetGadgetState(#listbox1)
  sort2 = GetGadgetState(#listbox2)
  sort3 = GetGadgetState(#listbox3)
  sorttiefe = 25
  datenposi = 1 + (sorttiefe*3)
  datenanzahl = CountGadgetItems(#list_nr)-1: Dim daten$(datenanzahl+1)
  For j = 0 To datenanzahl 
    x$ = Datensatzholen(j)
    a$ = LSet(StringField(x$, sort1+2, #LF$), sorttiefe)
    a$ + LSet(StringField(x$, sort2+2, #LF$), sorttiefe)
    a$ + LSet(StringField(x$, sort3+2, #LF$), sorttiefe)
    daten$(j) = a$ + x$   
  Next
  
  If GetGadgetState(#sortgk) = 0: sortoption = #PB_Sort_NoCase: EndIf
  If GetGadgetState(#sortdw) = 1: sortoption = #PB_Sort_Descending|sortoption: EndIf
  SortArray(daten$(),sortoption,0,datenanzahl)
  
  HideGadget(#list_nr,1): ClearGadgetItems(#list_nr) 
  For j = 0 To datenanzahl 
    x$ = Mid(daten$(j), datenposi): AddGadgetItem(#list_nr,-1, x$)
  Next
  HideGadget(#list_nr,0)
  DatenSortierenEnde()
EndProcedure

Procedure DatenSortierenEnde()
  CloseWindow(#window_sort): DisableWindow(#window_main,0)
EndProcedure

Procedure.s DateiAuswahl(flag=0,dat$="")
  file$ = GetCurrentDirectory() + GetFilePart(dat$) 
  patt$ = "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  
  If file$ = "": file$ = GetCurrentDirectory() + "miniadress.txt": EndIf
ProcedureReturn file$
EndProcedure

Procedure Datenload(flag=0)
  If flag = 0
    prgv\dateiname = DateiAuswahl(0,prgv\dateiname)
  Else
    prgv\dateiname = GetCurrentDirectory() + "miniadress.txt"
  EndIf
  ClearGadgetItems(#list_nr) 
  dnr = ReadFile(#PB_Any,prgv\dateiname)  
  If dnr
      HideGadget(#list_nr,1) ;für schnelleres Anzeigen der Liste
      While Eof(dnr) = 0          
        prgv\datensatz = ReadString(dnr) 
        ReplaceString(prgv\datensatz,#TAB$,#LF$,#PB_String_InPlace)
        AddGadgetItem(#list_nr,-1, prgv\datensatz)
      Wend
      CloseFile(dnr)
      HideGadget(#list_nr,0)
      StatusBarText(0, 1, Str(CountGadgetItems(#list_nr)))
  EndIf
  StatusBarText(0, 0, prgv\dateiname)
EndProcedure

Procedure Datensave(flag=0)
  If prgv\dateiname = "" Or flag = 1
    prgv\dateiname = DateiAuswahl(1,prgv\dateiname)
  EndIf
  dnr = CreateFile(#PB_Any, prgv\dateiname) 
  If dnr
    For item = 0 To CountGadgetItems(#list_nr) - 1
      x$ = Datensatzholen(item)
      ReplaceString(x$,#LF$,#TAB$,#PB_String_InPlace)
      WriteStringN(dnr, x$)
    Next   
    CloseFile(dnr)
  EndIf
  StatusBarText(0, 0, prgv\dateiname)
  StatusBarText(0, 1, "gespeichert: " + Str(item)) 
EndProcedure

Procedure DatenListe()
  Select EventType()  ;die 768 gilt für Tasten Pfeil oben/unten
    Case #PB_EventType_LeftClick, 768: StatusBarText(0, 1, "Satz: " + Str(GetGadgetState(#list_nr)+1))
    Case #PB_EventType_LeftDoubleClick: Datenaendern()
  EndSelect   
EndProcedure

DataSection
Data_FeldNamen: ;Feldname und Breite
Data.s "Vorname", "99", "Nachname","99", "Alter","50", "m/w","40"
Data.s "Plz/Ort","120", "Strasse","99", "Tel.","99", "Handy","99"
Data_FeldNamenEnde:
EndDataSection

Fehler beseitigt: Liste wurde nicht gelöscht bei Öffnen/Neu

KeyKon · Beitrag von **KeyKon** » 28.04.2009 23:10

Und wiso kommt das nich in die Tipps&Tricks oder in die FAQ?
Btw: GOTO IST BÖSE

Fluid Byte · Beitrag von **Fluid Byte** » 28.04.2009 23:23

hjbremer hat geschrieben:Auf Protecteted, Explicit und Define etc. habe ich wie immer verzichtet, außerdem benutzen Anfänger dies eher selten

Ganz schlechte Idee

Nicht nur für mich persönlich ein "Abturner" aber wie sollen es Anfänger lernen wenn mann nicht mit gutem Beispiel vorangeht?

- Wenn man startet wird man gleich mit einem OpenFileRequester belästigt. Ist überflüssig wenn man noch keine Datenbank hat. Bitte optional machen.

- geht man in den Sortieren-Dialog crasht das Programm wenn noch keine Einträge vorhanden sind. Das fatale, um den Dialog wieder zu schließen muss man auf "Sortieren" drücken.

- Der "Ok" Button im Dialog zum einfügen neuer Einträge sollte "Hinzufügen" heißen da sich das Fenster ja nicht schließt sondern man weitere Einträge erstellen kann.

hjbremer · Beitrag von **hjbremer** » 29.04.2009 20:00

Ansichtssache mit dem guten Beispiel

ich sehe es anders !

ts-soft · Beitrag von **ts-soft** » 29.04.2009 20:10

Auf deklarierte Variablen werde ich nie verzichten, macht vieles leichter,
selbst bei so kurzen Codes und erst recht bei grossen.

Auf Declare hätte ich hierbei aber gänzlich verzichtet, ist bei so kurzem
Code nicht notwendig, da kann man die Proceduren in einer logischen
Reihenfolge schreiben.

Also ich hätte es genau anders herum gemacht

Beitrag von **Kiffi** » 29.04.2009 20:10

hjbremer hat geschrieben:ich sehe es anders !

dass Anfänger sich von Anfang an angewöhnen, auf eine anständige
Variablendeklaration zu verzichten? Na, dann mal Prost Mahlzeit! Die Suppe
müssen ja dann die Kollegen hier im Board auslöffeln.

Zumindest steht der Code im richtigen Unterforum
und nicht in Code, Tipps & Tricks...

Grüße ... Kiffi

Sauer-RAM · Beitrag von **Sauer-RAM** » 01.05.2009 22:07

hjbremer ich glaub du meinst mich. Ich hab das vor kurzem gefragt.
Und ihr redet hier über einen code... Wo ist er denn

würd mich nähmlich auch interesieren

TomS · Beitrag von **TomS** » 01.05.2009 22:10

Sauer-RAM hat geschrieben:hjbremer ich glaub du meinst mich. Ich hab das vor kurzem gefragt.
Und ihr redet hier über einen code... Wo ist er denn
würd mich nähmlich auch interesieren

Wer lesen kann, ist im Vorteil.

Er hat den Code entfernt, weil er von den anderen als nicht anfängertauglich eingestuft wurde.

Vielleicht kommt ja bald ein Update

Fluid Byte · Beitrag von **Fluid Byte** » 01.05.2009 22:34

hjbremer hat geschrieben:Da das hier als < Nicht nur für mich persönlich ein "Abturner" > gesehen wird, habe ich den Code entfernt.

Bekloppt? Der Code ist völlig in Ordnung es ging nur um

hjbremer hat geschrieben:Auf Protecteted, Explicit und Define etc. habe ich wie immer verzichtet

Wäre besser wenn der Code EnableExplicit-fähig wär aber deshalb musst du ihn doch nicht gleich komplett entfernen ...

Vera · Beitrag von **Vera** » 03.05.2009 10:09

@hjbremer

Danke, dass Du den Code wieder reingestellt hast. .

Als ich Deinen Thread das erste Mal sah, dachte ich: 'Das ist ja prima, das ist im Prinzip wie das 'Partner-such-programm', womit wir damals an der Uni das Programmieren angefangen hatten, das möchte ich mir mal vergleichend ansehen.'
Da ich vorher noch zu erwartende 'konstruktive oder ergänzende Hinweise' abwarten wollte, war ich auch erschrocken, dass es tagsdrauf verschwunden war. Doch gerade für Anfänger finde ich solche 'Anmerkungen' sehr hilfreich, da sie auf unterschiedliche Programmierstile und potenzielle Fehlerquellen hinweisen.
In diesem Sinne würd' ich mich auch über weitere 'erhellende Profikritiken' freuen. .

Gruß ~ Vera
~

PureBoard

simple Adressverwaltung für PB Demoversion 4.3 x86

simple Adressverwaltung für PB Demoversion 4.3 x86

Re: simple Adressverwaltung für PB Demoversion 4.3 x86