Seite 3 von 3

Verfasst: 10.05.2007 10:34
von D@nte
Du hast den Suchalgo also wo zur Hölle is dat Prob herauszufinden ob nen identischer Eintrag scho vorhanden is?!

Vllt sollteste dich erstma mit Grundlegendenprogrammierkonzepten auseinandersetzen und nen paar einfach Lernprogramm schreiben...
Bei ner Procedure allEven(Array) das den Array Inhalt überprüft ob dieser grad ist hättest z.B. scho ma gelernt wie'n suchalgo funzt und auch wie man überprüft ob bestimmte Elemente vorhanden sind -.-

Verfasst: 10.05.2007 11:49
von 10tacle
ja, da hast du recht. hab erst vor 2 wochen angefangen, mich mit programmierung zu beschäftigen.

dachte bloß, mir würde hier gut geholfen werden. so lern ich mir manche Dinge an und habe auch schon grundlegende Dinge als kleine programme gemacht. schade, dass es kein richtiges buch für purebasic gibt. z.b. bei delphi, gibt es direkt ein buch genannt "kochrezepte", wo für jede aktion, einfach für nahezu vieles, ein kleines programm drin steht....

ich bin halt ein absoluter neuling in der programmierung... :oops:

Verfasst: 10.05.2007 14:31
von dysti
Hey 10tacle,
Entschuldigung, mit dem Einlesen habe ich selber ein Bug produziert.
Nun ja, wenn mal eben schnell.......
Hier jetzt meine Änderung.
Habe mal ein bißchen im Forum gestöbert und Code zusammengeklickt.
Hier das Ergebnis.
Mach mal ein Doppelklick auf ein Eintrag.

Code: Alles auswählen

; gPreferences[460-5-1-1-922-202-0-397-118]
;-- Konstanten

#ABOUT = "Telefonbuch Version 1.0" +#LF$+#LF$ + "Author: Kay" + #LF$ + "Compiler: Purebasic v4.02"


Enumeration
  #Menu
EndEnumeration

Enumeration
  #ToolBar
EndEnumeration

Enumeration
  #StatusBar
EndEnumeration

Enumeration
  ;-----> Menu Datei
  #Menu_Neu
  #Menu_Oeffnen
  #Menu_Speichern
  #Menu_Speichern_unter
  #Menu_Drucken
  #Menu_Beenden
  #Menu_Vorschau
  #Menu_Find
  ;-----> Menu Hilfe
  #Menu_Ueber
EndEnumeration

;-- Globale Variablen

Global Exit.l
Global Datei.s
Global Titel.s
Global FileName.s
Global Speichern.l
Global Neu.l
Global Aendern.l
Global telsatz.l

;--- Funktionen#####################################################


;#################################################################

Procedure.l xcm(x.f)
  Protected Result.l
  Result = x * (PrinterPageWidth()/2100) ; 21cm A4
  ProcedureReturn Result
EndProcedure

Procedure ycm(x.f)
  Protected Result.l
  Result = x * (PrinterPageHeight()/2970) ; 29,7cm A4
  ProcedureReturn Result
