mysticbbs/mdl/m_menuinput.pas

{$I M_OPS.PAS}

Unit m_MenuInput;

Interface

Uses
  m_Strings,
  m_Input,
  m_Output;

Type
  TMenuInput = Class
  Private
    Console  : TOutput;
  Public
    Key      : TInput;
    HiChars  : String;
    LoChars  : String;
    ExitCode : Char;
    Attr     : Byte;
    FillChar : Char;
    FillAttr : Byte;
    Changed  : Boolean;

    Constructor Create (Var Screen: TOutput);
    Destructor  Destroy; Override;
    Function    GetStr (X, Y, Field, Len, Mode: Byte; Default: String) : String;
    Function    GetNum (X, Y, Field, Len: Byte; Min, Max, Default: LongInt) : LongInt;
    Function    GetChar (X, Y : Byte; Default: Char) : Char;
    Function    GetEnter (X, Y, Len: Byte; Default : String) : Boolean;
    Function    GetYN (X, Y : Byte; Default: Boolean) : Boolean;

    Function    KeyWaiting : Boolean;
    Function    ReadKey : Char;
  End;

Implementation

Constructor TMenuInput.Create (Var Screen: TOutput);
Begin
  Inherited Create;

  Console  := Screen;
  Key      := TInput.Create;
  LoChars  := #13;
  HiChars  := '';
  Attr     := 15 + 1 * 16;
  FillAttr := 7  + 1 * 16;
  FillChar := '°';
  Changed  := False;
End;

Destructor TMenuInput.Destroy;
Begin
  Key.Free;

  Inherited Destroy;
End;

Function TMenuInput.GetYN (X, Y : Byte; Default: Boolean) : Boolean;
Var
  Ch  : Char;
  Res : Boolean;
  YS  : Array[False..True] of String[3] = ('No ', 'Yes');
Begin
  ExitCode := #0;
  Changed  := False;

  Console.CursorXY (X, Y);

  Res := Default;

  Repeat
    Console.WriteXY (X, Y, Attr, YS[Res]);

    Ch := ReadKey;
    Case Ch of
      #00 : Begin
              Ch := ReadKey;
              If Pos(Ch, HiChars) > 0 Then Begin
                ExitCode := Ch;
                Break;
              End;
            End;
      #13,
      #32 : Res := Not Res;
    Else
      If Pos(Ch, LoChars) > 0 Then Begin
        ExitCode := Ch;
        Break;
      End;
    End;
  Until False;

  Changed := (Res <> Default);
  GetYN   := Res;
End;

Function TMenuInput.GetChar (X, Y : Byte; Default: Char) : Char;
Var
  Ch  : Char;
  Res : Char;
Begin
  ExitCode := #0;
  Changed  := False;
  Res      := Default;

  Console.CursorXY (X, Y);

  Repeat
    Console.WriteXY (X, Y, Attr, Res);

    Ch := ReadKey;

    Case Ch of
      #00 : Begin
              Ch := ReadKey;
              If Pos(Ch, HiChars) > 0 Then Begin
                ExitCode := Ch;
                Break;
              End;
            End;
    Else
      If Ch = #27 Then Res := Default;

      If Pos(Ch, LoChars) > 0 Then Begin
        ExitCode := Ch;
        Break;
      End;

      If Ord(Ch) > 31 Then Res := Ch;
    End;
  Until False;

  GetChar := Res;
End;

Function TMenuInput.GetEnter (X, Y, Len: Byte; Default : String) : Boolean;
Var
  Ch  : Char;
  Res : Boolean;
Begin
  ExitCode := #0;
  Changed  := False;

  Console.WriteXY (X, Y, Attr, strPadR(Default, Len, ' '));
  Console.CursorXY (X, Y);

  Repeat
    Ch  := ReadKey;
    Res := Ch = #13;
    Case Ch of
      #00 : Begin
              Ch := ReadKey;
              If Pos(Ch, HiChars) > 0 Then Begin
                ExitCode := Ch;
                Break;
              End;
            End;
      Else
        If Pos(Ch, LoChars) > 0 Then Begin
          ExitCode := Ch;
          Break;
        End;
    End;
  Until Res;

  Changed  := Res;
  GetEnter := Res;
