* ccw.prg - CCW-Mitgliederliste
* by Neil Franklin, Morgenweg 8, 8400 Winterthur
* version (last revision) 96.12.28
* written in dBase III+

  * tidy up before starting
  clear all
  set bell off
  set confirm on
  set console off
  set exact on
  set procedure to CCW
  set safety off
  set scoreboard off
  set status off
  set talk off
  * do the job
  do EventLoop
  * tidy up after running
  close all
  set console on
  set exact off
  set procedure to
  set safety on
  set scoreboard on
  set status on
  set talk on
  set message to
  clear all
  clear
return

* do the actual job
procedure EventLoop
  do MakeVar
  use CCW index CCW
  do ReadRec
  clear
  do BuildScr
  Field=FirstField
  do while .t.
    clear gets
    do SetGetFi
    read
    Key=iif(readkey() >= 256, readkey()-256, readkey())
    do case
      case Key = 4
        * arrow up - put cursor on previous field
        Field=iif(Field > FirstField, Field-1, LastField)
      case Key = 5
        * arrow down  - next field
        Field=iif(Field < LastField, Field+1, FirstField)
      case Key = 33
        * Ctrl-Home - top field
        Field=FirstField
      case Key = 14
        * Ctrl-End - bottom field
        Field=LastField
      case Key = 15
        * Enter - search and display record (fitting typed record)
        do FindRec
	do ReadRec
        do BuildScr
      case Key = 6 .or. Key = 7
        * Page Up or Page Down - previous or next selected record in database
	do SkipRec
	do ReadRec
        do BuildScr
      case Key = 36
        * F1 - select all records
        set filter to
      case Key = 34
        * Ctrl Page Up - enter new record
        do NewRec
        do BuildScr
	Field=FirstField
      case Key = 35
        * Ctrl Page Down - save changed record on screen
	do WriteRec
        do BuildScr
      case Key = 12
        * Esc - end program or print
        do EndPrt
        do BuildScr
    endcase
  enddo
return

* make global variables
procedure MakeVar
  * to store range for display/editing fields
  public FirstField,LastField,Field
  * to store data for fields
  public mMitglnr,mAnrede,mFamname,mVorname,mStrasse,mPlzort
  public mTelnumpr,mTelnumge,mEmail,mBeruf,mGebdat,mEintritt,mAustritt
  public mComputer,mProzessor,mPeripherie,mLastupdate
return

* read all fields of the active record into the temporary variables
procedure ReadRec
  mMitglnr=MITGLNR
  mAnrede=ANREDE
  mFamname=FAMNAME
  mVorname=VORNAME
  mStrasse=STRASSE
  mPlzort=PLZORT
  mTelnumpr=TELNUMPR
  mTelnumge=TELNUMGE
  mEmail=EMAIL
  mBeruf=BERUF
  mGebdat=GEBDAT
  mEintritt=EINTRITT
  mAustritt=AUSTRITT
  mComputer=COMPUTER
  mProzessor=PROZESSOR
  mPeripherie=PERIPHERIE
  mLastupdate=LASTUPDATE
return

* build up texts and fields on the screen
procedure BuildScr
  FirstField=100
  LastField=114
  BSTempField=Field
  Field=FirstField
  do while Field <= LastField
    do SetGetFi
    Field=Field+1
  enddo
  Field=BSTempField
return

* build up fields with their texts and select the active field
* this is the only procedure, which is dependent on screen layout
procedure SetGetFi
  do case
    case Field = 100
      @ 0, 0 say "                         CCW-Mitgliederliste"
      @ 4, 0 say "Mitgliednummer "+mMitglnr
      @ 4,40 say "Anrede        " get mAnrede
    case Field = 101
      @ 5, 0 say "Familienname  " get mFamname
    case Field = 102
      @ 5,40 say "Vorname       " get mVorname
    case Field = 103
      @ 7, 0 say "Strasse       " get mStrasse
    case Field = 104
      @ 7,40 say "PLZ/Wohnort   " get mPlzort picture "9999 xxxxxxxxxxxxxxxxxxxx"
    case Field = 105
      @ 8, 0 say "Telefon Privat" get mTelnumpr picture "999 / 999 99 99"
    case Field = 106
      @ 8,40 say "Gesch„ft      " get mTelnumge picture "999 / 999 99 99"
    case Field = 107
      @ 9, 0 say "Email Addrese " get mEmail
    case Field = 108
      @11,00 say "Beruf         " get mBeruf
    case Field = 109
      @11,40 say "Geburtsdatum  " get mGebdat
    case Field = 110
      @13, 0 say "Eintritt      " get mEintritt
    case Field = 111
      @13,40 say "Austritt      " get mAustritt
    case Field = 112
      @15, 0 say "Computer      " get mComputer
    case Field = 113
      @15,40 say "Prozessor     " get mProzessor
    case Field = 114
      @16, 0 say "Peripherie    " get mPeripherie
      @18, 0 say "Letzte Aender  "+dtoc(Lastupdate)
      @24, 0 say "Such Enter, N„ch PgDn, Letz PgUp, Alle F1, "+ ;
                 "Neu ^PgUp, Speich ^PgDn, End/Prt Esc"
  endcase
return

