Power-Programmierung/CD1.mdf/pascal/library/dos/multtsk/cpmult/demo/glasstty.inc

Text File | 1990-04-07 | 11.2 KB | 431 lines

CONST MaxValues   = 9;   { Maximalanzahl möglicher Auswahlwerte }
      MaxFields   = 5;   { Maximale Feldanzahl }
      MaxCommLen  = 20;  { Maximale Länge einer Feldbezeichnung }
      MaxFieldLen = 30;  { Maximale Länge eines Datums }
      Up          = #72;
      Down        = #80;
      TAB         = #9;
      CR          = #13;
      ESC         = #27;
      BTAB        = #15;
      F1          = #59;
      F2          = #60;
      ExitChars   : SET OF CHAR = [ESC,F1,F2];  { Zeichen, die die Selektions-
                                                  Steuerroutine beenden }
      Ports       : ARRAY[1..2] OF ComType
                  = (Com1,Com2);
      Baudraten   : ARRAY[1..9] OF BaudType
                  = (b110,b150,b300,b600,b1200,b2400,b4800,b9600,b19200);
      Paritaet    : ARRAY[1..5] OF ParityType
                  = (Space,Odd,Mark,Even,None);
      DatenBits   : ARRAY[1..4] OF DataBitsType
                  = (d5,d6,d7,d8);
      StopBits    : ARRAY[1..2] OF StopBitsType
                  = (s1,s2);

TYPE  CommentType = STRING[MaxCommLen];
      ValueType   = STRING[MaxFieldLen];
      Str80       = STRING[80];
      FieldType   = RECORD
                      Zeile   : BYTE;         { Bildschirmzeile }
                      Spalte  : BYTE;         { Beginnn der Feldbezeichnung }
                      Comment : CommentType;  { Feldbezeichnung }
                      BarLen  : BYTE;         { Länge des Farbbalkens }
                      Werte   : BYTE;         { Anzahl wählbarer Werte }
                                              { oder BufLen bei Eingabefeldern }
                      Current : BYTE;         { Index auf aktuellen Wert }
                      Eingabe : BOOLEAN;      { Merker für Eingabefelder }
                      Daten   : ARRAY[1..MaxValues] OF ValueType;
                    END;

VAR   Selection   : BYTE;                     { Nummer der aktuellen Auswahl }
      Selects     : ARRAY[1..MaxFields] OF FieldType;
      SpecialChar : BOOLEAN;                  { Merker für die DoReadKey }

{--------------------------------------------------------------------------}

FUNCTION DoReadKey:Char;

{ Tastatureingabe ohne Blockieren des Multi-Tasking. }

VAR  C : Char;

BEGIN {DoReadKey}
  REPEAT Sleep(1); UNTIL KeyPressed;
  C := ReadKey;
  IF C = #0
     THEN BEGIN
            C := ReadKey;
            SpecialChar := True;
          END
     ELSE SpecialChar := False;
  DoReadKey := C;
END;  {DoReadKey}

{-----------------------------------------------------------------------------}

FUNCTION IsColor:BOOLEAN;

{ Diese Funktion liefert TRUE, falls ein Farbgraphikadapter installiert ist;
  eine Registerstruktur Regs wird benötigt }

BEGIN {IsColor}
  WITH Regs DO
  BEGIN
    AH := 15;
    Intr($10,Regs);
    IsColor := (AL <> 7);
  END;
END;  {IsColor}

{-----------------------------------------------------------------------------}

PROCEDURE CursorOff;

{ Schaltet den Cursor aus; benötigt die Funktion IsColor }

BEGIN {CursorOff}
  WITH Regs DO
  BEGIN
    IF IsColor
       THEN BEGIN
              CH := 9;
              CL := 10;
            END
       ELSE BEGIN
              CH := 31;
              CL := 32;
            END;
    AH := 1;
  END;
  Intr($10,Regs);
END;  {CursorOff}

{-----------------------------------------------------------------------------}

PROCEDURE CursorOn;

{ Erzeugt einen normalen Strich-Cursor aus; benötigt die Funktion IsColor }

BEGIN {CursorOn}
  WITH Regs DO
  BEGIN
    IF IsColor
       THEN BEGIN
              CH := 6;
              CL := 7;
            END
       ELSE BEGIN
              CH := 11;
              CL := 12;
            END;
    AH := 1;
  END;
  Intr($10,Regs);
