[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]

    {$S-,R-,V-,I-,N-,B-,F-}

    {$IFNDEF Ver40}
          {Allow overlays}
          {$F+,O-,X+,A-}
    {$ENDIF}

    UNIT FastEdit;

    INTERFACE

    USES Crt, Keys; { keys unit at the end .. cut out }

    TYPE

      EntryRec = RECORD
                   Row, Col : BYTE;
                   Format : STRING [80];
                   Prompt : STRING [40];
                 END;

    TYPE

      CharSet = SET OF CHAR;
      InputTypes = (AnyChars, Alphas, Ups, Lows, Nums, Reals, Dates, Times);

    CONST

      Printable : CharSet = [#32..#127];
      European  : CharSet = [#128..#168,#224..#239];    { European characters }
      Term : CharSet = [Esc, Enter, Tab, F2, Up, Down, ^X, ^E];
      ExitOutSet : CharSet = [F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, Up,
      Down, Esc];   FmtChars : CharSet = ['!', '#', '@', '*'];
      PhoneFormat : STRING = '(###) ###-####';
      DateFormat : STRING = '##/##/##';
      TimeFormat : STRING = '##:##';
      NumberFormat : STRING = '###,###,###';
      GIS : STRING[250] = '';
      DOTChar : Char = #4;

    VAR
       TC : CHAR;
       BaseOfScreen : WORD;

    procedure FastWrite(Strng : String; Row, Col, Attr : Byte);
    PROCEDURE GotoRC (Row, Col : BYTE);

    FUNCTION FmtStr (STR, Fmt : STRING) : STRING;

    PROCEDURE EditLine (VAR S : STRING;
                       Row, Col : BYTE;
                       LegalChars,
                       Term : CharSet;
                       InputAttr : BYTE;
                       FormatStr : STRING;
                       CharType : InputTypes;
                       VAR TC : CHAR);

    IMPLEMENTATION
      {$V-}

      PROCEDURE GotoRC (Row, Col : BYTE);
      BEGIN
        INLINE
        ($B4/$02/$31/$DB/$8E/$C3/$26/$8A/$3E/$62/$04/$8A/$76/<Row/$FE/$CE/$8A
        /$56/<Col/$FE/$CA/$CD/$10);
      END;

      procedure  FastWrite(Strng : String; Row, Col, Attr : Byte); assembler;
        { display strings directly on the CRT VERY FAST with color !! }
        asm
            PUSH    DS                     { ;Save DS }
            MOV     CH,Row                 { ;CH = Row }
            MOV     BL,Col                 { ;BL = Column }

            XOR     AX,AX                  { ;AX = 0 }
            MOV     CL,AL                  { ;CL = 0 }
            MOV     BH,AL                  { ;BH = 0 }
            DEC     CH                     { ;Row (in CH) to 0..24 range }
            SHR     CX,1                   { ;CX = Row * 128 }
            MOV     DI,CX                  { ;Store in DI }
            SHR     DI,1                   { ;DI = Row * 64 }
            SHR     DI,1                   { ;DI = Row * 32 }
            ADD     DI,CX                  { ;DI = (Row * 160) }
            DEC     BX                     { ;Col (in BX) to 0..79 range }
            SHL     BX,1                   { ;Account for attribute bytes }
            ADD     DI,BX                  { ;DI = (Row * 160) + (Col * 2) }
            MOV     ES,BaseOfScreen        { ;ES:DI points to BaseOfScreen:Row,Col }

            LDS     SI,DWORD PTR [Strng]   { ;DS:SI points to St[0] }
            CLD                            { ;Set direction to forward }
            LODSB                          { ;AX = Length(St); DS:SI -> St[1] }
            XCHG    AX,CX                  { ;CX = Length; AL = WaitForRetrace }
            JCXZ    @FWExit                { ;If string empty, exit }
            MOV     AH,Attr                { ;AH = Attribute }
          @FWDisplay:
            LODSB                          { ;Load next character into AL }
                                           { ; AH already has Attr }
            STOSW                          { ;Move video word into place }
            LOOP    @FWDisplay             { ;Get next character }
          @FWExit:
            POP     DS                     { ;Restore DS }
        end; {asm block}

      FUNCTION Max ( A, B : LONGINT ) : LONGINT;
      BEGIN (* Max *)

         IF A > B THEN
            Max := A
         ELSE
            Max := B;
      END   (* Max *);

      FUNCTION Min ( A, B : LONGINT ) : LONGINT;
      BEGIN (* Min *)

         IF A < B THEN
            Min := A
         ELSE
            Min := B;
      END   (* Min *);

      FUNCTION rPos(val : CHAR; Str : STRING) : BYTE;
      { return the right position of val in STR }
      VAR
         i : BYTE;
      BEGIN
         For i := Length(Str) DOWNTO 1 DO
             IF Str[i] = val THEN
                BEGIN
                rPos := i;
                EXIT;
                END;
      rPos := 0;
      END;

      function PadR(S : string; Len : Byte) : string;
        {-Return a string right-padded to length Len with Ch}
      var
        O : string;
        SLen : Byte absolute S;
      begin
        if Length(S) >= Len then
          PadR := S
        else begin
          O[0] := Chr(Len);
          Move(S[1], O[1], SLen);
          if SLen < 255 then
            FillChar(O[Succ(SLen)], Len-SLen, #32);
          PadR := O;
        end;
      end;

      function LTrim(const S: String): String;
      var
        I: Integer;
      begin
        I := 1;
        while (I < Length(S)) and (S[I] = ' ') do Inc(I);
        LTrim := Copy(S, I, 255);
      end;

      function RTrim(const S: String): String;
      var
        I: Integer;
      begin
        I := Length(S);
        while S[I] = ' ' do Dec(I);
        RTrim := Copy(S, 1, I);
      end;

      FUNCTION TrimB(const S : STRING) : STRING;
      BEGIN
          TrimB := LTrim(RTrim(S));
      END;

      FUNCTION FmtStr (STR, Fmt : STRING) : STRING;
      VAR
      TempStr : STRING;
      K, I, J : BYTE;
      Dollar, Percent : BOOLEAN;

      BEGIN

      TempStr := '';

          IF (POS (',', Fmt) > 0) THEN
          BEGIN
          Dollar  := POS ('$', Fmt) > 0;
          Percent := POS ('%', Fmt) > 0;
          FOR j := LENGTH (STR) DOWNTO 1 DO
              BEGIN
              i := rPos ('#', Fmt);
              Fmt [i] := STR [j];
              END;

          IF I > 1 THEN
          FOR j := i - 1 DOWNTO 1 DO fmt [j] := #32;

          Fmt := TrimB (Fmt);
          IF Dollar THEN Fmt := '$' + Fmt;
          IF Percent THEN Fmt := Fmt + '%';

          TempStr := Fmt;

          END ELSE
              BEGIN
              J := 0;
              FOR I := 1 TO LENGTH (Fmt) DO
              BEGIN
                  IF NOT (Fmt [I] IN ['#', '!', '@', '*']) THEN
                  BEGIN
                      TempStr [I] := Fmt [I] ;  {force any none format charcters into string}
                       J := SUCC (J);
                  END
                  ELSE    {format character}
                  BEGIN
                      IF I - J <= LENGTH (STR) THEN
                         TempStr [I] := STR [I - J]
                      ELSE
                         TempStr [I] := ' ';    {pad with underlines}
                  END;
              END;

              TempStr [0] := CHAR (LENGTH (Fmt) );  {set initial byte to string length}
              END;

          FmtStr := Tempstr;

      END;  {Func FmtStr}

      PROCEDURE Beep;
    { Generates a sound from the speaker to alert the user.  Useful
      for error handling routines. }
      BEGIN
      Sound(4000);
      Delay(30);
      Nosound;
      END;                    { Beep }

      FUNCTION GetKey (VAR Key : WORD) : BOOLEAN; assembler;
      { determine if key pressed and return it}
      asm
    	  MOV	AH, 1
    	  INT	16H
    	  MOV	AL, 0
    	  JE	@@1
    	  XOR	AH, AH
    	  INT	16H
    	  LES	DI, Key
    	  MOV	WORD PTR ES : [DI], AX
    	  MOV	AL, 1
      @@1 :
      END;

      FUNCTION KeyHit : CHAR;

      VAR
          Char_in,
          WW      : WORD;

      BEGIN
      WHILE NOT GetKey(WW) DO
            BEGIN
            { here you could check for other stuff !! }
            END;
        Char_in := WW;
        { covert the word to our keys format }
        IF (LO (char_in) = 0) AND (HI (char_in) <> 0) THEN
              KeyHit := CHR ( HI (char_in) + 128 )
            ELSE
              KeyHit := CHR (LO (char_in) );
      END;

      FUNCTION KeysOK (VAR C : CHAR; CharType : InputTypes) : BOOLEAN;

      VAR Temp : BOOLEAN;

      BEGIN
        Temp := TRUE;
        CASE CharType OF
          Alphas : Temp := NOT (C IN [#00..#64]-[#32]);
          Ups    : C := UPCASE (C);
          Lows   : IF C IN ['A'..'Z'] THEN C := CHR (ORD (C) + 32);
          Nums   : Temp := (C IN ['0'..'9', '-']);
          Reals  : Temp := (C IN ['0'..'9', '-', '.']);
          Dates  : Temp := (C IN ['0'..'9', '/', '-']);
          Times  : Temp := (C IN ['0'..'9', ':', 'P', 'p', 'A', 'a', 'M', 'm']);
        END;
        KeysOK := Temp;
      END;

      FUNCTION MaxFieldLen (Fmt : STRING) : BYTE;
      VAR j, Len : BYTE;

      BEGIN
        Len := 0;
        FOR j := 1 TO LENGTH (Fmt) DO IF Fmt [j] = '#' THEN Len := SUCC (Len);
        MaxFieldLen := Len;
      END;

      PROCEDURE EditLine (VAR S : STRING;
                         Row, Col : BYTE;
                         LegalChars,
                         Term : CharSet;
                         InputAttr : BYTE;
                         FormatStr : STRING;
                         CharType : InputTypes;
                         VAR TC : CHAR);

      VAR
        SAttr,
        MaxP,
        Len,
        P, P1, P2, P3 : BYTE;
        IStr, SStr : STRING;
        Ch : CHAR;
        KeyStrokes : WORD;
        ForceEND : BOOLEAN;

      LABEL TOP;

        FUNCTION PosCursor (P0 : BYTE) : BYTE;
        BEGIN
          REPEAT
            P0 := SUCC (P0);
          UNTIL (FormatStr [P0] IN FmtChars) OR (P0 >= Len);
          PosCursor := P0;
        END;

        PROCEDURE WriteOutput;
        BEGIN
          { adjust they way p3 acts if long string edit }
          P3 := Max (1, P1 - MaxP + ORD (BOOLEAN (Len <> MaxP) ) );
          IStr := FmtStr (S, FormatStr);
          FastWrite (PadR (COPY (IStr, P3, MaxP), MaxP), Row, Col, InputAttr);
        END;

      BEGIN

        SAttr := TextAttr;
        SStr := S;
        TextAttr := InputAttr;

    TOP :

        S          := SStr;
        KeyStrokes := 0;
        ForceEND   := FALSE;
        Ch         := #0;

        WHILE POS ('~', FormatStr) > 0 DO
          BEGIN
            ForceEND := TRUE;
            DELETE (FormatStr, POS ('~', FormatStr), 1);
            FormatStr := LTrim(RTrim (FormatStr));
          END;

        IF FormatStr = '' THEN FormatStr := COPY (GIS, 1, LENGTH (S) );

        Len := LENGTH (FormatStr);
        MaxP := Min (Len, PRED (LO (WindMax) ) );

        IStr := FmtStr (S, FormatStr);

        P1 := 0; { absolute position in string skipping over fmt chars }
        P  := 0; { relative position in string }
        P3 := 1;       { index ofset }

        IF ForceEND THEN
          BEGIN
            P := Min (LENGTH (S), Len);
            IStr := FmtStr (S, FormatStr);
            P1 := LENGTH (RTrim (IStr) ) + 1;
            WHILE (P1 < P) AND (FormatStr [P1] = IStr [P1]) DO P1 := SUCC (P1);
            Keystrokes := p1;
          END ELSE
              IF NOT (FormatStr [1] IN FmtChars) THEN
                 P1 := PosCursor (0) ELSE P1 := 1;

        IF ForceEND THEN P2 := PosCursor (0) ELSE P2 := P1; { save P1 }

        WriteOutput;

        REPEAT

          GotoRC (Row, Min (Col + MaxP - 1, Col + P1 - 1) );

          Ch := Keyhit;

          INC (KeyStrokes);

          IF NOT (UPCASE (Ch) IN Term) THEN
             CASE Ch OF

       #128..#168,#224..#239,    { European characters }
       #32..#126 : IF (P1 <= Len) AND
                      (Ch IN LegalChars) AND (KeysOK (Ch, CharType) ) THEN
                     BEGIN

                       IF (KeyStrokes <= 1) THEN
                         BEGIN
                           FastWrite (PadR (' ', MaxP), Row, Col, InputAttr);
                           DELETE (S, 1, LENGTH (S) );
                         END;

                       IF LENGTH (S) = Len THEN DELETE (S, Len, 1);

                       P := SUCC (P);
                       INSERT (Ch, S, P);
                       P1 := PosCursor (P1);
                       WriteOutput;

                     END
                   ELSE Beep;
              ^S, Left : IF P > 0 THEN
                              BEGIN
                                P := PRED (P);
                                REPEAT
                                  P1 := PRED (P1);
                                UNTIL (FormatStr [P1] IN FmtChars) OR
                                (P1 = P2);
                                WriteOutput;
                              END;
              ^D, Right : IF P < LENGTH (S) THEN
                               BEGIN

                                 P := SUCC (P);
                                 P1 := PosCursor (P1);

                                 WriteOutput;

                               END;
              ^A, Home : BEGIN
                              P := 0; P1 := P2; P3 := 1;
                              WriteOutput;
                            END;
              ^F, EndKey : BEGIN
                             P := Min (LENGTH (S), Len);
                             IStr := FmtStr (S, FormatStr);
                             P1 := LENGTH (RTrim (IStr) ) + 1;
                             WHILE (P1 < P) AND
                             (FormatStr [P1] = IStr [P1]) DO P1 := SUCC (P1);
                             WriteOutput;
                           END;
              ^G, Del : IF LENGTH (S) > 0 THEN
                             BEGIN
                               DELETE (S, P + 1, 1);
                               WriteOutput;
                             END;
              BackSp : IF P > 0 THEN
                            BEGIN
                              DELETE (S, P, 1);
                              P := PRED (P);
                              REPEAT
                                P1 := PRED (P1);
                              UNTIL (FormatStr [P1] IN FmtChars) OR
                              (P1 = P2);

                              WriteOutput;
                            END;
              ^R : IF NOT (Ch IN Term) THEN GOTO TOP;
              ^Y : BEGIN
                     P := 0; P1 := P2; P3 := 1;
                     DELETE (S, 1, LENGTH (S) );
                     WriteOutput;
                   END;
            ELSE ;         { nothing }
            END;             {of case}

        UNTIL UPCASE (Ch) IN Term;

        WriteOutput;

        TC := UPCASE (Ch);
        TextAttr := SAttr;

      END;                { EditLine }

      PROCEDURE DefineExitSet (ExitSet : CharSet);
      BEGIN
        ExitOutSet := ExitSet;
      END;

      FUNCTION CheckToExit (TC : CHAR) : BOOLEAN;
      BEGIN
        CheckToExit := (TC IN ExitOutSet);
      END;

    BEGIN
      FILLCHAR(GIS, SizeOF(GIS), #35);
      { point our fastwrite at the screen address for color or monochrome }
      ASM
          mov      BaseOfScreen,$B000
          mov      ax,$0F00
          int      $10
          cmp      al,2
          je       @XXX
          cmp      al,7
          je       @XXX
          mov      BaseOfScreen,$B800
      @XXX :
      end;
    END.

    { here is the demo  !!! -------------   CUT --------------- }

    {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}
    {$M 16384,0,655360}

    USES Dos, Crt, FastEdit;

    VAR
        Name,
        Date  : STRING;

    BEGIN
       ClrScr;
       { demo standard input }
       FastWrite('Enter your name : ', 5, 5, 15);
       EditLine (Name, 5, 30, Printable, Term, 95, '################', ALPHAS, TC);

       { demo insert mode input  ..  use the tilde char in front of the format }
       FastWrite('Enter your name : ', 7, 5, 15);
       EditLine (Name, 7, 30, Printable, Term, 95, '~################', ALPHAS, TC);

       { demo formated mode input }
       FastWrite('Enter the date : ', 9, 5, 15);
       EditLine (Date, 9, 30, Printable, Term, 95, DateFormat, Dates, TC);

       GoToRC(20,1);
       WriteLn;
       WriteLn('Name : ',Name);
       WriteLn('Date : ',FmtStr(Date, DateFormat));
       Readkey;

    END.

    { ------- UNIT KEYS , CUT HERE AND PASTE INTO NEW FILE (KEYS.PAS) ------- }

    Unit Keys;

    Interface

    Const
      Home   = #199;      Up    = #200;     PgUp  = #201;
      Left   = #203;      Num5  = #204;     Right = #205;
      EndKey = #207;      Down  = #208;     PgDn  = #209;
      Ins    = #210;      Del   = #211;

      CtrlHome = #247;    CtrlUp   = #141;    CtrlPgUp  = #138;
      CtrlLeft = #243;    CtrlNum5 = #143;    CtrlRight = #244;
      CtrlEnd  = #245;    CtrlDown = #145;    CtrlPgDn  = #246;
      CtrlIns  = #146;    CtrlDel  = #147;

      BackSp  = #8;
      Tab     = #9;       STab    = #143;
      Enter   = #13;
      Esc     = #27;

      CtrlPrtScr = #242;

      CtrlA  = #1;     AltA  = #158;        Alt1 = #248;
      CtrlB  = #2;     AltB  = #176;        Alt2 = #249;
      CtrlC  = #3;     AltC  = #174;        Alt3 = #250;
      CtrlD  = #4;     AltD  = #160;        Alt4 = #251;
      CtrlE  = #5;     AltE  = #146;        Alt5 = #252;
      CtrlF  = #6;     AltF  = #161;        Alt6 = #253;
      CtrlG  = #7;     AltG  = #162;        Alt7 = #254;
      CtrlH  = #8;     AltH  = #163;        Alt8 = #255;
      CtrlI  = #9;     AltI  = #151;        Alt9 = #134;
      CtrlJ  = #10;    AltJ  = #164;        Alt0 = #135;
      CtrlK  = #11;    AltK  = #165;        AltMinus  = #136;
      CtrlL  = #12;    AltL  = #166;        AltEquals = #137;
      CtrlM  = #13;    AltM  = #178;
      CtrlN  = #14;    AltN  = #177;
      CtrlO  = #15;    AltO  = #152;
      CtrlP  = #16;    AltP  = #153;
      CtrlQ  = #17;    AltQ  = #144;
      CtrlR  = #18;    AltR  = #147;
      CtrlS  = #19;    AltS  = #159;
      CtrlT  = #20;    AltT  = #148;
      CtrlU  = #21;    AltU  = #150;
      CtrlV  = #22;    AltV  = #175;
      CtrlW  = #23;    AltW  = #145;
      CtrlX  = #24;    AltX  = #173;
      CtrlY  = #25;    AltY  = #149;
      CtrlZ  = #26;    AltZ  = #172;

      F1  = #187;      sF1  = #212;      CtrlF1  = #222;      AltF1  = #232;
      F2  = #188;      sF2  = #213;      CtrlF2  = #223;      AltF2  = #233;
      F3  = #189;      sF3  = #214;      CtrlF3  = #224;      AltF3  = #234;
      F4  = #190;      sF4  = #215;      CtrlF4  = #225;      AltF4  = #235;
      F5  = #191;      sF5  = #216;      CtrlF5  = #226;      AltF5  = #236;
      F6  = #192;      sF6  = #217;      CtrlF6  = #227;      AltF6  = #237;
      F7  = #193;      sF7  = #218;      CtrlF7  = #228;      AltF7  = #238;
      F8  = #194;      sF8  = #219;      CtrlF8  = #229;      AltF8  = #239;
      F9  = #195;      sF9  = #220;      CtrlF9  = #230;      AltF9  = #240;
      F10 = #196;      sF10 = #221;      CtrlF10 = #231;      AltF10 = #241;
      F11 = #139;      sF11 = #141;      CtrlF11 = #154;      AltF11 = #156;
      F12 = #140;      sF12 = #142;      CtrlF12 = #155;      AltF12 = #157;

    Implementation

    End.

[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]