Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPEDIT.ZIP/EDITOR.PAS

Pascal/Delphi Source File | 1988-06-10 | 20.8 KB | 607 lines

Unit Editor;

{ Copyright (c) 1987, 1988 - COMPUsystems N.W. }

Interface

Uses
  CRT;

Type
  InpDate    = String[8];
  InpString  = String[80];
  InpInteger = String[10];
  InpReal    = String[28];
  Str80      = String[80];
  Str1       = String[1];

Var
  FieldNo    : LongInt;
  LastField  : LongInt;
  Escape     : Boolean;

Procedure Color(Foreground,Background : Byte);
Procedure Beep;
Procedure EditDate(Var DS            : InpDate;
                   X,Y,FG,BG         : Byte);
Procedure EditString(Var S           : InpString;
                     L,X,Y,FG,BG     : Byte;
                     Picture         : Str80);
Procedure EditInt(Var I              : LongInt;
                  L,X,Y,FG,BG        : Byte);
Procedure EditReal(Var R             : Real;
                   L,X,Y,DecPl,FG,BG : Byte);
Procedure EditChoice(Var C           : Str1;
                     X,Y             : Byte;
                     Choice1,Choice2 : Char;
                     FG,BG           : Byte);

Implementation

Procedure Color(Foreground,Background : Byte);
Begin
  TextColor(Foreground);
  TextBackground(Background);
End;

Procedure InverseColor(Foreground,Background : Byte);
Begin
  If Foreground < 8 then Foreground := Foreground + 8;
  If Background > 8 then Background := Background - 8;
  TextColor(Background);
  TextBackground(Foreground);
End;

Procedure Beep;
Begin
  Sound(400); Delay(100);
  Sound(200); Delay(100);
  NoSound;
End;

Procedure EditDate(Var DS    : InpDate;
                   X,Y,FG,BG : Byte);
Var
  Mo,Da,Yr  : String[2];
  Done      : Boolean;
  Ch        : Char;
  Postn       : Byte;
