Turbo Toolbox/Turbo_Toolbox.iso/1989/09/tricks/zwandler.pas

Pascal/Delphi Source File | 1989-06-15 | 5.6 KB | 211 lines

(* ------------------------------------------------------ *)
(*                     ZWANDLER.PAS                       *)
(*  Programm, das Zahlen zur  Basis 2, 3,..., 16 beliebig *)
(*  ineinander umrechnet                                  *)
(*  Eingabesysntax : <BASIS 1> <ZIFFERN> <BASIS 2>        *)
(*                                                        *)
(*         (c) 1989 Erich Cadario  &  TOOLBOX             *)
(* ------------------------------------------------------ *)
PROGRAM Zahlenwandler;

TYPE
  SStrg  = STRING[255];
  Menge  = SET OF CHAR;

VAR
  Bezeichner, Ausdruck, Zahl, z  : SStrg;
  ok                             : BOOLEAN;
  Position, Lauf, x, Loop, h     : INTEGER;
  m1, m2, m3, m4, m5, m6, m7, zm : Menge;
  Basis1, Basis2, Help, w        : REAL;
  a                              : ARRAY [0..80] OF INTEGER;
  c                              : CHAR;

  PROCEDURE XWert2;
   { zum Überbrücken von Blanks zwischen Basis und Ziffern }
  BEGIN
    x := Ord(Ausdruck[Position]);
    WHILE (x=32) AND (Position < Length(Ausdruck)) DO BEGIN
      Position := Position + 1;
      x := Ord(Ausdruck[Position]);
    END;
  END;

  PROCEDURE Bezei(m : Menge);
               { zur Analyse der eingelesenen Zeichenkette }
  BEGIN
    XWert2;
    Bezeichner := '';
    x := Ord(Ausdruck[Position]);
    WHILE Chr(x) IN m DO BEGIN
      Bezeichner := Bezeichner + Chr(x);
      Position   := Position + 1;
      Lauf       := Lauf + 1;
      x := Ord(Ausdruck[Position]);
    END;
  END;

  PROCEDURE Eingabe;
  VAR
    i : INTEGER;
  BEGIN
    FOR i := 1 TO 255 DO BEGIN
      Ausdruck[i]   := ' ';
      Zahl[i]       := ' ';
      z[i]          := ' ';
      Bezeichner[i] := ' ';
    END;
    Ausdruck   := '';
    z          := '';
    Bezeichner := '';
    Zahl       := '';
    WriteLn('Bitte den Ausdruck eingeben');
    ReadLn(Ausdruck);
  END;

  PROCEDURE Zahlenwert(VAR Basis : REAL);
 { Bestimmung der eingegebenen Basis und der Ziffernmenge, }
 { die bei dieser Basis erlaubt ist                        }
  VAR
    q : INTEGER;
  BEGIN
    Val(Bezeichner, Basis, h);
    q := Trunc(Basis);
    CASE q OF
      2..9 : ;
      10   : zm := m1;
      11   : zm := m2;
      12   : zm := m3;
      13   : zm := m4;
      14   : zm := m5;
      15   : zm := m6;
      16   : zm := m7
    ELSE
      ok := FALSE;
    END;
  END;

  PROCEDURE Number;         { Bestimmung der zweiten Basis }
  BEGIN
    Bezei(m1);
    Val(Bezeichner, Basis2, h);
    IF (Basis2 < 2) OR (Basis2 > 16) THEN ok := FALSE;
  END;

  PROCEDURE Base;    { Bestimmung der eingegebenen Ziffern }
  BEGIN
    Lauf := 0;
    IF Basis1 < 11 THEN BEGIN
      XWert2;
      Bezeichner := '';
      x          := Ord(Ausdruck[Position]);
      WHILE (x < Basis1 + 48) AND (Chr(x) IN m1) DO BEGIN
        Bezeichner := Bezeichner + Chr(x);
        Lauf       := Lauf + 1;
        Position   := Position + 1;
        x          := Ord(Ausdruck[Position]);
      END;
      IF (Lauf > 80) OR (Lauf = 0) OR (x <> 32) THEN
        ok := FALSE;
      Zahl := Bezeichner;
      IF ok = TRUE THEN Number;
    END ELSE BEGIN
      Bezei(zm);
      IF (Lauf > 80) OR (Lauf = 0) OR (x <> 32) THEN
        ok := FALSE;
      Zahl := Bezeichner;
      IF ok = TRUE THEN Number;
    END;
  END;

  PROCEDURE Zifferfilter;
            { Dezimalwerte der einzelnen Ziffern bestimmen }
  BEGIN
    FOR Loop := 0 TO Length(Zahl)-1 DO BEGIN
      c := Zahl[Length(Zahl)-Loop];
      CASE Ord(c) OF
        48..57  : a[Loop] := Ord(c) - 48;
        65..70  : a[Loop] := Ord(c) - 55;
        97..102 : a[Loop] := Ord(c) - 87;
      ELSE;
      END;
    END;
  END;

  FUNCTION in10er : REAL;      { Umwandeln ins 10er System }
  VAR
    Laenge, Loop : INTEGER;
    Wert         : REAL;
  BEGIN
    Laenge := Length(Zahl);
    Wert   := a[Laenge-1];
    FOR Loop := Laenge-1 DOWNTO 1 DO
      Wert := a[Loop-1] + Wert * Basis1;
    in10er := Wert;
  END;

  PROCEDURE inBasis2er(VAR Wert : REAL);
             { Umwandlung ins eingegebene System (Basis 2) }
  VAR
    Loop              : INTEGER;
    Rest, Hilf, Hilf1 : REAL;
  BEGIN
    Hilf := Int(Wert/Basis2);
    Rest := Wert - Hilf * Basis2;
    Wert := Hilf;
    Loop := Trunc(Rest);
    CASE Loop OF
      0..9   : z := z + Chr(Loop + 48);
      10..15 : z := z + Chr(Loop + 55)
    ELSE;
    END;
    IF Wert <> 0 THEN inBasis2er(Wert);
  END;

BEGIN
  m1 := ['0'..'9'];
  m2 := m1 + ['A', 'a'];
  m3 := m2 + ['B', 'b'];
  m4 := m3 + ['C', 'c'];
  m5 := m4 + ['D', 'd'];
  m6 := m5 + ['E', 'e'];
  m7 := m6 + ['F', 'f'];
  REPEAT
    Eingabe;
    IF (Ausdruck <> 'x') AND (Ausdruck <> 'X') THEN BEGIN
      Position := 1;
      Lauf     := 0;
      ok       := TRUE;
      Basis1   := 0;
      Basis2   := 0;
      XWert2;
      CASE x OF
        48..57 : BEGIN
                   Bezei(m1);
                   Zahlenwert(Basis1);
                   IF ok = TRUE THEN Base;
                 END;
      ELSE ok := FALSE;
      END;
      IF ok = TRUE THEN BEGIN
        Zifferfilter;
        Help := in10er;
        w    := Help;
        inBasis2er(Help);
        IF w >= 1.0E+10 THEN
          WriteLn('ZU GROSS', ^G)
        ELSE BEGIN
          WriteLn('Im 10er: ', w);  WriteLn;
          FOR Lauf := Length(z) DOWNTO 1 DO
            Write(z[Lauf]);
          WriteLn;  WriteLn;
        END;
      END ELSE WriteLn(^G);
    END;
  UNTIL (Ausdruck = 'x') OR (Ausdruck = 'X');
end.
(* ------------------------------------------------------ *)
(*                Ende von ZWANDLER.PAS                   *)