home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 01 / haka / haka20.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-27  |  9.1 KB  |  211 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                                HAKA20.PAS                               *)
  3. (*                   H a u s h a l t s k a s s e  v2.0                     *)
  4. (*                (C) 1987  Michael Hecker & PASCAL INT.                   *)
  5. (* ----------------------------------------------------------------------- *)
  6. PROGRAM Haushaltskasse;
  7. CONST
  8.     promptx = 20;                         (* Koordinaten der Meldungszeile *)
  9.     prompty = 25;
  10.     Nmon    = 'Neuen Monat anlegen';
  11.     Amon    = 'Aktuellen Monat bearbeiten';
  12.     Mstat   = 'Monats-Statistik';
  13.     Jstat   = 'Jahres-Statistik';
  14.     Mwe     = 'Monat wechseln';
  15.     Ende    = 'Programm beEnden';
  16.     Titel   = 'H A U S H A L T S K A S S E    V2.0';
  17.     Blank   = '    ';                                     (* 5 Leerzeichen *)
  18.     underline =
  19.      '=====================================================================';
  20. TYPE
  21.    Stringtyp = STRING[30];
  22.    Monstr    = STRING[9];
  23.    Mon_Aus   = RECORD
  24.                  SummeL,                                   (* Lebensmittel *)
  25.                  SummeT,                               (* Toilettenartikel *)
  26.                  SummeLit,                                    (* Literatur *)
  27.                  SummeKfz,                                         (* Auto *)
  28.                  SummePost,                                        (* Post *)
  29.                  SummeKleid,                                   (* Kleidung *)
  30.                  SummeWoh,                                      (* Wohnung *)
  31.                  SummeBuro,                                (* Bueroartikel *)
  32.                  SummeFrei,                              (* Freizeit/Hobby *)
  33.                  SummeDiv,                                     (* Diverses *)
  34.                  Guthaben_MonAnfang,           (* Guthaben am Monatsanfang *)
  35.                  Einkommen,                     (* Einkommen im lfd. Monat *)
  36.                  Guthaben : REAL;
  37.                END;
  38. VAR
  39.   mflag, mflag1, KeineDaten : BOOLEAN;
  40.   Tag, Mon, Jahr, Fehler    : INTEGER;
  41.   Monat                     : Monstr;
  42.   Key                       : CHAR;
  43.   Guth, Summe               : REAL;
  44.   Liste                     : Mon_Aus;
  45.   Datei                     : FILE OF Mon_Aus;
  46.   Ext                       : STRING[3];   (* Extention fuer den Filenamen *)
  47.                                            (* --> HAKA.EXT                 *)
  48. (* ----------------------------------------------------------------------- *)
  49. PROCEDURE Invers;                                   (* Bildschirmsteuerung *)
  50. BEGIN  TextBackGround(White);  TextColor(Black);  END;
  51.  
  52. PROCEDURE Normal;
  53. BEGIN  TextBackGround(Black);  TextColor(White);  END;
  54.  
  55. PROCEDURE Pause (x: INTEGER);              (* bei anderen Pascal-Sys. z.B. *)
  56. BEGIN  Delay(x);  END;                     (* durch FOR-Schleife ersetzen  *)
  57. (* ----------------------------------------------------------------------- *)
  58. PROCEDURE Initialisieren;                         (* Record initialisieren *)
  59. BEGIN
  60.   KeineDaten := FALSE;
  61.   WITH Liste DO BEGIN
  62.     SummeL := 0;      SummeT := 0;        SummeLit := 0;
  63.     SummeKfz := 0;    SummePost := 0;     SummeKleid := 0;
  64.     SummeWoh := 0;    SummeBuro := 0;     SummeFrei := 0;
  65.     SummeDiv := 0;    Guthaben_MonAnfang := 0;
  66.     Guthaben := 0;    Einkommen := 0;
  67.   END;
  68. END;
  69. (* ----------------------------------------------------------------------- *)
  70. PROCEDURE Ueberschrift;
  71. BEGIN
  72.   ClrScr;  GotoXY(5,1);  Invers;
  73.   WriteLn(Blank,Blank,Titel,Blank,Blank,Tag,'.',Monat,' ',Jahr,Blank,Blank);
  74.   Normal;
  75. END;
  76. (* ----------------------------------------------------------------------- *)
  77. (*      druckt String an Position x,y - der i. Buchstabe ist invers        *)
  78. PROCEDURE Say (s: Stringtyp; i,x,y: INTEGER);
  79. VAR p : INTEGER;
  80. BEGIN
  81.   LowVideo;  GotoXY(x,y);
  82.   FOR p:= 1 TO Length(s) DO BEGIN
  83.     IF p = i THEN  BEGIN  NormVideo;  Write(s[p]);  LowVideo;  END
  84.     ELSE Write(s[p]);
  85.   END;
  86.   NormVideo;
  87. END;
  88. (* ----------------------------------------------------------------------- *)
  89. (*  Tastaturpuffer immer wieder auslesen, Char in Grossbuchstaben wandeln  *)
  90. FUNCTION Getkey: CHAR;
  91. VAR ch : CHAR;
  92. BEGIN
  93.   WHILE KeyPressed DO Read (Kbd,ch);
  94.   Read(Kbd,ch);  Getkey := UpCase(ch);
  95. END;
  96. (* ----------------------------------------------------------------------- *)
  97. (*  Aufruf bei falschem Zeichen, Meldung ausgeben und neues Zeichen holen: *)
  98. FUNCTION Error_c (msg: Stringtyp): CHAR;
  99. BEGIN
  100.   GotoXY(promptx,prompty);  ClrEol;
  101.   Invers;  Write(msg);  Normal;
  102.   Error_c := Getkey;  GotoXY(promptx,prompty);  ClrEol;
  103. END;
  104. (* ----------------------------------------------------------------------- *)
  105. (* fordert Eingabe von J/N, gibt true/false zurueck. msg ist eine Frage,   *)
  106. (*                  die  mit J/N beantwortet werden muss                   *)
  107. FUNCTION JaNein (msg: Stringtyp): BOOLEAN;
  108. BEGIN
  109.   Invers;  GotoXY(promptx,prompty);  Write(msg,' (J/N)? ');  Normal;
  110.   Key := Getkey;  GotoXY(promptx,prompty);  ClrEol;
  111.   WHILE NOT(Key IN ['J','N']) DO
  112.     Key := Error_c('Antwort sollte J oder N sein !');
  113.   JaNein := (Key = 'J');
  114. END;
  115. (* ----------------------------------------------------------------------- *)
  116. PROCEDURE Datum; (* Systemdatum ermitteln, hier nur fuer MSDOS-Benutzer!!! *)
  117. TYPE  regpack = RECORD
  118.                   ax,bx,cx,dx,bp,si,di,ds,es,flags: INTEGER;
  119.                 END;
  120. VAR   recpack : regpack;                       (* Record fuer MsDos-Aufruf *)
  121. BEGIN
  122.   WITH recpack DO ax := $2a SHL 8;
  123.   MsDos(recpack);
  124.   WITH recpack DO BEGIN
  125.     Jahr := cx;  Tag := dx MOD 256;  Mon := dx SHR 8;
  126.   END;
  127. END;
  128. (* ----------------------------------------------------------------------- *)
  129. PROCEDURE Monats_Umwandlung (VAR Zahl: INTEGER);
  130. BEGIN
  131.   CASE Zahl OF
  132.     1  : Monat := 'Januar';        2  : Monat := 'Februar';
  133.     3  : Monat := 'Maerz';         4  : Monat := 'April';
  134.     5  : Monat := 'Mai';           6  : Monat := 'Juni';
  135.     7  : Monat := 'July';          8  : Monat := 'August';
  136.     9  : Monat := 'September';     10 : Monat := 'Oktober';
  137.     11 : Monat := 'November';      12 : Monat := 'Dezember';
  138.   END;
  139. END;
  140. (* ----------------------------------------------------------------------- *)
  141. PROCEDURE Daten_Speichern;
  142. BEGIN
  143.   GotoXY(promptx,prompty);  Invers;
  144.   Write(' Daten fuer ',Monat,' werden gespeichert ! ');  Normal;
  145.   Ext := Copy(Monat,1,3);            (* Extention aus Monatsnamen ableiten *)
  146.   Assign(Datei,'HAKA'+'.'+Ext);                         (* z. B.: HAKA.AUG *)
  147.   ReWrite(Datei);                       (* Datei zum Schreiben vorbereiten *)
  148.   Write(Datei,Liste);                                (* Record abspeichern *)
  149.   Close(Datei);
  150.   Pause(2000);                                (* nur zum Lesen der Meldung *)
  151. END;
  152. (* ----------------------------------------------------------------------- *)
  153. PROCEDURE Daten_Lesen;
  154. BEGIN
  155.   KeineDaten := FALSE;  GotoXY(promptx,prompty);  Invers;
  156.   Write(' Daten fuer ',Monat,' werden gelesen !    ');  Normal;
  157.   Ext := Copy(Monat,1,3);   Assign(Datei,'HAKA'+'.'+Ext);
  158.   (*$I-*)             (* I/O-Ueberwachung durch Laufzeitsystem ausschalten *)
  159.   ReSet(Datei);                             (* Datei zum Lesen vorbereiten *)
  160.   (*$I+*)                   (* ...und I/O-Ueberwachung wieder reaktivieren *)
  161.   Fehler := IOResult;                              (* Ergebnis von 'ReSet' *)
  162.   IF Fehler = 0 THEN                                        (* alles ok !! *)
  163.     BEGIN
  164.       Read(Datei,Liste);                                (* Record einlesen *)
  165.       Pause(2000);                            (* nur zum Lesen der Meldung *)
  166.     END
  167.   ELSE
  168.     BEGIN
  169.       KeineDaten := TRUE;
  170.       GotoXY(promptx,prompty);  ClrEol;  GotoXY(promptx,23);  Invers;
  171.       Write(' Datei fuer ',Monat,' existiert nicht !! ');
  172.       GotoXY(promptx,prompty);  Normal;
  173.       Write(' Weiter mit beliebiger Taste ! ');  Key := Getkey;
  174.     END;
  175.   Close(Datei);
  176. END;
  177. (* ----------------------------------------------------------------------- *)
  178. (*$I HAKAINC.PAS *)
  179. (*$I HAKAJST.PAS *)
  180. BEGIN
  181.   ClrScr;  Initialisieren;  Datum;  Monats_Umwandlung(Mon);
  182.   REPEAT
  183.     mflag := TRUE;
  184.     WHILE mflag DO BEGIN
  185.       Ueberschrift;
  186.       Say(Nmon,1,20,8);    Say(Amon,1,20,10);  Say(Mstat,1,20,12);
  187.       Say(Jstat,1,20,14);  Say(Mwe,7,20,16);   Say(Ende,12,20,18);
  188.       Key := Getkey;
  189.       WHILE NOT(Key IN['N','A','M','E','J','W']) DO
  190.         Key := Error_c(' Bitte nur N, A, M, J, W, E ! ');
  191.       CASE Key OF
  192.         'N': Neuer_Monat;
  193.         'A': Aktueller_Monat;
  194.         'M': Mon_Stat;
  195.         'J': Jahr_Stat;
  196.         'W': BEGIN
  197.                ClrScr;  Invers;
  198.                WriteLn('Bitte den zu bearbeitenden Monat (1..12) eingeben ');
  199.                Write('oder RETURN fuer den aktuellen Monat : ');
  200.                Normal;
  201.                Tag := 1;  Mon := 0;  ReadLn(Mon);
  202.                IF Mon = 0 THEN Datum;
  203.                Monats_Umwandlung(Mon);  ClrScr;  Initialisieren;
  204.              END;
  205.         'E': mflag := FALSE;
  206.       END;
  207.     END;
  208.   UNTIL JaNein('Wollen Sie wirklich aufhoeren ');
  209.   ClrScr;
  210. END.
  211.