EndProcedure
Procedure ListIcon_ScrollToItem(Gadget.l, item.l)
  Protected pitem.POINT 
  SendMessage_(GadgetID(Gadget), #LVM_GETITEMPOSITION,item, pitem); Itemposition in Pixel
  SendMessage_(GadgetID(Gadget), #LVM_SCROLL, pitem\x, pitem\y - 180); zu der Itemposition scrollen
EndProcedure

Procedure.S UmlautConversion(Name.S)
  Name = ReplaceString(Name, "Ä", "Ae")
  Name = ReplaceString(Name, "Ö", "Oe")
  Name = ReplaceString(Name, "Ü", "Ue")
  Name = ReplaceString(Name, "ä", "ae")
  Name = ReplaceString(Name, "ö", "oe")
  Name = ReplaceString(Name, "ü", "ue")
  Name = ReplaceString(Name, "ß", "ss")
  ProcedureReturn Name
EndProcedure 

Procedure.s BubbleSort(NameList.s(1),RCount.l)
Define TempName1.s,TempName2.s,j.l,i.l

For j = RCount - 2 To 0 Step -1
  For i = 0 To j
    TempName1 = UmlautConversion(NameList(i))
    TempName2 = UmlautConversion(NameList(i + 1))

    If TempName1 > TempName2
      Swap NameList(i), NameList(i + 1)
    EndIf
  Next i
Next j

EndProcedure

Procedure SortDaten(Ngadget.l,Column.l,ColumnCount.l)
  Define AnzahlPositionen.l,i.l,Eintrag.s,ii.l,text$,Datenneu.s,Datentext.s
  AnzahlPositionen = CountGadgetItems(Ngadget)
  If AnzahlPositionen>1
  Dim Feld.s(AnzahlPositionen-1)
 
  For i = 0 To AnzahlPositionen-1
    Eintrag.s=GetGadgetItemText(Ngadget,i,Column)
    If Eintrag<>" "
      For ii = 0 To ColumnCount-1
        text$=GetGadgetItemText(Ngadget,i,ii)
        Eintrag + "|" + text$
      Next
      Feld(i)= Eintrag
    EndIf
  Next
 
  BubbleSort(Feld(),AnzahlPositionen)
  ClearGadgetItemList(Ngadget)
 
  For i = 0 To AnzahlPositionen-1
 
    text$ = Feld(i)
    Datenneu.s=""
    For ii = 2 To ColumnCount+1
     
      Datentext.s = StringField(text$,ii,"|")
      Datenneu.s + Datentext+Chr(10)
     
    Next
    AddGadgetItem(Ngadget,-1,Datenneu)
  Next
  EndIf
EndProcedure


Procedure Datei_Speichern_unter()

;{ Procedure für Datei speichern als


  Protected eintrag.s
   
  ; Dateiname erfragen
  eintrag = SaveFileRequester("Datei Speichern als", "", "Telefonbuch (*.tel)|*.tel|Alle Dateien|*.*", 0)
  If eintrag = ""
    ProcedureReturn 0
    Else
    Datei=eintrag
  EndIf

  ; Datei prüfen
  If FileSize(eintrag) >= 0
    r1 = MessageRequester("Frage", "Datei " + Datei + " überschreiben?", #PB_MessageRequester_YesNo | #MB_ICONQUESTION)
    If r1 = #PB_MessageRequester_No
      ProcedureReturn 0
      Else
      Datei=eintrag
    EndIf
  EndIf
  ; Datei speichern
  
  ;If Save.b = 1
  ; Datei speichern
  If CreateFile(0, Datei)
   eintraganz.l = CountGadgetItems(7)
   For i = 0 To eintraganz-1
    eintrag.s = GetGadgetItemText(7,i,0) + "|" + GetGadgetItemText(7,i,1) + "|" + GetGadgetItemText(7,i,2)
    If eintrag <> GetGadgetItemText(7,i,1) ;ist ein Nachname vorhanden?
     WriteStringN(0,eintrag)
    EndIf
   Next i
   CloseFile(0)
   ; Variablen aktualisieren
    Speichern = 0
    Neu = 0
    ; Titel und Status aktualisieren
    Titel = "Telefonbuch - " + Datei
    SetWindowTitle(1, Titel)
    StatusBarText(#StatusBar, 0, "Datei wurde gespeichert")
  Else
    MessageRequester("Fehler", "Datei konnte nicht gespeichert werden", #MB_ICONSTOP)
  ;CloseFile(0)
  EndIf
 ;EndIf

EndProcedure



;#################################################################

Procedure Datei_Speichern()

;{ Procedure für Speichern
;
;}
 
  Protected eintrag.s
   ; Bei neuer Datei Speichern als aufrufen
  If Neu
    Datei_Speichern_unter()
    ProcedureReturn 0
  EndIf
 
 
  ; Datei speichern
  If CreateFile(0, Datei)
   eintraganz.l = CountGadgetItems(7)
   For i = 0 To eintraganz-1
    eintrag.s = GetGadgetItemText(7,i,0) + "|" + GetGadgetItemText(7,i,1) + "|" + GetGadgetItemText(7,i,2)
    If eintrag <> GetGadgetItemText(7,i,1) ;ist ein Nachname vorhanden?
     WriteStringN(0,eintrag)
    EndIf
   Next i
   CloseFile(0)

    ;Variablen aktualisieren
    Speichern = 0
    Neu = 0
    ; Titel und Status aktuallisieren
    Titel = "Telefonbuch - " + Datei
    SetWindowTitle(1, Titel)
    StatusBarText(#StatusBar, 0, "Datei wurde gespeichert")
  Else
    MessageRequester("Fehler", "Datei konnte nicht gespeichert werden", #MB_ICONSTOP)
  EndIf
   
EndProcedure


;#################################################################

Procedure Datei_Oeffnen()

;{ Procedure für Datei öffnen
;
;}

  Protected temp.s
 
  ; Bei änderung Speichern aufrufen
  If Speichern
    r1 = MessageRequester("Frage", "Änderung speichern?", #PB_MessageRequester_YesNoCancel | #MB_ICONQUESTION)
    If r1 = #PB_MessageRequester_Yes
      Datei_Speichern()
    EndIf
  EndIf
  If r1 = #PB_MessageRequester_Cancel
    ProcedureReturn 0
  EndIf
  ; Dateiname erfragen
  temp = OpenFileRequester("Datei öffnen", Datei, "Telefonbuch (*.tel)|*.tel|Alle Dateien (*.*)|*.*", 0)
  If temp = ""
    ProcedureReturn 0
  EndIf
  ; Datei öffnen
   ClearGadgetItemList(7)
  Datei = temp
   ;--- Telefonbuch-Daten aus Datei einlesen
 If OpenFile(0,Datei)
      While Eof(0) = 0
        Zeile$ = Trim(ReadString(0))
         If Zeile$<>"" 
            For FeldZaehler = 1 To CountString(Zeile$, "|")+1
                NeueZeile$=Trim(StringField(Zeile$, FeldZaehler, "|"))
                If ErsteSpalte=0
                AddGadgetItem(7,-1,NeueZeile$)
                ErsteSpalte=1
                Else
                SetGadgetItemText(7,azeile,NeueZeile$,FeldZaehler-1)
                EndIf     
            Next
        azeile=azeile+1
        ErsteSpalte=0
        EndIf
      Wend
    CloseFile(0)
    SortDaten(7,1,3)

    temp = ""
   
    ; Variablen aktualisieren
    Speichern = 0
    Neu = 0
    ; Titel und Status aktuallisieren
    Titel = "Telefonbuch - " + Datei
    SetWindowTitle(1, Titel)
    StatusBarText(#StatusBar, 0, "Datei wurde geöffnet")

  Else
    MessageRequester("Fehler", "Datei konnte nicht geöffnet werden", #MB_ICONSTOP)
  EndIf
 
EndProcedure

;##########################################################################

Procedure Datei_Oeffnen_sofort(temp.s)

;{ Procedure für Datei öffnen bei Parameterübergabe
;
;}


  Datei = temp
   ;--- Telefonbuch-Daten aus Datei einlesen
 If OpenFile(0,Datei)
      While Eof(0) = 0
        Zeile$ = ReadString(0)
         If Zeile$<>""        
            For FeldZaehler = 1 To CountString(Zeile$, "|")+1
                NeueZeile$=Trim(StringField(Zeile$, FeldZaehler, "|"))
                If ErsteSpalte=0
                AddGadgetItem(7,-1,NeueZeile$)
                ErsteSpalte=1
                Else
                SetGadgetItemText(7,azeile,NeueZeile$,FeldZaehler-1)
                EndIf     
            Next
        azeile=azeile+1
        ErsteSpalte=0
        EndIf
      Wend
    CloseFile(0)
    SortDaten(7,1,3)
    temp = ""
    ; Variablen aktuallisieren
    Speichern = 0
    Neu = 0
    ; Titel und Status aktuallisieren
    Titel = "Telefonbuch - " + Datei
    SetWindowTitle(1, Titel)
    StatusBarText(#StatusBar, 0, "Geöffnet")

  Else
    MessageRequester("Information","Konnte Datei nicht öffnen!")
    End
  EndIf


 
EndProcedure

;###################################################################################

Procedure Datei_Neu()

;{ Procedure für Neu
;
;}

  ; Bei Änderung Speichern aufrufen
  If Speichern
    r1 = MessageRequester("Frage", "Änderung speichern?", #PB_MessageRequester_YesNoCancel | #MB_ICONQUESTION)
    If r1 = #PB_MessageRequester_Yes
      Datei_Speichern()
    EndIf
  EndIf
  If r1 = #PB_MessageRequester_Cancel
    ProcedureReturn 0
  EndIf
  ; Editorfeld löschen
  ClearGadgetItemList(7)
  ; Variablen aktuallisieren
  Speichern = 0
  Neu = 1
  Datei = "neu.tel"
  ; Titel und Status aktuallisieren
  Titel = "Telefonbuch - " + Datei
  SetWindowTitle(1, Titel)
  StatusBarText(#StatusBar, 0, "Neu")
EndProcedure

;############################################################################


Procedure Datei_Drucken()

Protected Zeichenhoehe.l, z.l, rand.l, text.s, textz.s, Font1.l, Zeilenabstand.d
  Protected drreihe.l, drspalte.l, drucker.s, eintraganz.l, textgroesse.d,k.l
  k=1
  Zeichenhoehe=75
  textgroesse=0.6
  Zeilenabstand=Zeichenhoehe*textgroesse
 
  z=50
  rand=200
  textz.s=""
  text.s=""
  eintraganz.l = CountGadgetItems(7)
  ;Font1 = LoadFont(#PB_Any, "Courier New", 12, #PB_Font_StrikeOut)
  If PrintRequester()
   
   
    If StartPrinting("Job")
     
      LoadFont(0, "Courier New",Zeichenhoehe)
      LoadFont(1, "Courier New",Zeichenhoehe,#PB_Font_StrikeOut  )
     
      If StartDrawing(PrinterOutput())
        DrawingFont(FontID(0))
       
        DrawText(xcm(rand),ycm(Zeichenhoehe)," Telefonbucheinträge ")
       
       
        Zeichenhoehe=Zeichenhoehe+Zeilenabstand+Zeilenabstand
        k=k+1
        DrawText(xcm(rand),ycm(Zeichenhoehe),"Nachname            Vorname             Telefonnummer")
        Zeichenhoehe=Zeichenhoehe+Zeilenabstand
        k=k+1
        DrawingFont(FontID(1))
        DrawText(xcm(rand),ycm(Zeichenhoehe),"                                                       ")
        DrawingFont(FontID(0))
        Zeichenhoehe=Zeichenhoehe+Zeilenabstand
        k=k+1
        For drreihe=0 To eintraganz
          For drspalte= 0 To 2
            textz=GetGadgetItemText(7,drreihe,drspalte)
            If drspalte=0
              textz=LSet(textz,20)
            ElseIf drspalte=1
              textz=LSet(textz,20)
            ElseIf drspalte=2
              textz=LSet(textz,15)
            EndIf
            text=text+textz
          Next drspalte
          DrawText(xcm(rand),ycm(Zeichenhoehe),text)
          Zeichenhoehe=Zeichenhoehe+Zeilenabstand
          k=k+1
          If k=63
            NewPrinterPage()
            k=1
            Zeichenhoehe=75
            Zeilenabstand=Zeichenhoehe*textgroesse
          EndIf
          text=""
          textz=""
        Next drreihe
        StopDrawing()
       
      EndIf
     
      StopPrinting()
      EndIf
    EndIf
 
EndProcedure

Procedure Datei_Druckvorschau()

Protected Zeichenhoehe.l, z.l, rand.l, text.s, textz.s, Font1.l, Zeilenabstand.d
  Protected drreihe.l, drspalte.l, drucker.s, eintraganz.l, textgroesse.d,k.l
  k=1
  Zeichenhoehe=75
  textgroesse=0.6
  Zeilenabstand=Zeichenhoehe*textgroesse
 
  z=50
  rand=10
  textz.s=""
  text.s=""
  
   If OpenWindow(100, 200, 200, 502, 600, "Druckvorschau", #PB_Window_SystemMenu)
  CreateGadgetList(WindowID(100))
  EditorGadget(101, 35, 5, 430, 545)
  ButtonGadget(102, 210, 560, 100, 30, "Zurück")
  
  eintraganz.l = CountGadgetItems(7)
 
      LoadFont(0, "Courier New",Zeichenhoehe)
        Zeichenhoehe=Zeichenhoehe+Zeilenabstand+Zeilenabstand
        k=k+1
        AddGadgetItem(101,-1,Space(rand)+"Nachname            Vorname             Telefonnummer")
        Zeichenhoehe=Zeichenhoehe+Zeilenabstand
        k=k+1
        For drreihe=0 To eintraganz
          For drspalte= 0 To 2
            textz=GetGadgetItemText(7,drreihe,drspalte)
            If drspalte=0
              textz=LSet(textz,20)
            ElseIf drspalte=1
              textz=LSet(textz,20)
            ElseIf drspalte=2
              textz=LSet(textz,15)
            EndIf
            text=text+textz
          Next drspalte
          AddGadgetItem(101,-1,Space(rand)+text)
        text=""
        textz=""
      Next drreihe
    EndIf
 
EndProcedure

Procedure Datei_Namen_suchen()
      suchstr$=InputRequester("Suchen","Bitte geben sie den Suchnamen ein","")
      If suchstr$ > ""      
      SetGadgetState(7,0)
      reihe=0
      For i=0 To CountGadgetItems(7)-1
      telsuch=FindString(UCase(GetGadgetItemText(7, i, 1)),UCase(suchstr$),1)
      If telsuch=1
      telreihe=i
      SetActiveGadget(7)
      ListIcon_ScrollToItem(7, telreihe)
      SetGadgetItemState(7,telreihe,1)
      Break
      EndIf
      Next
      If i=CountGadgetItems(7)
      MessageRequester("Suche","Leider kein Eintrag gefunden!")
      EndIf
      Else  
      MessageRequester("Fehler!", "Die Suche wurde abgebrochen oder es wurde nichts eingegeben.")
      EndIf
EndProcedure

Procedure Datei_Dblclick()
aendern=1
        telsatz=GetGadgetState(7)
        teleintrag1$=GetGadgetItemText(7,telsatz,0)
        teleintrag2$=GetGadgetItemText(7,telsatz,1)
        teleintrag3$=GetGadgetItemText(7,telsatz,2)
        SetGadgetText(4,teleintrag1$)
        SetGadgetText(5,teleintrag2$)
        SetGadgetText(6,teleintrag3$)
EndProcedure

Procedure Datei_Eintragen()
 If GetGadgetText(4); <> "" And GetGadgetText(5) <> "" And GetGadgetText(6) <> ""
        AddGadgetItem(7,-1,GetGadgetText(4)+Chr(10)+GetGadgetText(5)+Chr(10)+GetGadgetText(6)+Chr(10))
        StatusBarText(#StatusBar, 0, "neuer Datensatz wurde eingetragen")
        SetGadgetText(4,"")
        SetGadgetText(5,"")
        SetGadgetText(6,"")
        SortDaten(7,1,3)
      Else
       MessageRequester("Fehler","Bitte alle Felder ausfüllen!",0)
      EndIf
EndProcedure

Procedure Datei_Namen_loeschen()
gadgetstate.w = GetGadgetState(7)
      If gadgetstate.w <> -1
        r1 = MessageRequester("Frage", "Soll der Datensatz gelöscht werden?", #PB_MessageRequester_YesNo | #MB_ICONQUESTION)
          If r1 = #PB_MessageRequester_No
            StatusBarText(#StatusBar, 0, "Löschen eines Datensatzes wurde abegebrochen")
          EndIf
       If r1 = #PB_MessageRequester_Yes
        RemoveGadgetItem(7,gadgetstate.w)
        StatusBarText(#StatusBar, 0, "Datensatz wurde gelöscht")
       EndIf
       Else
          MessageRequester("Fehler","Bitte einen Datensatz zum Löschen auswählen!",0)
       EndIf
EndProcedure

;######################################################################


Procedure ProgrammEnde()

;{ Procedure bei Programm Ende
;
;}
 
  ; Bei änderung Speichern aufrufen
  If Speichern
    r1 = MessageRequester("Frage", "Änderung speichern?", #PB_MessageRequester_YesNoCancel | #MB_ICONQUESTION)
    If r1 = #PB_MessageRequester_Yes
      Datei_Speichern()
    EndIf
  EndIf
  If r1 <> #PB_MessageRequester_Cancel
    Exit = 1
  EndIf
   
EndProcedure

Procedure Datei_Namen_aendern()
If Aendern=1
     If GetGadgetText(4); <> "" And GetGadgetText(5) <> "" And GetGadgetText(6) <> ""
        SetGadgetItemText(7,telsatz,GetGadgetText(4),0)
        SetGadgetItemText(7,telsatz,GetGadgetText(5),1)
        SetGadgetItemText(7,telsatz,GetGadgetText(6),2)
        StatusBarText(#StatusBar, 0, "Datensatz wurde geändert")
        SetGadgetText(4,"")
        SetGadgetText(5,"")
        SetGadgetText(6,"")
        SortDaten(7,1,3)
        Aendern=0
      Else
       MessageRequester("Fehler","Bitte alle Felder ausfüllen!",0)
      EndIf
      Else
      MessageRequester("Fehler","Bitte erst auf einen Eintrag doppelklicken")
      EndIf
EndProcedure
      
;---Hauptprogramm#####################################################




Datei = "unbekannt.tel"
Titel = "Telefonbuch - " + Datei

If OpenWindow(1, 400, 50, 350, 600, Titel, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
 
;--- Menü
 
   If CreateMenu(1, WindowID(1))
    MenuTitle("&Datei")
      MenuItem(#Menu_Neu, "&Neu" + #TAB$+ "Strg+N")
      MenuItem(#Menu_Oeffnen, "&Öffnen" + #TAB$+ "Strg+O")
      MenuItem(#Menu_Speichern, "&Speichern" + #TAB$+ "Strg+S")
      MenuItem(#Menu_Speichern_unter, "&Speichern unter")
      MenuItem(#Menu_Drucken, "&Drucken" + #TAB$+ "Strg+P")
      MenuItem(#Menu_Find, "&Suchen" + #TAB$+ "Strg+F")
      MenuBar()
      MenuItem(#Menu_Beenden, "Be&enden")
    MenuTitle("Hilfe")
      MenuItem(#Menu_Ueber, "&Über")
   
   
;--- Tastenkürzel hinzufügen für Neu, Öffnen und Speichern
  AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_N, #Menu_Neu)
  AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_O, #Menu_Oeffnen)
  AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_S, #Menu_Speichern)
  AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_P, #Menu_Drucken)
  AddKeyboardShortcut(1, #PB_Shortcut_Control | #PB_Shortcut_F, #Menu_Find)

 
  EndIf
  ;--- Toolbar erzeugen
  If CreateToolBar(#ToolBar, WindowID(1))
    ToolBarStandardButton(#Menu_Neu, #PB_ToolBarIcon_New)
    ToolBarStandardButton(#Menu_Oeffnen, #PB_ToolBarIcon_Open)
    ToolBarStandardButton(#Menu_Speichern, #PB_ToolBarIcon_Save)
    ToolBarStandardButton(#Menu_Drucken, #PB_ToolBarIcon_Print)
    ToolBarStandardButton(#Menu_Vorschau, #PB_ToolBarIcon_New)
    ToolBarStandardButton(#Menu_Find, #PB_ToolBarIcon_Find)
    ToolBarToolTip(#ToolBar, #Menu_Neu, "Neues Telefonbuch")
    ToolBarToolTip(#ToolBar, #Menu_Oeffnen, "Telefonbuch Öffnen")
    ToolBarToolTip(#ToolBar, #Menu_Speichern, "Telefonbuch Speichern")
    ToolBarToolTip(#ToolBar, #Menu_Drucken, "Telefonbuch Drucken")
    ToolBarToolTip(#ToolBar, #Menu_Vorschau, "Druck-Vorschau")
    ToolBarToolTip(#ToolBar, #Menu_Find, "Namen suchen")
 
 
  EndIf
 
 
 ;--- Gadgets
 If CreateGadgetList(WindowID(1))
  TextGadget(1, 10, 70, 100, 20, "Nachname:")
  TextGadget(2, 10, 40, 100, 20, "Vorname:")
  TextGadget(3, 10, 100, 100, 20, "Tel.:")
  StringGadget(4, 110, 40, 230, 20, "")
  StringGadget(5, 110, 70, 230, 20, "")
  StringGadget(6, 110, 100, 230, 20, "")
  ListIconGadget(7, 10, 205, 330, 350, "Vorname", 110, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
    AddGadgetColumn(7, 1, "Nachname", 110)
    AddGadgetColumn(7, 2, "Telefonnummer", 106)
  ButtonGadget(8, 10, 145, 100, 25, "Eintragen")
  ButtonGadget(9, 125, 175, 100, 25, "Löschen")
  ButtonGadget(10, 240, 145, 100, 25, "Beenden")
  ButtonGadget(11, 125, 145, 100, 25, "Ändern")
 EndIf


  ;--- Statusbar erzeugen
  CreateStatusBar(#StatusBar, WindowID(1))
 

 ;--- Telefonbuch-Daten aus Datei einlesen
 If OpenFile(0,Datei)
      While Eof(0) = 0
        Zeile$ = ReadString(0)
        If Zeile$<>""     
            For FeldZaehler = 1 To CountString(Zeile$, "|") + 1
                NeueZeile$=Trim(StringField(Zeile$, FeldZaehler, "|"))
                If ErsteSpalte=0
                AddGadgetItem(7,-1,NeueZeile$)
                ErsteSpalte=1
                Else
                SetGadgetItemText(7,azeile,NeueZeile$,FeldZaehler-1)
                EndIf     
            Next
        azeile=azeile+1
        ErsteSpalte=0
      EndIf
      Wend
    CloseFile(0)
  Else
    MessageRequester("Information","Konnte Datei nicht öffnen!")
    End
  EndIf



 SortDaten(7,1,3)


 ;--- Hauptschleife
 Repeat
 
  event.l = WaitWindowEvent()
  gadget  = EventGadget()
  menu    = EventMenu()
 
Select event

 Case #PB_Event_Menu
   Select menu
     Case #Menu_Neu
        Datei_Neu()
        SetActiveGadget(7)   
     Case #Menu_Oeffnen
        Datei_Oeffnen()
        SetActiveGadget(7)
     Case #Menu_Speichern
        Datei_Speichern()
        SetActiveGadget(7)
        StatusBarText(#StatusBar, 0, "Datei wurde gespeichert")
     Case #Menu_Speichern_unter
        Datei_Speichern_unter()
        SetActiveGadget(7)
        StatusBarText(#StatusBar, 0, "Datei wurde gespeichert")
     Case  #Menu_Drucken
        Datei_Drucken()
        SetActiveGadget(7)
        StatusBarText(#StatusBar, 0, "Datei wurde gedruckt")
     Case  #Menu_Vorschau
        Datei_Druckvorschau()
     Case #Menu_Find
        Datei_Namen_suchen()
     Case #Menu_Beenden
       ProgrammEnde()
     Case #Menu_Ueber
       MessageRequester("Info", #ABOUT)
   EndSelect     
   
   
 Case #PB_Event_Gadget
   Select gadget
      Case 102
      CloseWindow(100)
     Case 7 ;Doppelklick auf einen Listeneintrag
     If EventType() = #PB_EventType_LeftDoubleClick 
      Datei_dblclick()  
     EndIf
     Case 8 ;Eintragen-Button
      Datei_eintragen()
     Case 9 ;Löschen-Button
      Datei_Namen_loeschen()
     Case 10 ; Beenden-Button
      ProgrammEnde()
     Case 11 ;Ändern
        Datei_Namen_aendern()
   EndSelect
    
      ;--? Das Schließgadget vom Fenster wurde gedrückt
      Case #PB_Event_CloseWindow
        ;If gadget=102
        ;ProgrammEnde()
        ;EndIf
        Select EventWindow()
          Case 1
            ProgrammEnde()
          Case 100
            CloseWindow(100)
        EndSelect
EndSelect

Until Exit
 
EndIf
End 

Verfasst: 10.05.2007 14:53
von dysti
Code wurde oben geändert.

Verfasst: 10.05.2007 14:59
von dysti
Wenn man die Druckvorschau aufruft, sieht man, das die Spalteneinträge nicht richtig untereinander sind.
Wer weiß hier Abhilfe außer die Schriftart zu ändern?

Verfasst: 10.05.2007 15:06
von uweb
Ich bekomme hier einen ERROR "Array size can't be negative.".

edit:

Code: Alles auswählen

Procedure SortDaten(Ngadget.l,Column.l,ColumnCount.l)
  Define AnzahlPositionen.l,i.l,Eintrag.s,ii.l,text$,Datenneu.s,Datentext.s
  AnzahlPositionen = CountGadgetItems(Ngadget)
Delay (5000) 
  Dim Feld.s(AnzahlPositionen-1)

Verfasst: 10.05.2007 15:24
von dysti
@uweb, danke für die Meldung.
Code wurde oben geändert.