Begin
  gotoXY(X,Y);
  InverseColor(FG,BG);
  Escape := False;
  If DS = '' then
  Begin
    DS := '  /  /  ';
    Write(DS);
  End else Write(DS);
  gotoXY(X,Y); Postn := X;
  Done := False;
  Repeat
    Ch := ReadKey;
    Case Ch of
      '0'..'9' : Begin
                   Write(Ch);
                   DS[(Postn+1)-X] := Ch;
                   Postn := Postn + 1;
                   If (Postn = X+2) or (Postn = X+5) then Postn := Postn + 1;
                   gotoXY(Postn,Y);
                   If Postn >= X + 8 then
                   Begin
                     Done := True;
                     Inc(FieldNo);
                   End;
                 End;
           #13 : Begin
                   Done := True;
                   Inc(FieldNo);
                 End;
           #27 : Begin
                   Escape := True;
                   FieldNo := LastField + 1;
                 End;
            #0 : Begin
                   Ch := ReadKey;
                   Case Ch of
                         #71 : Begin               { Home }
                                 Postn := X;
                                 gotoXY(Postn,Y);
                               End;
                         #72 : Begin               { Up Arrow }
                                 Done := True;
                                 Dec(FieldNo);
                                 If FieldNo < 1 then FieldNo := 1;
                               End;
                         #80 : Begin               { Down Arrow }
                                 Done := True;
                                 Inc(FieldNo);
                                 If FieldNo > LastField then
                                   FieldNo := LastField;
                               End;
                         #73 : Begin               { PgUp }
                                 Done := True;
                                 FieldNo := 1;
                               End;
                         #81 : Begin               { PgUp }
                                 Done := True;
                                 FieldNo := LastField;
                               End;
                         #75 : Begin               { Left arrow }
                                 Postn := Postn - 1;
                                 If (Postn = X+2) or (Postn = X+5) then
                                   Postn := Postn - 1;
                                 If Postn < X  then Postn := X;
                                 gotoXY(Postn,Y);
                               End;
                         #77 : Begin               { Right arrow }
                                 Postn := Postn + 1;
                                 If (Postn = X+2) or (Postn = X+5) then
                                   Postn := Postn + 1;
                                 If Postn > X + 7  then Postn := X + 7;
                                 gotoXY(Postn,Y);
                               End;
                   End; { Case }
                 End; { Ch = #0 }
    End; { Case }
  Until (Done) or (Escape);
  Color(FG,BG);
  gotoXY(X,Y); Write(DS);
End;

Procedure EditString(Var S       : InpString;
                     L,X,Y,FG,BG : Byte;
                     Picture     : Str80);
Var
  InsFlag,
  Done    : Boolean;
  Postn     : Byte;
  Ch      : Char;
Begin
  Done := False;
  InsFlag := False;
  Escape := False;
  gotoXY(X,Y);
  InverseColor(FG,BG);
  While Length(S) < L do S := S + ' ';
  gotoXY(X,Y);
  Write(S);
  gotoXY(X,Y);
  Postn := X;
  Repeat
    Ch := ReadKey;
    Case Ch of
      #32..#126 : Begin
                    If InsFlag then
                    Begin
                      If Picture[Postn+1-X] = 'U' then Ch := Upcase(Ch);
                      Write(Ch);
                      Insert(Ch,S,(Postn+1)-X);
                      S[0] := Chr(L);
                      gotoXY(X,Y); Write(S);
                    End else
                    Begin
                      If Picture[Postn+1-X] = 'U' then Ch := Upcase(Ch);
                      Write(Ch);
                      S[(Postn+1)-X] := Ch;
                    End;
                    Inc(Postn);
                    If (Picture[Postn-X] = '#') and not (Ch in['0'..'9']) then
                    Begin
                      Dec(Postn);
                      S[Postn+1-X] := ' ';
                      gotoXY(X,Y); Write(S);
                      Beep;
                    End;
                    If Picture[Postn+1-X] = '*' then Inc(Postn);
                    gotoXY(Postn,Y);
                    If Postn >= X + L then
                    Begin
                      Done := True;
                      Inc(FieldNo);
                    End;
                  End;
            #13 : Begin
                    Done := True;
                    Inc(FieldNo);
                  End;
            #27 : Begin
                    Escape := True;
                    FieldNo := LastField + 1;
                  End;
             #8 : Begin                        { Destructive Backspace }
                    If Pos('-',Picture) = 0 then
                    Begin
                      Dec(Postn);
                      If Postn < X then Postn := X;
                      Delete(S,(Postn+1)-X,1);
                      S := S + ' ';
                      gotoXY(X,Y); Write(S);
                      gotoXY(Postn,Y);
                    End;
                  End;
             #0 : Begin
                    Ch := ReadKey;
                    Case Ch of
                      #71 : Begin          { Home }
                              Postn := X;
                              gotoXY(Postn,Y);
                            End;
                      #72 : Begin               { Up Arrow }
                              Done := True;
                              Dec(FieldNo);
                              If FieldNo < 1 then FieldNo := 1;
                            End;
                      #80 : Begin               { Down Arrow }
                              Done := True;
                              Inc(FieldNo);
                              If FieldNo > LastField then
                                FieldNo := LastField;
                            End;
                      #73 : Begin               { PgUp }
                              Done := True;
                              FieldNo := 1;
                            End;
                      #81 : Begin               { PgUp }
                              Done := True;
                              FieldNo := LastField;
                            End;
                      #75 : Begin          { Left arrow }
                              Dec(Postn);
                              If Picture[Postn+1-X] = '*' then Dec(Postn);
                              If Postn < X  then Postn := X;
                              gotoXY(Postn,Y);
                            End;
                      #77 : Begin          { Right arrow }
                              Inc(Postn);
                              If Picture[Postn+1-X] = '*' then Inc(Postn);
                              If Postn >= X + L-1  then Postn := X + L-1;
                              gotoXY(Postn,Y);
                            End;
                      #82 : Begin          { Toggle Insert }
                              If Pos('*',Picture) = 0 then
                              If not InsFlag then InsFlag := True
                                else InsFlag := False;
                            End;
                      #83 : Begin          { Del }
                              If Pos('*',Picture) = 0 then
                              Begin
                                Delete(S,(Postn+1)-X,1);
                                S := S + ' ';
                                gotoXY(X,Y); Write(S);
                                gotoXY(Postn,Y);
                              End;
                            End;
                    End; { Case }
                  End; { Ch = #0 }
    End; { Case }
  Until (Done) or (Escape);
  Color(FG,BG);
  gotoXY(X,Y); Write(S);
  While S[Length(S)] = ' ' do Delete(S,Length(S),1)
End;

Function IntToStr(I : LongInt; Len : Byte) : InpInteger;
Var
  IntString : InpInteger;
Begin
  Str(I:Len,IntString);
  IntToStr := IntString;
End;

Function StrToInt(IStr : InpInteger) : LongInt;
Var
  Code      : Integer;
  StringInt : LongInt;
Begin
  While IStr[1] = ' ' do Delete(IStr,1,1);
  Val(IStr,StringInt,Code);
  StrToInt := StringInt;
End;

Procedure EditInt(Var I       : LongInt;
                  L,X,Y,FG,BG : Byte);
Var
  Done    : Boolean;
  Postn     : Byte;
  Ch      : Char;
  IInt    : InpInteger;
Begin
  Done := False;
  Escape := False;
  gotoXY(X,Y);
  InverseColor(FG,BG);
  IInt := IntToStr(I,L);
  Write(IInt);
  gotoXY(X,Y);
  Postn := X + L;
  gotoXY(Postn-1,Y);
  Repeat
    Ch := ReadKey;
    Case Ch of
     '-','0'..'9' : Begin
                      IInt := IInt + Ch;
                      While (IInt[1] = ' ') or (IInt[1] = '0')
                        do Delete(IInt,1,1);
                      If Length(IInt) = L then
                      Begin
                        Done := True;
                        Inc(FieldNo);
                      End;
                      While Length(IInt) < L do IInt := ' ' + IInt;
                      gotoXY(X,Y); Write(IInt);
                      gotoXY(Postn-1,Y);
                    End;
              #13 : Begin
                      Done := True;
                      Inc(FieldNo);
                    End;
              #27 : Begin
                      Escape := True;
                      FieldNo := LastField + 1;
                    End;
               #8 : Begin
                      Delete(IInt,Length(IInt),1);
                      While Length(IInt) < L do IInt := ' ' + IInt;
                      gotoXY(X,Y); Write(IInt);
                      gotoXY(Postn-1,Y);
                    End;
               #0 : Begin
                      Ch := ReadKey;
                      Case Ch of
                        #83 : Begin
                                Delete(IInt,Length(IInt),1);
                                While Length(IInt) < L do IInt := ' ' + IInt;
                                gotoXY(X,Y); Write(IInt);
                                gotoXY(Postn-1,Y);
                              End;
                        #72 : Begin               { Up Arrow }
                                Done := True;
                                Dec(FieldNo);
                                If FieldNo < 1 then FieldNo := 1;
                              End;
                        #80 : Begin               { Down Arrow }
                                Done := True;
                                Inc(FieldNo);
                                If FieldNo > LastField then
                                  FieldNo := LastField;
                              End;
                        #73 : Begin               { PgUp }
                                Done := True;
                                FieldNo := 1;
                              End;
                        #81 : Begin               { PgUp }
                                Done := True;
                                FieldNo := LastField;
                              End;
                      End; { Case }
                    End;
    End; { Case }
  Until (Done) or (Escape);
  Color(FG,BG);
  If IInt[Length(IInt)] = ' ' then IInt[Length(IInt)] := '0';
  gotoXY(X,Y); Write(IInt);
  I := StrToInt(IInt);
End;

Function RealToStr(I : Real; L,DecPl : Byte) : InpReal;
Var
  StringReal : InpReal;
Begin
  Str(I:L:DecPl,StringReal);
  RealToStr := StringReal;
End;

Function StrToReal(RealStr : InpReal) : Real;
Var
  Code : Integer;
  RealString : Real;
Begin
  While RealStr[1] = ' ' do Delete(RealStr,1,1);
  Val(RealStr,RealString,Code);
  StrToReal := RealString;
End;

Procedure EditReal(Var R             : Real;
                   L,X,Y,DecPl,FG,BG : Byte);
Var
  DecFlag,
  Done      : Boolean;
  Postn,Loc : Byte;
  Ch        : Char;
  IntPart   : InpInteger;
  DecPart   : InpReal;
  IReal     : InpReal;
Begin
  Done := False;
  DecFlag := False;
  Escape := False;
  IReal := RealToStr(R,L,DecPl);
  IntPart := Copy(IReal,1,L-(DecPl+1));
  DecPart := Copy(IReal,L-DecPl+1,DecPl);
  InverseColor(FG,BG);
  gotoXY(X,Y); Write(IReal);
  Postn := (X+L) - (DecPl+2);
  gotoXY(Postn,Y);
  Repeat
    Ch := ReadKey;
    Case Ch of
              #46 : Begin
                      If DecFlag then
                      Begin
                        DecFlag := False;
                        Postn := (X+L) - (DecPl+2);
                        gotoXY(Postn,Y);
                      End;
                      If not DecFlag then
                      Begin
                        DecFlag := True;
                        Loc := 1;
                        Postn := (X+L) - (DecPl);
                        gotoXY(Postn,Y);
                      End;
                    End;
     '-','0'..'9' : Begin
                      If not DecFlag then
                      Begin
                        IntPart := IntPart + Ch;
                        While (IntPart[1] = ' ') or (IntPart[1] = '0')
                          do Delete(IntPart,1,1);
                        If Length(IntPart) = L - (DecPl+1) then
                        Begin
                          DecFlag := True;
                          Loc := 1;
                          Postn := (X+L) - (DecPl);
                          gotoXY(Postn,Y);
                        End;
                        While Length(IntPart) < L - (DecPl+1)
                          do IntPart := ' ' + IntPart;
                        gotoXY(X,Y); Write(IntPart);
                        gotoXY(Postn,Y);
                      End else
                      Begin
                        DecPart[Loc] := Ch;
                        gotoXY(Postn,Y); Write(Copy(DecPart,1,DecPl));
                        gotoXY(Postn,Y);
                        Inc(Loc);
                        If DecPart[DecPl] > '0' then
                        Begin
                          Done := True;
                          Inc(FieldNo);
                        End;
                      End;
                    End;
              #13 : Begin
                      Done := True;
                      Inc(FieldNo);
                    End;
              #27 : Begin
                      Escape := True;
                      FieldNo := LastField + 1;
                    End;
               #8 : Begin
                      If not DecFlag then
                      Begin
                        Delete(IntPart,Length(IntPart),1);
                        While Length(IntPart) < L-DecPl-1
                          do IntPart := ' ' + IntPart;
                        gotoXY(X,Y); Write(IntPart);
                        gotoXY(Postn,Y);
                      End else
                      Begin
                        Delete(DecPart,1,1);
                        DecPart := DecPart + '0';
                        gotoXY(X+L-DecPl,Y);
                        Write(DecPart);
                        gotoXY(Postn,Y);
                      End;
                    End;
               #0 : Begin
                      Ch := ReadKey;
                      Case Ch of
                        #83 : Begin
                                If not DecFlag then
                                Begin
                                  Delete(IntPart,Length(IntPart),1);
                                  While Length(IntPart) < L-DecPl-1
                                    do IntPart := ' ' + IntPart;
                                  gotoXY(X,Y); Write(IntPart);
                                  gotoXY(Postn,Y);
                                End else
                                Begin
                                  Delete(DecPart,1,1);
                                  DecPart := DecPart + '0';
                                  gotoXY(X+L-DecPl,Y);
                                  Write(DecPart);
                                  gotoXY(Postn,Y);
                                End;
                              End;
                        #72 : Begin               { Up Arrow }
                                Done := True;
                                Dec(FieldNo);
                                If FieldNo < 1 then FieldNo := 1;
                              End;
                        #80 : Begin               { Down Arrow }
                                Done := True;
                                Inc(FieldNo);
                                If FieldNo > LastField then
                                  FieldNo := LastField;
                              End;
                        #73 : Begin               { PgUp }
                                Done := True;
                                FieldNo := 1;
                              End;
                        #81 : Begin               { PgUp }
                                Done := True;
                                FieldNo := LastField;
                              End;
                      End; { Case }
                    End;
    End; { Case }
  Until (Done) or (Escape);
  Color(FG,BG);
  If IntPart[Length(IntPart)] = ' ' then IntPart[Length(IntPart)] := '0';
  IReal := IntPart + '.' + DecPart;
  gotoXY(X,Y); Write(IReal);
  R := StrToReal(IReal);
End;

Procedure EditChoice(Var C            : Str1;
                     X,Y              : Byte;
                     Choice1,Choice2  : Char;
                     FG,BG            : Byte);
Var
  Done : Boolean;
  Ch   : Char;
Begin
  Done := False;
  Escape := False;
  gotoXY(X,Y);
  InverseColor(FG,BG);
  Repeat
    Ch := Upcase(Readkey);
    If Ch in[Choice1,Choice2] then
    Begin
      Done := True;
      Inc(FieldNo);
    End else
    Begin
      Case Ch of
       #27 : Begin
               Escape := True;
               FieldNo := LastField + 1;
             End;
        #0 : Begin
               Ch := ReadKey;
               Case Ch of
                 #72 : Begin               { Up Arrow }
                         Done := True;
                         Dec(FieldNo);
                         If FieldNo < 1 then FieldNo := 1;
                       End;
                 #80 : Begin               { Down Arrow }
                         Done := True;
                         Inc(FieldNo);
                         If FieldNo > LastField then
                           FieldNo := LastField;
                       End;
                 #73 : Begin               { PgUp }
                         Done := True;
                         FieldNo := 1;
                       End;
                 #81 : Begin               { PgUp }
                         Done := True;
                         FieldNo := LastField;
                       End;
               End; { Case }
             End; { Ch = #0 }
      End; { Case }
    End;
    If not Done then Beep;
  Until (Done) or (Escape);
  C := Ch;
  Color(FG,BG);
  gotoXY(X,Y); Write(C);
End;

End.