Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FORUM25C.ZIP/FRMSTF.PAS

Pascal/Delphi Source File | 1989-02-04 | 5.3 KB | 207 lines

{=============================================================================}

TYPE CharSetType = Set Of Char;

Procedure BuildCharSet(VAR CharSet : CharSetType; Choices : String);
VAR Index   : INTEGER;
    NeedSys : BOOLEAN;
Begin
  CharSet := [];
  Index := 1;
  While Index <= Length(Choices) DO
    Begin
      NeedSys:=false;
      If Index < length(choices) THEN
        If choices[Index+1] = '@' then needsys := TRUE;
      If Needsys AND (Not ISsysop) THEN
            NeedSys := FALSE
      Else
        Begin
          CharSet := CharSet + [UpCase(Choices[Index])];
          Inc(Index);
          If needsys THEN Inc(Index);
        End
    End;
   CharSet := CharSet + ['>','?'];
End;

{=============================================================================}

Function Response(ChoiceList : String) : CHAR;
VAR ChoiceSet : CharSetType;
    UsrKey    : CHAR;
Begin
  InGetStr:=true;
  BuildCharSet(ChoiceSet,ChoiceList);
  LineCount := 1;
  NoChain := TRUE;
{  Ch;   }
  REPEAT
     ClearBreak;
     Nobreak := TRUE;
     UsrKey := GetInputChar;
  If UsrKey = #13 THEN UsrKey := '_';
  UNTIL (UpCase(UsrKey) IN ChoiceSet) OR (HungUpon);
  UsrKey := UpCase(UsrKey);
  If Not HungUpon THEN Writeln(UsrKey);
  Input := UsrKey;
  Response := UsrKey;
  InGetStr := FALSE;
End;

{=============================================================================}

Procedure Center(CenterString : String; ScreenWidth : BYTE);
Begin
  Tab('',Trunc((Trunc(ScreenWidth/2))-(Length(CenterString)/2)));
  Writeln(CenterString);
End;

{=============================================================================}

Procedure WaitReturn;
VAR Pause : CHAR;
Begin
  WriteStr('Press [RETURN]:;');
  LastPrompt := 'Press [RETURN]:';
  REPEAT
    Pause := GetInputChar;
  UNTIL (Pause IN [^M]) OR (HungUpon);

  Write(^H' '^H^H' '^H^H' '^H^H' '^H^H' '^H' '^H^H' '^H^H' '^H^H' ');
  Write(^H^H' '^H^H' '^H^H' '^H^H' '^H^H' '^H^H' '^H^H' ');
  Writeln;
End;

{=============================================================================}

Procedure TopOfBox(ScreenWidth : BYTE);
VAR Index : BYTE;
Begin
  IF ASCIIGraphics in URec.Config THEN
    Begin
      Write('┌');
      For Index := 1 to ScreenWidth - 3 DO
        Write('─');
      Writeln('┐');
    End
  ELSE
    Begin
      Write(' ');
      For Index := 2 TO ScreenWidth-2 DO
        Write('-');
      Writeln;
    End;
End;

{=============================================================================}

Procedure BoxText(StringBox : String78; ScreenWidth : BYTE;
                  AllignMent : AllignTypes);
Begin
 If ASCIIGraphics in URec.Config THEN
   Begin
    Write('│');
    CASE AllignMent Of
     Middle : Begin
                Tab('',Trunc((ScreenWidth/2)-(Length(StringBox)/2))-2);
                Write(StringBox);
                Tab('',ScreenWidth-(Trunc((ScreenWidth/2)-(Length(StringBox)/2))+Length(StringBox))-1);
              End;
     Left   : Begin
                Write(' ',StringBox);
                Tab('',ScreenWidth-Length(StringBox)-4);
              End;
     Right  : Begin
                Tab('',ScreenWidth-Length(StringBox)-4);
                Write(StringBox,' ');
              End;
     End;
     Writeln('│');
   End
 ELSE
   Begin
     Write('|');
     CASE AllignMent Of
     Middle : Begin
                Tab('',Trunc((ScreenWidth/2)-(Length(StringBox)/2))-2);
                Write(StringBox);
                Tab('',ScreenWidth-(Trunc((ScreenWidth/2)-(Length(StringBox)/2))+Length(StringBox))-1);
              End;
     Left   : Begin
                Write(' ',StringBox);
                Tab('',ScreenWidth-Length(StringBox)-4);
              End;
     Right  : Begin
                Tab('',ScreenWidth-Length(StringBox)-4);
                Write(StringBox,' ');
              End;
     End;
     Writeln('|');
   End;
End;

{=============================================================================}

Procedure MiddleBar(ScreenWidth : BYTE);
VAR Index : BYTE;
Begin
  IF ASCIIGraphics in URec.Config THEN
    Begin
     Write('├');
     For Index := 1 to ScreenWidth - 3 DO
     Write('─');
     Writeln('┤');
    End
  ELSE
    Begin
      Write('|');
      For Index := 1 TO ScreenWidth-3 DO
        Write('-');
      Writeln('|');
    End;
End;

{=============================================================================}

Procedure BottomOfBox(ScreenWidth : BYTE);
VAR Index : BYTE;
Begin
  IF ASCIIGraphics in URec.Config THEN
    Begin
     Write('└');
     For Index := 1 to ScreenWidth - 3 DO
     Write('─');
     Writeln('┘');
     Writeln;
    End
  ELSE
    Begin
      Write(' ');
      For Index := 2 TO ScreenWidth-2 DO
        Write('-');
      Writeln;
    End;
End;

{=============================================================================}

Procedure BoxString(StringBox : String80; Size : BYTE);
VAR Index : BYTE;
Begin
  TopOfBox(Size);
  BoxText(StringBox,Size,Middle);
  BottomOfBox(Size);
End;

{=============================================================================}

Function WidthScreen : BYTE;
Begin
  If EightyCols in URec.Config THEN WidthScreen := 80
    ELSE
      WidthScreen := 40;
End;

{=============================================================================}