Turbo Toolbox/Turbo_Toolbox.iso/turbo4/mcinput.pas

Pascal/Delphi Source File | 1987-12-08 | 6KB | 235 lines

{           Copyright (c) 1985, 87 by Borland International, Inc.            }

unit MCINPUT;

interface

uses Crt, Dos, MCVars, MCUtil, MCDisply, MCParser, MCLib;

function GetKey : Char;
{ Liest ein Zeichen von der Tastatur via BIOS-Aufruf. }

function InCharset(Ch: Char): Boolean;
{ Prüft auf "erlaubtes Zeichen" inklusive Umlaute. }

function EditString(var S : IString; Legal : IString;
                    MaxLength : Word) : Boolean;
{ Editieren eines Strings: "Legal" legt den Satz erlaubter Zeichen fest.
  Ergebnis FALSE bei Abbruch durch Eingabe von ESC. }

procedure GetInput(C : Char);
{ Liest und bearbeitet eine Eingabe über die Tastatur, die mit dem als C
  übergebenen Zeichen begonnen wurde. }

function GetWord(var Number : Word; Low, High : Word) : Boolean;
{ Liest einen (positiven) Wert des Typs Word ein }

function GetCell(var Col, Row : Word) : Boolean;
{ Liest eine Zelladresse und liefert FALSE bei Abbruch der Eingabe mit ESC. }

function GetYesNo(var YesNo : Char; Prompt : String) : Boolean;
{ Gibt den als Prompt übergebenen String aus und wartet danach auf
  'J' oder 'N' - liefert FALSE bei Abbruch mit ESC. }

function GetCommand(MsgStr, ComStr : String) : Word;
{ Liest einen Befehl und führt ihn aus. }

{ ********************************************************** }
{ ********************************************************** }

implementation

function GetKey;
var C : Char;
begin
  C := ReadKey;
  repeat
    if C = NULL then  { Spezialtaste }
    begin
      C := ReadKey;
      if Ord(C) > 127 then C := NULL
       else GetKey := Chr(Ord(C) + 128);
    end
    else
      GetKey := C;
  until C <> NULL;
end;

function InCharset;
begin
  if (Ch >= ' ') and (Ch <= '~') then InCharSet := True
    else if Ch in ['ä','ö','ü','ß','Ä','Ö','Ü'] then InCharSet := True
     else InCharSet := False;
end;

function EditString;
var
  CPos : Word;
  Ins : Boolean;
  Ch : Char;
begin
  Ins := True;
  ChangeCursor(Ins);
  CPos := Succ(Length(S));
  SetColor(White);
  repeat
    GotoXY(1, ScreenRows + 5);
    Write(S, '':(79 - Length(S)));
    GotoXY(CPos, ScreenRows + 5);
    Ch := GetKey;
    case Ch of
      HOMEKEY : CPos := 1;
      ENDKEY : CPos := Succ(Length(S));
      INSKEY : begin
                Ins := not Ins; ChangeCursor(Ins);
              end;
      LEFTKEY : if CPos > 1 then Dec(CPos);
      RIGHTKEY : if CPos <= Length(S) then Inc(CPos);
      BS : if CPos > 1 then
            begin
             Delete(S, Pred(CPos), 1); Dec(CPos);
            end;
      DELKEY : if CPos <= Length(S) then Delete(S, CPos, 1);
      CR : ;
      UPKEY, DOWNKEY : Ch := CR;
      ESC : S := '';
      else begin
        if ((Legal = '')
         or (Pos(Ch, Legal) <> 0)) and InCharset(Ch)
         and (Length(S) < MaxLength) then
        begin
          if Ins then Insert(Ch, S, CPos)
          else if CPos > Length(S) then S := S + Ch
            else S[CPos] := Ch;
          Inc(CPos);
        end;
      end;
    end; { case }
  until (Ch = CR) or (Ch = ESC);
  ClearInput;
  ChangeCursor(False);
  EditString := Ch <> ESC;
  SetCursor(NoCursor);
end; { EditString }

procedure GetInput;
var
  S : IString;
begin
  S := C;
  if (not EditString(S, '', MAXINPUT)) or (S = '') then Exit;
  Act(S);
  Changed := True;
end;

function GetWord;
var
  I, Error : Word;
  Good : Boolean;
  Num1, Num2 : String[5];
  Message : String[80];
  S : IString;
begin
  GetWord := False;
  S := '';
  Str(Low, Num1);
  Str(High, Num2);
  Message := MSGBADNUMBER + ' ' + Num1 + ' to ' + Num2 + '.';
  repeat
    if not EditString(S, '1234567890', 4) then Exit;
    Val(S, I, Error);
    Good := (Error = 0) and (I >= Low) and (I <= High);
    if not Good then ErrorMsg(Message);
  until Good;
  Number := I;
  GetWord := True;
end;

function GetCell;
var
  Len, NumLen, OldCol, OldRow, Posit, Error : Word;
  Data : IString;
  NumString : IString;
  First, Good : Boolean;
begin
  NumLen := RowWidth(MAXROWS);
  OldCol := Col;
  OldRow := Row;
  First := True;
  Good := False;
  Data := '';
  repeat
    if not First then ErrorMsg(MSGBADCELL);
    First := False;
    Posit := 1;
    if not EditString(Data, '', NumLen + 2) then
    begin
      Col := OldCol;
      Row := OldRow;
      GetCell := False;
      Exit;
    end;
    if (Data <> '') and (Data[1] in Letters) then
    begin
      Col := Succ(Ord(UpCase(Data[1])) - Ord('A'));
      Inc(Posit);
      if (Posit <= Length(Data)) and (Data[Posit] in LETTERS) then
      begin
        Col := Col * 26;
        Inc(Col, Succ(Ord(UpCase(Data[Posit])) - Ord('A')));
        Inc(Posit);
      end;
      if Col <= MAXCOLS then
      begin
        NumString := Copy(Data, Posit, Succ(Length(Data) - Posit));
        Val(NumString, Row, Error);
        if (Row <= MAXROWS) and (Error = 0) then
          Good := True;
      end;
    end;
  until Good;
  GetCell := True;
end;

function GetYesNo;
begin
  SetCursor(ULCursor);
  GetYesNo := False;
  WritePrompt(Prompt + ' ');
  repeat
    YesNo := UpCase(GetKey);
    if YesNo = ESC then Exit;
  until YesNo in ['J', 'N'];
  SetCursor(NoCursor);
  GetYesNo := True;
end;

function GetCommand;
var
  Counter, Len : Word;
  Ch : Char;
begin
  Len := Length(MsgStr);
  GotoXY(1, ScreenRows + 4);
  ClrEol;
  for Counter := 1 to Len do
  begin
    if MsgStr[Counter] in ['A'..'Z'] then SetColor(COMMANDCOLOR)
     else SetColor(LOWCOMMANDCOLOR);
    Write(MsgStr[Counter]);
  end;
  GotoXY(1, ScreenRows + 5);
  repeat
    Ch := UpCase(GetKey);
  until (Pos(Ch, ComStr) <> 0) or (Ch = ESC);
  ClearInput;
  if Ch = ESC then
    GetCommand := 0
  else
    GetCommand := Pos(Ch, ComStr);
end;

begin   { keine Initialisierungen }
end.