home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 01 / haka / hakainc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-27  |  8.6 KB  |  209 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                             HAKAINC.PAS                                 *)
  3. PROCEDURE Guthaben;
  4. BEGIN
  5.    GotoXY(23,2);  ClrEol;  Invers;
  6.    Write(' Guthaben : ',Guth:4:2,' DM ');  Normal;
  7. END;
  8. (* ----------------------------------------------------------------------- *)
  9. PROCEDURE Eingabe (was : Stringtyp);
  10. CONST Fehlerton = ^G;                   (* ASCII Zeichen 'Bell' : CONTRL-G *)
  11. VAR    y, kontroll: INTEGER;
  12.        Preis      : REAL;
  13.        Eingabe    : STRING[10];
  14. BEGIN
  15.   Summe := 0;  y := 4;  ClrScr;
  16.   GotoXY(9,1);  ClrEol;  GotoXY(9,1);  Invers;
  17.   Write(Blank,'Eingabe : ',was,' fuer Monat : ',Monat,Blank);  Normal;
  18.   Guthaben;  GotoXY(promptx-6,prompty);  Invers;
  19.   Write(' Eingabe ',was,' beenden mit RETURN !');  Normal;
  20.   REPEAT
  21.     GotoXY(15,y);  Write(y-3:2,' ........ : ');  Preis := 0;
  22.     REPEAT        (* Eingabe ueberpruefen, es wird Punkt und Komma erkannt *)
  23.       ReadLn(Eingabe);
  24.       WHILE Pos(' ',Eingabe) > 0 DO      (* loesche Leerzeichen in Eingabe *)
  25.         Delete(Eingabe, Pos(' ',Eingabe), 1);
  26.       IF Pos(',', Eingabe) > 0 THEN               (* ersetze ',' durch '.' *)
  27.         Eingabe[Pos(',', Eingabe)] := '.';
  28.       Val(Eingabe,Preis,kontroll);      (* wandle Eingabestring in Zahl um *)
  29.       IF kontroll > 0 THEN BEGIN (* Eingabe ist keine korrekte Dezimalzahl *)
  30.         Write(Fehlerton);  Pause(200);  Write(Fehlerton);  Pause(1000);
  31.         GotoXY(29,y);  ClrEol;
  32.       END;
  33.     UNTIL kontroll = 0;
  34.     Summe := Summe + Preis;
  35.     Guth  := Guth  - Preis;         (* Guthaben aktualisieren und anzeigen *)
  36.     Guthaben;  y := Succ(y);
  37.   UNTIL (y = 19) OR (Preis = 0);
  38.   ClrScr;
  39. END;
  40. (* ----------------------------------------------------------------------- *)
  41. PROCEDURE Einlesen;
  42. BEGIN
  43.   key := GetKey;
  44.   WHILE NOT(key IN ['L','T','I','A','P','K','W','B','F','D','H']) DO
  45.     key := Error_c('Falsche Eingabe !');
  46.   WITH Liste DO
  47.     CASE key OF
  48.       'L' : BEGIN
  49.               Eingabe('Lebensmittel');  SummeL := SummeL+Summe;
  50.             END;
  51.       'T' : BEGIN
  52.               Eingabe('Toilettenartikel');  SummeT := SummeT+Summe;
  53.             END;
  54.       'I' : BEGIN
  55.               Eingabe('Literatur');  SummeLit := SummeLit+Summe;
  56.             END;
  57.       'A' : BEGIN
  58.               Eingabe('Auto');  SummeKfz := SummeKfz+Summe;
  59.             END;
  60.       'P' : BEGIN
  61.               Eingabe('Post');  SummePost := SummePost+Summe;
  62.             END;
  63.       'K' : BEGIN
  64.               Eingabe('Kleidung');  SummeKleid := SummeKleid+Summe;
  65.             END;
  66.       'W' : BEGIN
  67.               Eingabe('Wohnung');  SummeWoh := SummeWoh+Summe;
  68.             END;
  69.       'B' : BEGIN
  70.               Eingabe('Bueroartikel');  SummeBuro := SummeBuro+Summe;
  71.             END;
  72.       'F' : BEGIN
  73.               Eingabe('Freizeit/Hobby');  SummeFrei := SummeFrei+Summe;
  74.             END;
  75.       'D' : BEGIN
  76.               Eingabe('Diverses');  SummeDiv := SummeDiv+Summe;
  77.             END;
  78.       'H' : mflag1 := FALSE;
  79.     END; (* Case *)
  80. END;
  81. (* ----------------------------------------------------------------------- *)
  82. PROCEDURE Schleife;
  83. BEGIN
  84.   REPEAT
  85.     mflag1 := TRUE;
  86.     WHILE mflag1 DO BEGIN
  87.       Guthaben;  GotoXY(15,4);
  88.       Write('Welche Daten sollen erfasst werden : ');
  89.       Say('Lebensmittel',1,20,6);        Say('Toilettenartikel',1,20,7);
  90.       Say('LIteratur',2,20,8);           Say('Auto',1,20,9);
  91.       Say('Post',1,20,10);               Say('Kleidung',1,20,11);
  92.       Say('Wohnung',1,20,12);            Say('Bueroartikel',1,20,13);
  93.       Say('Freizeit/Hobby',1,20,14);     Say('Diverses',1,20,15);
  94.       Say('Zum Hauptmenue',5,20,17);
  95.       Einlesen;
  96.     END;
  97.   UNTIL JaNein(' Sind Sie wirklich fertig ');
  98.   Liste.Guthaben := Guth;  ClrScr;  Daten_Speichern;  Ueberschrift;
  99. END;
  100. (* ----------------------------------------------------------------------- *)
  101. PROCEDURE Neuer_Monat;
  102. BEGIN
  103.   ClrScr;  Ext := Copy(Monat,1,3);
  104.   Assign(Datei,'HAKA'+'.'+Ext);  (* Ueberpruefen ob Datei schon existiert: *)
  105.   (*$I-*)  ReSet(Datei);  (*$I+*)           (* Datei zum Lesen vorbereiten *)
  106.   Fehler := IOResult;
  107.   IF Fehler = 1 THEN
  108.     BEGIN
  109.       GotoXY(9,1);  Invers;
  110.       Write(Blank,Blank,Nmon,Blank,Tag,'.',Monat,' ',Jahr,Blank);
  111.       GotoXY(9,10);
  112.       Write(Blank,'Bitte geben Sie Ihr aktuelles Guthaben ',Blank);
  113.       GotoXY(9,11);
  114.       Write(Blank,'am Monatsanfang ein : ');Normal;
  115.       ReadLn(Guth);  Liste.Guthaben_MonAnfang := Guth;
  116.       GotoXY(9,10);  ClrEol;  GotoXY(9,11);  ClrEol;
  117.       Guthaben;
  118.       Schleife;
  119.     END
  120.   ELSE
  121.     BEGIN
  122.       ClrScr;  GotoXY(promptx,prompty-2);
  123.       Write('Achtung : Datei fuer ',Monat,' existiert schon !!');
  124.       GotoXY(promptx,prompty-1);
  125.       Write('Bitte mit AKTUELLEM Monat weitermachen !');
  126.       GotoXY(promptx,prompty);  Write('Beliebige Taste druecken . . . . .');
  127.       key := GetKey;
  128.     END;
  129. END;
  130. (* ----------------------------------------------------------------------- *)
  131. PROCEDURE Aktueller_Monat;          (* Daten des laufenden Monats erfassen *)
  132. VAR  Eink : REAL;
  133. BEGIN
  134.   Eink := 0;  Fehler := 0;  ClrScr;  Daten_Lesen;  ClrScr;
  135.   IF Fehler = 0 THEN BEGIN
  136.     GotoXY(9,1);  Invers;
  137.     Write(Blank,Amon,Blank,Tag,'.',Monat,' ',Jahr,Blank);
  138.     GotoXY(9,10);
  139.     Write(Blank,'Hatten Sie Einkuenfte in diesem Monat ?',Blank);
  140.     GotoXY(9,11);
  141.     Write(' wenn ja, wieviel ? ( sonst RETURN ) : ');  Normal;
  142.     ReadLn(Eink);
  143.     Liste.Einkommen := Liste.Einkommen + Eink;
  144.     Guth := Liste.Guthaben + Eink;
  145.     GotoXY(9,10);  ClrEol;  GotoXY(9,11);  ClrEol;  GotoXY(23,2);  Invers;
  146.     WriteLn(' Guthaben : ',Guth:4:2,' DM ');  Normal;
  147.     Schleife;
  148.   END;
  149. END;
  150. (* ----------------------------------------------------------------------- *)
  151. PROCEDURE Mon_Stat;                                    (* Monats-Statistik *)
  152. VAR  ch : CHAR;   dev : TEXT;
  153. BEGIN
  154.   ClrScr;  GotoXY(9,1);  LowVideo;
  155.   Write('Ausgabe auf Drucker ');  NormVideo;  Write(' (D)');  LowVideo;
  156.   Write(' oder Bildschirm ');  NormVideo;  Write(' (B)');  LowVideo;
  157.   Write(' ? : ');  NormVideo;
  158.   Read(Kbd,ch);                  (* von Tastatur ohne Bildschirmecho lesen *)
  159.   ch := UpCase(ch);
  160.   IF ch = 'D' THEN                       (* Ausgabe auf den Drucker        *)
  161.     BEGIN Assign(dev,'LST:'); WriteLn(dev); WriteLn(dev); END
  162.   ELSE Assign(dev,'CON:');               (* oder auf den Bildschirm leiten *)
  163.   GotoXY(9,1);  ClrEol;  Daten_Lesen;  ClrScr;
  164.   IF NOT KeineDaten THEN BEGIN
  165.     GotoXY(0,0);  WriteLn(dev,Blank,Blank,Mstat,'  fuer : ',Monat,' ',Jahr);
  166.     WriteLn(dev,underline);  WriteLn(dev);
  167.     WriteLn(dev,'Ihr Guthaben am Monatsanfang betrug        : ',
  168.                 Liste.Guthaben_MonAnfang:8:2,' DM');
  169.     IF Liste.Einkommen <> 0 THEN
  170.       WriteLn(dev,'Einkuenfte in diesem Monat                 : ',
  171.                   Liste.Einkommen:8:2,' DM')
  172.     ELSE WriteLn(dev);
  173.     WriteLn(dev);
  174.     WriteLn(dev,'Davon haben Sie ausgegeben ');  WriteLn(dev);
  175.     WriteLn(dev,'     fuer Lebensmittel                     : ',
  176.                 Liste.SummeL:8:2,' DM');
  177.     WriteLn(dev,'          Toilettenartikel                 : ',
  178.                 Liste.SummeT:8:2,' DM');
  179.     WriteLn(dev,'          Literatur                        : ',
  180.                 Liste.SummeLit:8:2,' DM');
  181.     WriteLn(dev,'          Auto                             : ',
  182.                 Liste.SummeKfz:8:2,' DM');
  183.     WriteLn(dev,'          Post                             : ',
  184.                 Liste.SummePost:8:2,' DM');
  185.     WriteLn(dev,'          Kleidung                         : ',
  186.                 Liste.SummeKleid:8:2,' DM');
  187.     WriteLn(dev,'          Wohnung                          : ',
  188.                 Liste.SummeWoh:8:2,' DM');
  189.     WriteLn(dev,'          Bueroartikel                     : ',
  190.                 Liste.SummeBuro:8:2,' DM');
  191.     WriteLn(dev,'          Freizeit/Hobby                   : ',
  192.                 Liste.SummeFrei:8:2,' DM');
  193.     WriteLn(dev,'          Diverses                         : ',
  194.                 Liste.SummeDiv:8:2,' DM');
  195.     WriteLn(dev);  WriteLn(dev,underline);
  196.     WriteLn(dev,'===> Ihr Guthaben am Monatsende            : ',
  197.                 Liste.Guthaben:8:2,' DM');
  198.     WriteLn(dev,
  199.          '                                             ============= ');
  200.     WriteLn(dev);
  201.     Datum;
  202.     WriteLn(dev,'Ausdruckdatum : ',Tag,'.',Mon,'.',Jahr);
  203.     GotoXY(promptx,prompty);  Write(Con,' Weiter mit beliebiger Taste ! ');
  204.     key := GetKey;  ClrScr;
  205.   END;
  206. END;
  207. (* ----------------------------------------------------------------------- *)
  208. (*                             HAKAINC.PAS                                 *)
  209.