END;  {CursorOn}

{-----------------------------------------------------------------------------}

PROCEDURE ReverseVideo;

{ Schaltet auf Umkehrdarstellung }

BEGIN {ReverseVideo}
  TextColor(0);
  TextBackground(7);
END;  {ReverseVideo}

{-----------------------------------------------------------------------------}

PROCEDURE DrawBar(SelectNo : BYTE);

{ Erzeugt einen Farbbalken auf der Bezeichnung für Feld SELECTNO }

BEGIN {DrawBar}
  WITH Selects[SelectNo] DO
  BEGIN
    GotoXY(Spalte,Zeile);
    ReverseVideo;
    Write(COPY(Comment,1,BarLen));
    LowVideo;
  END;
END;  {DrawBar}

{-----------------------------------------------------------------------------}

PROCEDURE HighVideo;

BEGIN
  TextColor(15);
  TextBackground(0);
END;

{-----------------------------------------------------------------------------}

PROCEDURE LowVideo;

BEGIN
  TextColor(7);
  TextBackground(0);
END;

{-----------------------------------------------------------------------------}

PROCEDURE RemoveBar(SelectNo : BYTE);

{ Löscht den Farbbalken wieder }

BEGIN {RemoveBar}
  WITH Selects[SelectNo] DO
  BEGIN
    GotoXY(Spalte,Zeile);
    LowVideo;
    Write(COPY(Comment,1,BarLen));
  END;
END;  {RemoveBar}

{-----------------------------------------------------------------------------}

PROCEDURE PrintSelection(SelectNo : BYTE);

{ Ausgabe des aktuell eingestellen Wertes im Feld SELECTNO }

BEGIN {PrintSelection}
  WITH Selects[SelectNo] DO
  BEGIN
    GotoXY(Spalte+BYTE(Comment[0]),Zeile);
    HighVideo;
    Write(Daten[Current]);
    LowVideo;
  END;
END;  {PrintSelection}

{-----------------------------------------------------------------------------}

FUNCTION Replicate(C:CHAR;Count:BYTE):Str80;

{ benötigt eine Typendeklaration Str80:STRING[80] }

VAR   N : BYTE;
      Z : Str80;

BEGIN {Replicate}
  Z[0] := CHR(Count);
  FillChar(Z[1],Count,C);
  Replicate := Z;
END;  {Replicate}

{-----------------------------------------------------------------------------}

PROCEDURE PaddValueArea(SelectNo:BYTE; C:CHAR);

{ Ausfüllen des Wert-Bereiches für das EINGABE-Feld SELECTNO }

BEGIN {PaddValueArea}
  WITH Selects[SelectNo] DO
  BEGIN
    GotoXY(Spalte+BYTE(Comment[0]),Zeile);
    Write(Replicate(C,Werte));
  END;
END;  {PaddValueArea}

{-----------------------------------------------------------------------------}

PROCEDURE DoInput(SelectNo : BYTE);

VAR AuxField : ValueType;

BEGIN {DoInput}
  WITH Selects[SelectNo] DO
  BEGIN
    HighVideo;
    PaddValueArea(SelectNo,'.');
    Current := 1;              {zur Sicherheit}
    GotoXY(Spalte+BYTE(Comment[0]),Zeile);
    CursorOn;
    Read(AuxField);
    CursorOff;
    IF BYTE(AuxField[0]) > 0
       THEN Daten[1] := AuxField;
    PaddValueArea(SelectNo,' ');
    LowVideo;
    PrintSelection(SelectNo);
  END;
END;  {DoInput}

{-----------------------------------------------------------------------------}

PROCEDURE InitSelection;

{ Voreinstellen der Feldparameter; je Programm unterschiedlich und vom User
  bereitzustellen }