End;

Function TMenuInput.GetStr (X, Y, Field, Len, Mode : Byte; Default : String) : String;
{ mode options:      }
{   0 = numbers only }
{   1 = as typed     }
{   2 = all caps     }
{   3 = date input   }
Var
  Ch     : Char;
  Str    : String;
  StrPos : Integer;
  Junk   : Integer;
  CurPos : Integer;

  Procedure ReDraw;
  Var
    T : String;
  Begin
    T := Copy(Str, Junk, Field);

    Console.WriteXY  (X, Y, Attr, T);
    Console.WriteXY  (X + Length(T), Y, FillAttr, strRep(FillChar, Field - Length(T)));
    Console.CursorXY (X + CurPos - 1, Console.CursorY);
  End;

  Procedure ReDrawPart;
  Var
    T : String;
  Begin
    T := Copy(Str, StrPos, Field - CurPos + 1);

    Console.WriteXY  (Console.CursorX, Y, Attr, T);
    Console.WriteXY  (Console.CursorX + Length(T), Y, FillAttr, strRep(FillChar, (Field - CurPos + 1) - Length(T)));
    Console.CursorXY (X + CurPos - 1, Y);
  End;

  Procedure ScrollRight;
  Begin
    Inc (Junk);
    If Junk > Length(Str) Then Junk := Length(Str);
    If Junk > Len then Junk := Len;
    CurPos := StrPos - Junk + 1;
    ReDraw;
  End;

  Procedure ScrollLeft;
  Begin
    If Junk > 1 Then Begin
      Dec (Junk);
      CurPos := StrPos - Junk + 1;
      ReDraw;
    End;
  End;

  Procedure Add_Char (Ch : Char);
  Begin
    If Length(Str) >= Len Then Exit;

    If (CurPos >= Field) and (Field <> Len) Then ScrollRight;

    Insert (Ch, Str, StrPos);
    If StrPos < Length(Str) Then ReDrawPart;

    Inc (StrPos);
    Inc (CurPos);

    Console.WriteXY  (Console.CursorX, Console.CursorY, Attr, Ch);
    Console.CursorXY (Console.CursorX + 1, Console.CursorY);
  End;