* find first record fitting desired condition (field content)
procedure FindRec
  do case
    case Field = 100
      set filter to ANREDE = mAnrede
    case Field = 101
      set filter to FAMNAME = mFamname
    case Field = 102
      set filter to VORNAME = mVorname
    case Field = 103
      set filter to STRASSE = mStrasse
    case Field = 104
      set filter to PLZORT = mPlzort
    case Field = 105
      set filter to TELNUMPR = mTelnumpr
    case Field = 106
      set filter to TELNUMGE = mTelnumge
    case Field = 107
      set filter to EMAIL = mEmail
    case Field = 108
      set filter to BERUF = mBeruf
    case Field = 109
      set filter to GEBDAT = mGebdat
    case Field = 110
      set filter to EINTRITT = mEintritt
    case Field = 111
      set filter to AUSTRITT = mAustritt
    case Field = 112
      set filter to COMPUTER = mComputer
    case Field = 113
      set filter to PROZESSOR = mProzessor
    case Field = 114
      set filter to PERIPHERIE = mPeripherie
  endcase
  OnDisplay=recno()
  locate for .t.
  if eof()
    go record OnDisplay
  endif
return

* got to next or previous fitting record
procedure SkipRec
  OnDisplay=recno()
  Key=iif(readkey() >= 256, readkey()-256, readkey())
  skip iif(Key = 6, -1, 1)
  if bof() .or. eof()
    go Record OnDisplay
  endif
return

* set the temporary variables to the default values for a new record
procedure NewRec
  * read an empty record
  OnDisplay=recno()
  go bottom
  skip 1
  do ReadRec
  go record OnDisplay
  * make member number invalid as flag for WriteRec
  mMitglnr="0000000"
  * add defaults to save typing
  mAnrede="Herrn"
  mPlzort="8400 Winterthur          "
  mTelnumpr="052 / ... .. .."
  mTelnumge="052 / ... .. .."
  * set last update to today
  mLastupdate=date()
return

* write the temporary variables to the record (new or modified one)
procedure WriteRec
  * if new member make new member number and record
  if mMitglnr = "0000000"
    do MakeNum
    append blank
  endif
  * make correct data stamp
  mLastupdate=date()
  replace MITGLNR with mMitglnr
  replace ANREDE with mAnrede
  replace FAMNAME with mFamname
  replace VORNAME with mVorname
  replace STRASSE with mStrasse
  replace TELNUMPR with mTelnumpr
  replace TELNUMGE with mTelnumge
  replace EMAIL with mEmail
  replace PLZORT with mPlzort
  replace BERUF with mBeruf
  replace GEBDAT with mGebdat
  replace EINTRITT with mEintritt
  replace AUSTRITT with mAustritt
  replace COMPUTER with mComputer
  replace PROZESSOR with mProzessor
  replace PERIPHERIE with mPeripherie
  replace LASTUPDATE with mLastupdate
return

* make a new member number
procedure MakeNum
  select 2
  use ccwnumme
  * code direct from JRU program, only Var names modified
  monat = substr(dtoc(mEintritt),4,2)
  record = val(monat)
  do while .not. record = recno()
    skip +1
  enddo
  neumonat = ltrim(str(MONATSTOT + 1))
  replace MONATSTOT with val(neumonat)
  cmeintritt = dtoc(mEintritt)
  if len(neumonat) = 1
    neumonat = "0"+neumonat
  endif
  mMitglnr = substr(cmeintritt,8,1)+substr(cmeintritt,4,2);
	    +substr(cmeintritt,1,2)+neumonat
  * end of code direct from JRU program
  use
  select 1
return

* print data or terminate prog, together because no free codes from readkey()
procedure EndPrt
  @24,0 say space(80)
  @24,8 say "Ende X, Telefonliste T, Etiketten E, Mitgliederliste M, Haupt H"
  wait to Key
  @24,0 say space(80)
  Key=upper(Key)
  do case
    case Key = "X"
      return to master
    case Key = "T"
      OnDisplay=recno()
      if file("TELLISTE.TXT")
	erase TELLISTE.TXT
      endif
      set alternate to TELLISTE.TXT
      set alternate on
      locate for AUSTRITT = ctod("  .  .  ") .or. AUSTRITT > date()
      do while found()
	?? VORNAME+" "+FAMNAME+" "+TELNUMPR+"      "+TELNUMGE
	?
	continue
      enddo
      set alternate off
      set alternate to
      go record OnDisplay
    case Key = "E"
      OnDisplay=recno()
      if file("ETTIKET.TXT")
	erase ETTIKET.TXT
      endif
      set alternate to ETTIKET.TXT
      set alternate on
      locate for AUSTRITT = ctod("  .  .  ") .or. AUSTRITT > date()
      do while found()
	?? "     "+trim(VORNAME)+" "+FAMNAME
	?  "     "+STRASSE
	?  "     "+PLZORT
	* 12 line high labels
	?
	?
	?
	?
	?
	?
	?
	?
	?
	?
	continue
      enddo
      set alternate off
      set alternate to
      go record OnDisplay
    case Key = "M"
      OnDisplay=recno()
      if file("MITGLIED.TXT")
	erase MITGLIED.TXT
      endif
      set alternate to MITGLIED.TXT
      set alternate on
      locate for AUSTRITT = ctod("  .  .  ") .or. AUSTRITT > date()
      do while found()
	?? FAMNAME+      "                     "+VORNAME
	?  STRASSE+           "                "+PLZORT
	?  TELNUMPR+"                          "+TELNUMGE
	?  EMAIL+                            " "+BERUF
	?  COMPUTER+     "                     "+PROZESSOR
        ?  PERIPHERIE
        ?
        ?
        continue
      enddo
      set alternate off
      set alternate to
      go record OnDisplay
  endcase
return