BEGIN {InitSelection}
  WITH Selects[1] DO
  BEGIN
    Zeile := 6;
    Spalte := 10;
    Comment := 'Com-Port........:  ';
    BarLen := 17;
    Werte := 2;
    Current := 1;
    Eingabe := FALSE;
    Daten[1] := 'Com1:';
    Daten[2] := 'Com2:';
  END;

  WITH Selects[2] DO
  BEGIN
    Zeile := 7;
    Spalte := 10;
    Comment := 'Übertragungsrate:  ';
    BarLen := 17;
    Werte := 9;
    Current := 8;
    Eingabe := FALSE;
    Daten[1] := '110  ';
    Daten[2] := '150  ';
    Daten[3] := '300  ';
    Daten[4] := '600  ';
    Daten[5] := '1200 ';
    Daten[6] := '2400 ';
    Daten[7] := '4800 ';
    Daten[8] := '9600 ';
    Daten[9] := '19200';
  END;

  WITH Selects[3] DO
  BEGIN
    Zeile := 8;
    Spalte := 10;
    Comment := 'Parität.........:  ';
    BarLen := 17;
    Werte := 5;
    Current := 5;
    Eingabe := FALSE;
    Daten[1] := 'Space';
    Daten[2] := 'Odd  ';
    Daten[3] := 'Mark ';
    Daten[4] := 'Even ';
    Daten[5] := 'None ';
  END;

  WITH Selects[4] DO
  BEGIN
    Zeile := 9;
    Spalte := 10;
    Comment := 'Datenbits.......:  ';
    BarLen := 17;
    Werte := 4;
    Current := 4;
    Eingabe := FALSE;
    Daten[1] := '5';
    Daten[2] := '6';
    Daten[3] := '7';
    Daten[4] := '8';
  END;

  WITH Selects[5] DO
  BEGIN
    Zeile := 10;
    Spalte := 10;
    Comment := 'Stopbits........:  ';
    BarLen := 17;
    Werte := 2;
    Current := 1;
    Eingabe := FALSE;
    Daten[1] := '1';
    Daten[2] := '2';
  END;
END;  {InitSelection}

{-----------------------------------------------------------------------------}

PROCEDURE SetupScreen;

{ Aufbau der Bildschirmmaske; vom User bereitszustellen }

BEGIN {SetupScreen}
  ClrScr;
  GotoXY(15,1);
  Writeln('GlassTty V1.00 (c) Ch. Philipps im März 1989');
  GotoXY(15,2);
  Writeln('============================================');
  FOR Selection := 1 TO MaxFields DO
  BEGIN
    RemoveBar(Selection);
    PrintSelection(Selection);
  END;
  GotoXY(12,21);
  Writeln('Selection der Eingabefelder mit TAB und BACKTAB;');
  GotoXY(12,22);
  Writeln('Auswahl der möglichen Parameter mittels der Cursortasten');
  GotoXY(20,24);
  HighVideo;
  Writeln('F1 = Terminal-Mode  /  ESC = Ende');
END;  {SetupScreen}

{-----------------------------------------------------------------------------}

FUNCTION DoSelect(Start:BYTE):CHAR;

{ Beginnt mit der Abarbeitung der Selektionsmaske beim Feld START und liefert
  die Ende-Taste (CR oder ESC) zurück. }

VAR   C : CHAR;

BEGIN {DoSelect}
  IF Start IN [1..MaxFields]
     THEN Selection := Start
     ELSE Selection := 1;
  CursorOff;
  DrawBar(Selection);
  REPEAT
    C := DoReadKey;
    IF SpecialChar
       THEN CASE C OF
            BTAB: BEGIN
                    RemoveBar(Selection);
                    Selection := PRED(Selection);
                    IF Selection < 1
                       THEN Selection := MaxFields;
                    DrawBar(Selection);
                  END;
            Up:   WITH Selects[Selection] DO
                  IF Eingabe
                     THEN DoInput(selection)
                     ELSE WITH Selects[Selection] DO
                          BEGIN
                            Current := PRED(Current);
                            IF NOT (Current IN [1..Werte])
                               THEN Current := Werte;
                            IF Werte > 1
                               THEN PrintSelection(Selection);
                          END;
            Down: WITH Selects[Selection] DO
                  IF Eingabe
                     THEN DoInput(selection)
                     ELSE WITH Selects[Selection] DO
                          BEGIN
                            Current := SUCC(Current);
                            IF NOT (Current IN [1..Werte])
                               THEN Current := 1;
                            IF Werte > 1
                               THEN PrintSelection(Selection);
                          END;
            END
       ELSE CASE C OF
             TAB: BEGIN
                    RemoveBar(Selection);
                    Selection := SUCC(Selection);
                    IF Selection > MaxFields
                       THEN Selection := 1;
                    DrawBar(Selection);
                  END;
            END;
  UNTIL C IN ExitChars;
  CursorOn;
  DoSelect := C;
END;  {DoSelect}