Begin
  Changed := False;
  Str     := Default;
  StrPos  := Length(Str) + 1;
  Junk    := Length(Str) - Field + 1;

  If Junk < 1 Then Junk := 1;

  CurPos  := StrPos - Junk + 1;

  Console.CursorXY (X, Y);
  Console.TextAttr := Attr;

  ReDraw;

  Repeat
    Ch := Key.ReadKey;

    Case Ch of
      #00 : Begin
              Ch := Key.ReadKey;

              Case Ch of
                #77 : If StrPos < Length(Str) + 1 Then Begin
                        If (CurPos = Field) and (StrPos < Length(Str)) Then ScrollRight;
                        Inc (CurPos);
                        Inc (StrPos);
                        Console.CursorXY (Console.CursorX + 1, Console.CursorY);
                      End;
                #75 : If StrPos > 1 Then Begin
                        If CurPos = 1 Then ScrollLeft;
                        Dec (StrPos);
                        Dec (CurPos);
                        Console.CursorXY (Console.CursorX - 1, Console.CursorY);
                      End;
                #71 : If StrPos > 1 Then Begin
                        StrPos := 1;
                        Junk   := 1;
                        CurPos := 1;
                        ReDraw;
                      End;
                #79 : Begin
                        StrPos := Length(Str) + 1;
                        Junk   := Length(Str) - Field + 1;
                        If Junk < 1 Then Junk := 1;
                        CurPos := StrPos - Junk + 1;
                        ReDraw;
                      End;
                #83 : If (StrPos <= Length(Str)) and (Length(Str) > 0) Then Begin
                        Delete (Str, StrPos, 1);
                        ReDrawPart;
                      End;
                #115: Begin
                        If (StrPos > 1) and (Str[StrPos] = ' ') or (Str[StrPos - 1] = ' ') Then Begin
                          If CurPos = 1 Then ScrollLeft;
                          Dec(StrPos);
                          Dec(CurPos);

                          While (StrPos > 1) and (Str[StrPos] = ' ') Do Begin
                            If CurPos = 1 Then ScrollLeft;
                            Dec(StrPos);
                            Dec(CurPos);
                          End;
                        End;

                        While (StrPos > 1) and (Str[StrPos] <> ' ') Do Begin
                          If CurPos = 1 Then ScrollLeft;
                          Dec(StrPos);
                          Dec(CurPos);
                        End;

                        While (StrPos > 1) and (Str[StrPos] <> ' ') Do Begin
                          If CurPos = 1 Then ScrollLeft;
                          Dec(StrPos);
                          Dec(CurPos);
                        End;

                        If (Str[StrPos] = ' ') and (StrPos > 1) Then Begin
                          Inc(StrPos);
                          Inc(CurPos);
                        End;

                        ReDraw;
                      End;
                #116: Begin
                        While StrPos < Length(Str) + 1 Do Begin
                          If (CurPos = Field) and (StrPos < Length(Str)) Then ScrollRight;
                          Inc (CurPos);
                          Inc (StrPos);

                          If Str[StrPos] = ' ' Then Begin
                            If StrPos < Length(Str) + 1 Then Begin
                              If (CurPos = Field) and (StrPos < Length(Str)) Then ScrollRight;
                              Inc (CurPos);
                              Inc (StrPos);
                            End;
                            Break;
                          End;
                        End;
                        Console.CursorXY (X + CurPos - 1, Y);
                      End;
              Else
                If Pos(Ch, HiChars) > 0 Then Begin
                  ExitCode := Ch;
                  Break;
                End;
              End;
            End;
      #08 : If StrPos > 1 Then Begin
              Dec (StrPos);
              Delete (Str, StrPos, 1);
              If CurPos = 1 Then
                ScrollLeft
              Else Begin
                Console.CursorXY (Console.CursorX - 1, Console.CursorY);
                Dec (CurPos);
                ReDrawPart;
              End;
            End;
      ^Y  : Begin
              Str    := '';
              StrPos := 1;
              Junk   := 1;
              CurPos := 1;
              ReDraw;
            End;
      #32..
      #254: Case Mode of
              0 : If Ch in ['0'..'9', '-'] Then Add_Char(Ch);
              1 : Add_Char (Ch);
              2 : Add_Char (UpCase(Ch));
              3 : If (Ch > '/') and (Ch < ':') Then
                    Case StrPos of
                      2,5 : Begin
                              Add_Char (Ch);
                              Add_Char ('/');
                            End;
                      3,6 : Begin
                              Add_Char ('/');
                              Add_Char (Ch);
                            End;
                    Else
                      Add_Char (Ch);
                    End;
            End;
    Else
      If Pos(Ch, LoChars) > 0 Then Begin
        ExitCode := Ch;
        Break;
       End;
    End;
  Until False;

  Changed := (Str <> Default);
  Result  := Str;
End;

Function TMenuInput.GetNum (X, Y, Field, Len: Byte; Min, Max, Default: LongInt) : LongInt;
Var
  N : LongInt;
Begin
  N := Default;
  N := strS2I(Self.GetStr(X, Y, Field, Len, 0, strI2S(N)));

  If N < Min Then N := Min;
  If N > Max Then N := Max;

  GetNum := N;
End;

Function TMenuInput.KeyWaiting : Boolean;
Begin
  Result := Key.KeyPressed;
End;

Function TMenuInput.ReadKey : Char;
Begin
  Result := Key.ReadKey;
End;

End.