[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]