SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00013 INPUT AND FIELD ENTRY ROUTINES 1 05-31-9308:59ALL GAYLE DAVIS Simple Field Input IMPORT 23 3&╟ usesπ crt;πtypeπ input_data = recordπ st : string; { The string to be input }π col,row, { position of input }π attr, { color of input }π flen : byte; { maximum length of input }π prompt : string[40];π end;πconstπ NumberOfFields = 3;π BackSpace = $08;π Enter = $0d;π Escape = $1b;π space = $20;ππvarπ InputField : array[1..NumberOfFields] of input_data;π x : byte;π Done : boolean;π field : byte;πππProcedure SetInputField(VAR inpRec : Input_data;π S : STRING;π C,R : Byte;π A,L : Byte;π P : String);ππBEGINπWith inpRec DOπ BEGINπ St := S;π Col := C;π Row := R;π Attr := A;π fLen := L;π Prompt := P;π END;πEND;πππprocedure GetStr(var inprec: input_data; var f: byte; var finished: boolean);π varπ spstr : string; { just a string of spaces }π x,y,π oldattr: byte;π ch : char;π chval : byte absolute ch;π len : byte absolute inprec;π beginπ with inprec do beginπ FillChar(spstr,sizeof(spstr),32); spstr[0] := chr(flen);π y := row; x := col + length(prompt);π oldattr := TextAttr; finished := false;π gotoXY(col,row); write(prompt);π TextAttr := attr;π repeatπ gotoXY(x,y); write(st,copy(spstr,1,flen-len)); gotoXY(x+len,y);π ch := ReadKey;π case chval ofπ 0 : ch := ReadKey;π Enter : beginπ inc(f);π if f > NumberOfFields then f := 1;π TextAttr := oldattr;π exit;π end;π BackSpace : if len > 0 thenπ dec(len);π Escape : begin { the escape key is the only way to halt }π finished := true;π TextAttr := oldattr;π exit;π end;π 32..255 : if len <> flen then beginπ inc(len);π st[len] := ch;π end;π end; { case }π until false; { procedure only exits via exit statements }π end; { with }π end; { GetStr }ππbeginπ Clrscr;π SetInputField(InputField[1],'',12,10,31,20,'Your Name : ');π SetInputField(InputField[2],'',12,11,31,20,'Your Address : ');π SetInputField(InputField[3],'',12,12,31,20,'City,State : ');π field := 1;π repeatπ GetStr(InputField[field],field,Done);π until Done;πend.π 2 06-08-9308:24ALL SWAG SUPPORT TEAM General Input with Color IMPORT 18 3╥x { General STRING input routine with Color prompt and input }ππUSES DOS,Crt;ππTYPEπ CharSet = Set OF Char;ππVARπ Name : STRING;ππprocedure QWrite( Column, Line , Color : byte; S : STRING );ππvarπ VMode : BYTE ABSOLUTE $0040 : $0049; { Video mode: Mono=7, Color=0-3 }π NumCol : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }π VSeg : WORD;π OfsPos : integer; { offset position of the character in video RAM }π vPos : integer;π sLen : Byte ABSOLUTE S;ππBeginπ If VMode in [0,2,7] THEN VSeg := $B000 ELSE VSeg := $B800;π OfsPos := (((pred(Line) * NumCol) + pred(Column)) * 2);π FOR vPos := 0 to pred(sLen) doπ MemW[VSeg : (OfsPos + (vPos * 2))] :=π (Color shl 8) + byte(S[succ(vPos)])πEnd;ππFunction GetString(cx,cy,cc,pc : Byte; Default,Prompt : String; MaxLen : Integer;OKSet :πcharset):string;ππ{ cx = Input Column }π{ cy = Input Row }π{ cc = Input Color }π{ pc = Prompt Color }ππconstπ BS = ^H;π CR = ^M;π iPutChar = #249;π ConSet : CharSet = [BS,CR];πvarπ TStr : string;π TLen,X,i : Integer;π Ch : Char;πbeginπ {$I-} { turn off I/O checking }π TStr := '';π TLen := 0;π Qwrite(cx,cy,pc,Prompt);π X := cx + Length(Prompt);π For i := x to (x + Maxlen - 1) doπ Qwrite(i,cy,cc,iputChar);π Qwrite(x,cy,cc,Default);π OKSet := OKSet + ConSet;π repeatπ Gotoxy(x,cy);π repeatπ ch := readkeyπ until Ch in OKSet;π if Ch = BS then beginπ if TLen > 0 then beginπ TLen := TLen - 1;π X := X - 1;π QWrite(x,cy,cc,iPutChar);π endπ endπ else if (Ch <> CR) and (TLen < MaxLen) then beginπ QWrite(x,cy,cc,Ch);π TLen := TLen + 1;π TStr[TLen] := Ch;π X := X + 1;π endπ until Ch = CR;π If Tlen > 0π Then Beginπ TStr[0] := chr(Tlen);π Getstring := TStrπ Endπ Else Getstring := Default;π {$I+}πend;πππBEGINπ ClrScr;π Name := Getstring(16,5,79,31,'GOOD OLE BOY','Enter Name : ',25,['a'..'z','A'..'Z',' ']);π GOTOXY(16,7);π WriteLn('Name : ',Name);π Readkey;πEND.ππ 3 06-22-9309:18ALL SWAG SUPPORT TEAM OOP Line Editor IMPORT 49 3e' π{ A good line editor object }ππUNIT EditObj; { Object_Line_Editor }ππINTERFACEππUSES Crt, KeyBd;ππTYPEπ LineEdit = OBJECTπ Pos, XPos, YPos : Integer;π EdLine : String;π PROCEDURE InitEdit( X, Y: Integer; LineIn: String );π FUNCTION GetLine: String;π END;ππVARπ Kbd: KeyBoard; {<<<========== Global definition of OBJECT}ππ{***************************************************************}π IMPLEMENTATIONπ{***************************************************************}ππ{-------------------------------------------------π- Name : InitEdit -π- Purpose: Set up editor, display line onscreen -π-------------------------------------------------}ππPROCEDURE LineEdit.InitEdit;π BEGINπ EdLine := LineIn;π Pos := Ord( LineIn[0] ) + 1;π XPos := X;π YPos := Y;π GotoXY( X, Y );π Write( LineIn );π END;ππ{-------------------------------------------------π- Name : GetLine -π- Purpose: Process keying from user -π- Maximum 80 characters accepted -π-------------------------------------------------}ππFUNCTION LineEdit.GetLine;π VARπ KeyFlags : Byte;π Ch: Char;π FunctKey, Finish: Boolean;π BEGINπ Finish := FALSE;π REPEATπ IF Kbd.GetKey( KeyFlags, FunctKey, Ch ) THEN BEGINπ IF FunctKey THENπ CASE Ch OFπ{ HOME } #$47: Pos := 1;π{ END } #$4F: Pos := Ord( EdLine[0] ) + 1;π{ RIGHT } #$4D: BEGINπ IF Pos < 80 THEN Inc( Pos );π IF Pos > Ord( EdLine[0] ) THENπ Insert( ' ', EdLine, Pos );π END;π{ LEFT } #$4B: IF Pos > 1 THEN Dec( Pos );π{ DELETE } #$53: IF Pos <= Ord( EdLine[0] ) THENπ Delete( EdLine, Pos, 1 );π END {CASE Ch}π ELSE {IF}π CASE Ch OFπ{ BS } #$08: IF Pos > 1 THEN BEGINπ Delete( EdLine, Pos-1, 1 );π Dec( Pos );π END;π{ ENTER } #$0D: Finish := TRUE;π ELSE BEGINπ IF( ( KeyFlags AND $80 ) <> $80 )π THEN Insert( Ch, EdLine, Pos )π ELSE EdLine[Pos] := Ch;π IF Pos > Ord( EdLine[0] ) THENπ EdLine[0] := Chr( Pos );π IF Pos < 80 THEN Inc( Pos );π END {CASE CH ELSE}π END; {CASE Ch}π GotoXY( XPos, YPos );π Write( EdLine, ' ' );π GotoXY( XPos+Pos-1, YPos );π END; {IF Kbd.GetKey}π UNTIL Finish;π GetLine := EdLine;π END;ππEND.πππ{ KEYBOARD UNIT }πUNIT Keybd; { Keybd.PAS / Keybd.TPU }ππINTERFACEππUSES Crt, Dos;ππTYPEπ CType = ( UBAR, BLOCK );π Keyboard = OBJECTπ ThisCursor: CType;π PROCEDURE InitKeyBd;π PROCEDURE SetCursor( Cursor: CType );π FUNCTION GetCursor: CType;π FUNCTION GetKbdFlags: Byte;π FUNCTION GetKey( VAR KeyFlags: Byte; VAR FunctKey: Boolean;π VAR Ch: Char ): Boolean;π END;ππ{***************************************************************}π IMPLEMENTATIONπ{***************************************************************}πππ{Keyboard}ππ{-------------------------------------------------π- Name : InitKeyBd -π- Purpose: Set the cursor to underline style -π- and empty keyboard buffer -π-------------------------------------------------}ππPROCEDURE Keyboard.InitKeyBd;π VARπ Ch : Char;π BEGINπ SetCursor( UBAR );π WHILE( KeyPressed ) DO Ch := ReadKey;π END;ππ{-------------------------------------------------π- Name : SetCursor -π- Purpose: Modify number of lines for cursor -π-------------------------------------------------}ππPROCEDURE Keyboard.SetCursor;π VARπ Regs: Registers;π BEGINπ CASE Cursor OFπ UBAR: Regs.Ch := 6;π BLOCK: Regs.Ch := 1;π END;π Regs.CL := 7;π Regs.AH := 1;π Intr( $10, Regs );π END;ππ{-------------------------------------------------π- Name : GetKbdFlags -π- Purpose: Monitor the Insert key -π- Output : Shift key status flag byte -π-------------------------------------------------}ππFUNCTION Keyboard.GetKbdFlags: Byte;π VARπ Regs: Registers;π BEGINπ (* FOR enhanced keyboards: AH := $12 *)π (* FOR normal keyboards: AH := $02 *)π Regs.AH := $12;π Intr( $16, Regs );π IF( Regs.AX AND $80 = $80 ) THEN SetCursor( BLOCK )π ELSE SetCursor( UBAR );π GetKbdFlags := Regs.AX;π END;ππ{-------------------------------------------------π- Name : GetCursor -π- Purpose: Query current cursor state -π-------------------------------------------------}ππFUNCTION Keyboard.GetCursor;π BEGINπ GetCursor := ThisCursor;π END;ππ{-------------------------------------------------π- Name : GetKey -π- Purpose: Get a keypress contents if any -π- Updates a function keypressed flag -π-------------------------------------------------}ππFUNCTION Keyboard.GetKey;π VARπ Result : Boolean;π BEGINπ Result := KeyPressed;π FunctKey := FALSE;π Ch := #$00; {Use this to check for Function key press}π IF Result THEN BEGINπ Ch := ReadKey;π IF( KeyPressed AND ( Ch = #$00 ) ) THEN BEGINπ Ch := ReadKey;π FunctKey := TRUE;π END;π END;π KeyFlags := GetKbdFlags;π GetKey := Result;π END;ππEND.ππ{ DEMO PROGRAM }ππPROGRAM EditDemo;ππ{-------------------------------------------------π- Show off example of global object use -π-------------------------------------------------}ππUSES Crt, EditObj;ππVARπ Editor: LineEdit; {Instantiation of LineEdit OBJECT}π ResultStr: String;πBEGINπ ClrScr;π WITH Editor DOπ BEGINπ InitEdit( 1, 10, 'Edit this sample line');π ResultStr := GetLine;π GotoXY( 1, 15 );π WriteLn( ResultStr );π END;π ReadLn;πEND.π 4 06-22-9309:30ALL BOB GIBSON General Purpos Line Edit IMPORT 46 3
α (****************************************************************)π(* N_EditLn *)π(* *)π(* General Purpose line editor, based on EDITLN by Borland *)π(* Modified for use with multiple lines by *)π(* Bob Gibson of BGShareWare *)π(* *)π(****************************************************************)ππunit N_EditLn;π{$D-,I-,S-}πinterfaceπuses Scrn;ππconstπ NULL = #0;π BS = #8;π LF = #10;π CR = #13;π ESC = #27;π Space = #32;π Tab = ^I;ππ { The following constants are based on the scheme used by the scan keyπ function to convert a two key scan code sequence into one characterπ by adding 128 to the ordinal value of the second character.π }π F1 = #187;π F2 = #188;π F3 = #189;π F4 = #190;π F5 = #191;π F6 = #192;π F7 = #193;π F8 = #194;π F9 = #195;π F10 = #196;π UpKey = #200;π DownKey = #208;π LeftKey = #203;π RightKey = #205;π PgUpKey = #201;π PgDnKey = #209;π HomeKey = #199;π EndKey = #207;π InsKey = #210;π DelKey = #211;π M : Word = 0;πvarπ O, N, R, P : byte;π Ch : Char;π T : String;ππtypeπ CharSet = set of char;ππprocedure EditLine(var S : String;π Len, X, Y : byte;π LegalChars,π Term : CharSet;π var TC : Char );π{ EditLn implements a line editor that supports WordStar commandsπ as well as left-right arrow keys , Home, End, back space, etc.π Paramaters:π S : String to be editedπ Len : Maximum characters allowed to be editedπ X, Y : Starting x an y cordinatesπ LegalChars : Set of characters that will be acceptedπ Term : Set of characters that will cause EditLine to Exitπ (Note LegalChars need not contain Term)π TC : Character that caused EditLn to exitπ}ππfunction ScanKey : char;π{ Reads a key from the keyboard and converts 2 scan code escapeπ sequences into 1 character. }ππimplementationπ{$L keys}πFunction KeyPressed : Boolean ; External;πFunction ReadKey : Char ; External;ππfunction ScanKey : char;π{ Reads a key from the keyboard and converts 2 scan code escapeπ sequences into 1 character. }ππvarπ Ch : Char;πbeginπ Ch := ReadKey;π if (Ch = #0) {and KeyPressed} thenπ beginπ Ch := ReadKey;π if ord(Ch) < 128 thenπ Ch := Chr(Ord(Ch) + 128);π end;π ScanKey := Ch;πend; { ScanKey }ππprocedure EditLine(var S : String;π Len, X, Y : byte;π LegalChars, Term : CharSet;π var TC : Char);π{ EditLn implements a line editor that supports WordStar commandsπ as well as left-right arrow keys , Home, End, back space, etc.π Paramaters:π S : String to be editedπ Len : Maximum characters allowed to be editedπ X, Y : Starting x an y cordinatesπ LegalChars : Set of characters that will be acceptedπ Term : Set of characters that will cause EditLine to Exitπ (Note LegalChars need not contain Term)π TC : Character that caused EditLn to exitπ}π{$V-}ππbeginπ PXY(X,Y);π PWrite(S);π P := Y - 1;π N := Y;π O := X;π Y := 1;π M := 0;π Mem[$40:$17] := (Mem[$40:$17] AND $7F);π repeatπ If ((Mem[$40:$17] AND $80) = $80) Then SetCursor(0,7) Else SetCursor(6,7);π If (Y+P) > 80 Then Beginπ Inc(X);π P := 0;π End;π PXY(X,Y+P);π Ch := ScanKey;π if not (Upcase(Ch) in Term) thenπ case Ch ofπ #32..#126 : if (M < Len) andπ (ch in LegalChars) thenπ beginπ P := succ(P);π M := succ(M);π If ((Mem[$40:$17] AND $80) = $80) Thenπ Delete(S,M,1);π If ((Mem[$40:$17] AND $80) <> $80) Thenπ If Length(S) = Len Then Delete(S,Len,1);π Insert(Ch,S,M);π T := Copy(S,M,Len);π PWrite(T);π endπ Else Writeln(^G);π ^S, LeftKey : if M > 0 then Beginπ If P < 1 Then Beginπ P := 80;π Dec(X);π End;π P := pred(P);π M := pred(M);π End;π ^D, RightKey : if M < Length(S) then Beginπ P := succ(P);π M := succ(M);π End;π HomeKey : Beginπ M := M - P;π P := 0;π End;π EndKey : Beginπ M := M + (79 - P);π P := 79;π If M > Length(S) Then Beginπ P := P - (M - Length(S));π M := Length(S);π End;π End;π UpKey : If X > O Then Beginπ Dec(X);π M := M - 80;π End;π DownKey : If (M+80) < Length(S) Then Beginπ Inc(X);π M := M + 80;π If M > Length(S) Then Beginπ P := P - (M - Length(S));π M := Length(S);π End;π End;π DelKey : if M < Length(S) thenπ beginπ Delete(S,M + 1,1);π T := Copy(S,M+1,Len);π T := T + ' ';π PWrite(T);π end;π BS : if M > 0 thenπ beginπ Delete(S,M,1);π T := Copy(S,M,Len);π If (Y+P-1) < 1 Then Beginπ Dec(X);π P := (81-Y);π PXY(X,P);π Endπ Else PXY(X,Y+P-1);π T := T + ' ';π PWrite(T);π P := pred(P);π M := pred(M);π end;π F9 : Beginπ X := O;π Y := 1;π For R := 1 To Len Do PWrite(' ');π P := 0;π S := '';π M := 0;π End;π else;π end; {of case}π until UpCase(Ch) in Term;π SetCursor(6,7);π PXY(X,Y+P);π M := Length(S);π For R := 1 To (Len-M) Do PWrite('');π TC := Upcase(Ch);πend; { EditLine }ππend.ππUSE XX34 to decode this object code. You MUST Have it to use this unitπAlso, you will need the SCRN.PAS from the SCREEN.SWG packet.πππ*XX3401-000092-070293--68--85-59342--------KEYS.OBJ--1-OF--1πU+M+-2h3KJAuZUQ+++F1HoF3F7U5+0UI++6-+G4E5++++Ed9FJZEIYJHIoJ2++++-p73πEIF9FJY7+++pc-U++E++h+5B3bHug+51JMjgh+TB6MjZLQD6WU6++5E+π***** END OF XX-BLOCK *****πππ 5 08-27-9321:28ALL SEAN PALMER A Simple Input Routine IMPORT 20 3½o {πSEAN PALMERππ> name:_______________) problem, how do you make a field where youπ> define the max Chars in the field and doNOT let the person Type moreπ> than that. stop the users keyboard at the last Char in this Case itsπ> 78 Chars max and the field looks like thisππTry this. Send it a default value, the length of the field, and a set ofπChar containing all the valid Characters For the field.ππ}πUses uInput,Crt;ππFunction getName : String;πConstπ nameMax = 20;πVarπ Count : Integer;π attrsave : Byte;πbeginπ GotoXY(12, 2);π Write('ENTER NAME:');π attrsave := TextAttr;π TextColor(0);π TextBackground(7);π GotoXY(26, 2);π for Count := 1 to nameMax doπ Write(' '); {draw inverse field}π GotoXY(26, 2);π getName := input('Nobody', nameMax, ['A'..'Z','a'..'z','.',' ']);π Textattr := attrsave;πend;ππ{----------}ππ{uInput}π{by Sean Palmer}π{released to the public domain}π {2237 Lincoln St.}π {Longmont, CO 80501}π{Alms gladly accepted! 8) }ππUnit uInput;π{$B-,I-,N-,O-,R-,S-,V-,X-}ππInterfaceππ{tCharSet is used to specify Function keys to the input routine}πTypeπ tCharSet = set of Char;ππFunction isKey : Boolean;πInline(π $B4/$B/ {mov ah,$B}π $CD/$21/ {int $21}π $24/$FE); {and al,$FE}ππFunction getKey : Char;πInline(π $B4/7/ {mov ah,7}π $CD/$21); {int $21}ππFunction input(default : String; maxCh : Byte; cs : tCharSet) : String;ππImplementationππFunction input(default : String; maxCh : Byte; cs : tCharSet) : String;πVarπ p : Byte;π c : Char;π s : String[255];πbeginπ s := default;π Repeatπ c := getKey;π if c = #0 thenπ c := Char(Byte(getKey) or $80);π Case c ofπ ^H :π if s[0] <> #0 thenπ beginπ Write(^H, ' ', ^H);π dec(s[0]);π end;π #127 :π beginπ For p := length(s) downto 1 doπ Write(^H, ' ', ^H);π s[0] := #0;π end;π ^M : ; {don't beep}π ' '..'~' :π if length(s) < maxCh thenπ beginπ Write(c);π inc(s[0]);π s[Byte(s[0])] := c;π endπ elseπ Write(^G);ππ elseπ if c in cs thenπ beginπ s[1] := c;π s[0] := #1;π c := ^M;π endπ elseπ Write(^G);π end;π Until (c = ^M) or (c = ^[);ππ if c = ^[ thenπ input := defaultπ elseπ input := s;ππend;ππend.ππ 6 10-28-9311:32ALL RANDALL WOODMAN Generalize Input IMPORT 40 3è} {===========================================================================πDate: 10-02-93 (06:28)πFrom: RANDALL WOODMANπSubj: Inputππ{->>>>GetString<<<<--------------------------------------------}π{ }π{ Filename : GETSTRIN.SRC -- Last Modified 7/14/88 }π{ }π{ This is a generalized string-input procedure. It shows a }π{ field between vertical bar characters at X,Y, with any }π{ string value passed initially in XString left-justified in }π{ the field. The current state of XString when the user }π{ presses Return is returned in XString. The user can press }π{ ESC and leave the passed value of XString undisturbed, even }π{ if XString was altered prior to his pressing ESC. }π{ }π{ From: COMPLETE TURBO PASCAL 5.0 by Jeff Duntemann }π{ Scott, Foresman & Co., Inc. 1988 ISBN 0-673-38355-5 }π{--------------------------------------------------------------}ππPROCEDURE GetString( X,Y : Integer;π VAR XString : String80;π MaxLen : Integer;π Capslock : Boolean;π Numeric : Boolean;π GetReal : Boolean;π VAR RValue : Real;π VAR IValue : Integer;π VAR Error : Integer;π VAR Escape : Boolean);ππVAR I,J : Integer;π Ch : Char;π Cursor : Char;π Dot : Char;π BLength : Byte;π ClearIt : String80;π Worker : String80;π Printables : SET OF Char;π Lowercase : SET OF Char;π Numerics : SET OF Char;π CR : Boolean;πππBEGINπ Printables := [' '..'}']; { Init sets }π Lowercase := ['a'..'z'];π IF GetReal THEN Numerics := ['-','.','0'..'9','E','e']π ELSE Numerics := ['-','0'..'9'];π Cursor := '_'; Dot := '.';π CR := False; Escape := False;π FillChar(ClearIt,SizeOf(ClearIt),'.'); { Fill the clear string }π ClearIt[0] := Chr(MaxLen); { Set clear string to MaxLen }ππ { Convert numbers to string if required: }π IF Numeric THEN { Convert zero values to null string: }π IF (GetReal AND (RValue = 0.0)) ORπ (NOT GetReal AND (IValue = 0)) THEN XString := ''π ELSE { Convert nonzero values to string equiv: }π IF GetReal THEN Str(RValue:MaxLen,XString)π ELSE Str(IValue:MaxLen,XString);ππ { Truncate string value to MaxLen }π IF Length(XString) > MaxLen THEN XString[0] := Chr(MaxLen);π GotoXY(X,Y); Write('|',ClearIt,'|'); { Draw the field }π GotoXY(X+1,Y); Write(XString);π IF Length(XString)<MaxLen THENπ BEGINπ GotoXY(X + Length(XString) + 1,Y);π Write(Cursor) { Draw the Cursor }π END;π Worker := XString; { Fill work string with input string }ππ REPEAT { Until ESC or (CR) entered }π { Wait here for keypress: }π WHILE NOT KeyPressed DO BEGIN {NULL} END;π Ch := ReadKey;ππ IF Ch IN Printables THEN { If Ch is printable... }π IF Length(Worker) >= MaxLen THEN UhUh ELSEπ IF Numeric AND (NOT (Ch IN Numerics)) THEN UhUh ELSEπ BEGINπ IF Ch IN Lowercase THEN IF Capslock THEN Ch := Chr(Ord(Ch)-32);π Worker := CONCAT(Worker,Ch);π GotoXY(X+1,Y); Write(Worker);π IF Length(Worker) < MaxLen THEN Write(Cursor)π ENDπ ELSE { If Ch is NOT printable... }π CASE Ord(Ch) OFπ 8,127 : IF Length(Worker) <= 0 THEN UhUh ELSEπ BEGINπ Delete(Worker,Length(Worker),1);π GotoXY(X+1,Y); Write(Worker,Cursor);π IF Length(Worker) < MaxLen-1 THEN Write(Dot);π END;ππ 13 : CR := True; { Carriage return }ππ 24 : BEGIN { CTRL-X : Blank the field }π GotoXY(X+1,Y); Write(ClearIt);π Worker := ''; { Blank out work string }π END;ππ 27 : Escape := True; { ESC }π ELSE UhUh { CASE ELSE }π END; { CASE }ππ UNTIL CR OR Escape; { Get keypresses until (CR) or }π { ESC pressed }π GotoXY(X + 1,Y); Write(ClearIt);π GotoXY(X + 1,Y); Write(Worker);π IF CR THEN { Don't update XString if ESC hit }π BEGINπ XString := Worker;π IF Numeric THEN { Convert string to Numeric values }π CASE GetReal OFπ True : Val(Worker,RValue,Error);π False : Val(Worker,IValue,Error)π END { CASE }π ELSEπ BEGINπ RValue := 0.0;π IValue := 0π ENDπ ENDπEND; { GETString }π 7 01-27-9412:04ALL JEFF FANJOY Key Input Routine IMPORT 73 3 > Does anyone know how to make the input line a certain number of linesπ> only!...sya the user only gets to us 3 characters....ππHere is the input routine that I use for all of my programs. You mayπnot need it so precise, so you can cut out anything you don't feel isπnecessary but here goes:π}ππUNIT KeyInput;ππINTERFACEππUSES CRT,CURSOR;ππPROCEDURE GetInput(VAR InStr; {String Passed}π WhatWas: String; {Old value to Remember}π Len: Byte; {Length of String Max=255}π XPosition, {X Cursor Position}π YPosition, {Y Cursor Position}π BackGroundColor, {Background Color}π ForeGroundColor: Integer; {Foreground Color}π BackGroundChar: Char; {Echoed Character on BkSp}π Caps: Boolean); {CAPS?}πIMPLEMENTATIONππPROCEDURE GetInput(VAR InStr;π WhatWas: String;π Len: Byte;π XPosition,π YPosition,π BackGroundColor,π ForeGroundColor: Integer;π BackGroundChar: Char;π Caps: Boolean);ππCONSTπ BkSp: Char = Chr($08);ππVARπ InsertKey: Byte Absolute $0040:$0017;π Temp: String;π Ch2,π C: Char;π A,π U,π B: Byte;π FirstChar,π InsertOn,π NoAdd: Boolean;π NewString: String Absolute InStr;ππBEGINπ InsertKey := InsertKey OR $80; {changes to insert mode}π IF (InsertKey AND $80 > 0) THENπ BEGINπ InsertOn := TRUE;π ShowCursor;π ENDπ ELSEπ BEGINπ InsertOn := FALSE;π BigCursor;π END;π FirstChar := TRUE;π NewString := '';π Temp := '';π GotoXY(XPosition,YPosition);π TextBackGround(BackGroundColor);π TextColor(ForeGroundColor);π FOR U := 1 TO Len DOπ BEGINπ Write(BackGroundChar); {shows how many characters are available}π END;π GotoXY(XPosition,YPosition);π C := Chr($00); {null character input}π TextBackGround(ForeGroundColor);π TextColor(BackGroundColor);π NewString := WhatWas; {starts with previous value in memory}π Write(NewString); {writes previous value to screen for editing}π B := Length(WhatWas);π A := B;π TextBackGround(BackGroundColor);π TextColor(ForeGroundColor);π WHILE (C <> Chr($0D)) AND (C <> Chr($1B)) DO {not CR or ESC}π BEGINπ NoAdd := FALSE;π IF Caps THEN C := UpCase(ReadKey) {if Caps read uppercase else...}π ELSE C := ReadKey;π CASE C OFπ Chr($08): IF B >= 1 THEN {backspace}π BEGINπ IF FirstChar THENπ BEGINπ FirstChar := FALSE;π GotoXY(XPosition,YPosition);π Write(NewString);π END;π Delete(NewString,B,1);π Write(BkSp,BackGroundChar,BkSp);π Dec(B);π GotoXY(XPosition+B,WhereY);π FOR U := B TO Length(NewString) DOπ BEGINπ IF B <> U THEN Temp := Temp + NewString[U]π ELSE Temp := '';π END;π Write(Temp);π FOR U := Length(NewString)+1 TO Len DOπ BEGINπ Write(BackGroundChar);π END;π GotoXY(XPosition+B,WhereY);π NoAdd := TRUE;π Dec(A);π END;π Chr($1B): BEGIN {Escape}π NoAdd := TRUE;π NewString := WhatWas;π END;π Chr($19): BEGIN {^Y = clear the editing line}π NoAdd := TRUE;π NewString := '';π GotoXY(XPosition,YPosition);π FOR U := 1 TO Len DOπ BEGINπ Write(BackGroundChar);π END;π FirstChar := FALSE;π GotoXY(XPosition,YPosition);π B := 0;π A := 0;π END;π Chr($0D): NoAdd := TRUE; {enter <CR>}π Chr($00): BEGIN {extended keys always start with null character}π NoAdd := TRUE;π IF FirstChar THENπ BEGINπ FirstChar := FALSE;π GotoXY(XPosition,YPosition);π Write(NewString);π END;π C := UpCase(ReadKey);π CASE C OFπ Chr(77): BEGIN {right arrow}π IF B <= Length(NewString)-1 THENπ BEGINπ GotoXY(XPosition+B+1,WhereY);π Inc(B);π END;π END;π Chr(75): BEGIN {left arrow}π IF B >= 1 THENπ BEGINπ GotoXY(XPosition+B-1,WhereY);π Dec(B);π END;π END;π Chr(71): BEGIN {home}π GotoXY(XPosition,YPosition);π B := 0;π END;π Chr(79): BEGIN {end}π GotoXY(XPosition+Length(NewString),YPosition);π B := Length(NewString);π END;π Chr(82): BEGIN {insert}π IF InsertOn THENπ BEGINπ InsertOn := FALSE;π BigCursor;π ENDπ ELSEπ BEGINπ InsertOn := TRUE;π ShowCursor;π END;π END;π Chr(83): BEGIN {del}π IF (B < Length(NewString)) AND (B >= 0) THENπ BEGINπ Delete(NewString,B+1,1);π FOR U := B TO Length(NewString) DOπ BEGINπ IF U <> B THEN Temp := Temp + NewString[U]π ELSE Temp := '';π END;π GotoXY(XPosition+B,WhereY);π Write(Temp);π Write(BackGroundChar);π GotoXY(XPosition+B,WhereY);π Dec(A);π END;π END;π END;π WHILE Keypressed DO C := ReadKey;π END;π END;π IF ((A < Len) AND (NoAdd = FALSE) AND (C <> Chr($08))) OR ((FirstChar) ANDπ (NOT(NoAdd)) AND (C <> Chr($08))) THENπ BEGINπ IF FirstChar THEN {if first character typed is a real character,thenπ string is removed to start new one else...}π BEGINπ Delete(NewString,1,Length(NewString));π GotoXY(XPosition,YPosition);π B := 0;π A := 0;π FOR U := 1 TO Len DOπ BEGINπ Write(BackGroundChar);π END;π GotoXY(XPosition,YPosition);π FirstChar := FALSE;π END;π Inc(B);π Inc(A);π IF InsertOn THENπ BEGINπ Insert(C,NewString,B);π FOR U := B TO Length(NewString) DOπ BEGINπ IF B <> U THEN Temp := Temp + NewString[U]π ELSE Temp := '';π END;π GotoXY(XPosition+B-1,WhereY);π Write(C);π Write(Temp);π GotoXY(XPosition+B,WhereY);π ENDπ ELSEπ BEGINπ Insert(C,NewString,B);π Delete(NewString,B+1,1);π Write(C)π END;π END;π END;π TextBackGround(0);πEND;πππBEGINπEND.ππ 8 01-27-9412:13ALL BERNIE PALLEK Masked Input IMPORT 22 3 {π> The text on the screen would be something like:π> What is your phone number? ( ) -π> ^^^ ^^^ ^^^^π> But text could only be entered at the marked locations. As soon as oneπ> section is full it would move to the one beside it but read in a differentπ> variable..ππHow about this: (it's tested, BTW)π}ππUSES Crt;ππVARπ ts : String;ππPROCEDURE MaskedReadLn(VAR s : String; mask : String; fillCh : Char);π{ in 'mask', chars with A will only accept alpha input, and charsπ with 0 will only accept numeric input; spaces accept anything }πVAR ch : Char; sx, ox, oy : Byte;πBEGINπ s := ''; ox := WhereX; oy := WhereY; sx := 0;π REPEATπ Inc(sx);π IF (mask[sx] IN ['0', 'A']) THENπ Write(fillCh)π ELSE IF (mask[sx] = '_') THENπ Write(' ')π ELSE Write(mask[sx]);π UNTIL (sx = Length(mask));π sx := 0;π WHILE (NOT (mask[sx + 1] IN [#32, '0', 'A']))π AND (sx < Length(mask)) DO BEGINπ Inc(sx);π s := s + mask[sx];π END;π GotoXY(ox + sx, oy);π REPEATπ ch := ReadKey;π IF (ch = #8) THEN BEGINπ IF (Length(s) > sx) THEN BEGINπ IF NOT (mask[Length(s)] IN [#32, '0', 'A']) THEN BEGINπ REPEATπ s[0] := Chr(Length(s) - 1);π GotoXY(WhereX - 1, WhereY);π UNTIL (Length(s) <= sx) OR (mask[Length(s)] IN [#32, '0', 'A']);π END;π s[0] := Chr(Length(s) - 1); GotoXY(WhereX - 1, WhereY);π Write(fillCh); GotoXY(WhereX - 1, WhereY);π END ELSE BEGINπ Sound(440);π Delay(50);π NoSound;π END;π END ELSE IF (Length(s) < Length(mask)) THEN BEGINπ CASE mask[Length(s) + 1] OFπ '0' : IF (ch IN ['0'..'9']) THEN BEGINπ Write(ch);π s := s + ch;π END;π 'A' : IF (UpCase(ch) IN ['A'..'Z']) THEN BEGINπ Write(ch);π s := s + ch;π END;π #32 : BEGINπ Write(ch);π s := s + ch;π END;π END;π WHILE (Length(s) < Length(mask))π AND (NOT (mask[Length(s) + 1] IN [#32, '0', 'A'])) DO BEGINπ IF (mask[Length(s) + 1] = '_') THEN s := s + ' ' ELSEπ s := s + mask[Length(s) + 1];π GotoXY(WhereX + 1, WhereY);π END;π END;π UNTIL (ch IN [#13, #27]);πEND;ππBEGINπ ClrScr;π Write('Enter phone number: ');π MaskedReadLn(ts, '(000)_000-0000', '_');π WriteLn;π Write('Enter postal code: ');π MaskedReadLn(ts, 'A0A_0A0', '_');π WriteLn;πEND.ππ{πIt can be improved with colours and such stuff, but it may suit yourπneeds without enhancement. If you have questions about how this works,πfeel free to ask.π}ππ 9 02-03-9409:58ALL LOU DUCHEZ DATABOX.PAS IMPORT 121 3 unit databox;ππ{ This is a unit to let you open data-entry boxes on the screen for quick 'n'π easy data entry. It operates on variables of type "string", "integer",π "word", "byte", "longint" and "boolean". There are two main routines toπ call here:ππ OpenBox(x, y, data, temp, type) -- to open a data entry box on the screenπ ReadBoxes -- to read all data entry boxesππ The parameters for "OpenBox":π x, y -- the coordinates where the box should appear on the screenπ data -- the variable you want to do data entry onπ type -- an character indicating what type of variable you're working on.π Valid "types" are:ππ 'S' -- String 'I' -- Integerπ 'W' -- Word 'L' -- LongIntπ 'Y' -- Byte 'B' -- Booleanππ temp -- a string "template" indicating the size of the data entryπ field and the data acceptable at each position. The followingπ characters mean the following:ππ 'X' -- accept any character ( strings )π '!' -- accept any character, but capitalize ( strings )π '9' -- accept only digits and minus signs ( numeric )π 'T' -- accept only 'T' and 'F' ( boolean )π 'Y' -- accept only 'T', 'F', 'Y' and 'N' ( boolean )ππ All of these template characters are valid on strings. Forπ numeric fields, the whole template gets converted to all 9's;π for boolean, the template will either be a single 'T' or 'Y'π (it defaults to 'T').ππ Examples:ππ OpenBox(12, 10, counter, '99999', 'I');ππ -- is for an integer variable "counter". It opens a data entry box atπ position (12, 10), and is five characters across.ππ OpenBox(1, 14, yes_or_no, 'Y', 'b')ππ -- opens a data entry box for a boolean variable "yes_or_no", and willπ accept only a "Y" or an "N" as input.ππ OpenBox(1, 25, namestring, '!XXXXXXXXXXXXXXXX', 's')ππ -- opens a data entry box for a string variable "namestring"; it willπ automatically capitalize the first letter, and accept every otherπ character entered "as is".ππ When you have opened all your data boxes, call "ReadBoxes" to allowπ the user to actually input into the boxes. Once you are done, theπ boxes "close" so you can't do any more data entry on them. There isπ also a "ClearBoxes" procedure to manually "close" open boxes, and aπ "Qwrite" procedure for doing direct video writes.ππ Oh, I'm Lou Duchez, and if you could leave my name somewhere in theπ code I'd appreciate it. I'll never be rich off of public domain codeπ like this, so at least help me get famous ...π }π{π-------------------------------------------------------π}πinterfaceππconst boxforeground: byte = 1;π boxbackground: byte = 7;ππprocedure qwrite(x, y: byte; s: string; f, b: byte);πprocedure openbox(x, y: byte; var data; template: string; datatype: char);πprocedure clearboxes;πprocedure readboxes;π{π-------------------------------------------------------π}πimplementationπuses crt; { for "checkbreak" and "readkey" functions }ππconst maxboxes = 255; { open up to 255 data boxes simultaneously }ππtype boxrecord = record { holds all the data we need }π x, y: byte; { position to display on screen }π template: string; { describes size and type of data field }π dataptr: pointer; { points to data }π datatype: char; { type of data we're pointing to }π end;ππvar boxes: array[1 .. maxboxes] of ^boxrecord; { all the data boxes }π boxcount, thisbox, boxpos, boxlength: byte;π boxstring: string;π boxmodified: boolean;π{π-------------------------------------------------------π}πprocedure qwrite(x, y: byte; s: string; f, b: byte); { direct video writes }ππ{ x, y: coordinates to display string at }π{ s: the string to display }π{ f, b: the foreground and background colors to display in }ππtype videolocation = record { video memory locations }π videodata: char; { character displayed }π videoattribute: byte; { attributes }π end;ππvar cnter: byte;π videosegment: word;π vidptr: ^videolocation;π videomode: byte absolute $0040:$0049;π scrncols: byte absolute $0040:$004a;π monosystem: boolean;πbeginππ{ Find the memory location where the string will be displayed at, according toπ the monitor type and screen location. Then associate the pointer VIDPTR withπ that memory location: VIDPTR is a pointer to type VIDEOLOCATION. Insert theπ screen data and attribute; now go to the next character and video location. }ππ monosystem := (videomode = 7);π if monosystem then videosegment := $b000 else videosegment := $b800;π vidptr := ptr(videosegment, 2*(scrncols*(y - 1) + (x - 1)));π for cnter := 1 to length(s) do beginπ vidptr^.videoattribute := (b shl 4) + f;π vidptr^.videodata := s[cnter];π inc(vidptr);π end;π end;π{π-------------------------------------------------------π}πprocedure movecursor(boxnum, position: byte); { Positions cursor. }πvar tmpx, tmpy: byte;πbeginπ tmpx := (boxes[boxnum]^.x - 1) + (position - 1);π tmpy := (boxes[boxnum]^.y - 1);π asmπ mov ah, 02h { Move cursor here. I don't use GOTOXY because it }π mov bh, 00h { is window-dependent. }π mov dh, tmpyπ mov dl, tmpxπ int 10hπ end;π end;π{π-------------------------------------------------------π}πprocedure openbox(x, y: byte; var data; template: string; datatype: char);πvar i: byte;π datastring, tempstring: ^string;πbeginπ if boxcount < maxboxes then begin { If we have room for another data }π inc(boxcount); { box, allocate memory for it from }π new(boxes[boxcount]); { the heap and fill its fields. }π boxes[boxcount]^.x := x;π boxes[boxcount]^.y := y;π boxes[boxcount]^.dataptr := @data;π boxes[boxcount]^.template := template;π boxes[boxcount]^.datatype := upcase(datatype);π case upcase(datatype) ofππ { "Fix" data entry template as needed. Make sure the string data andπ the template are of the same length. Numeric templates should consistπ of all 9's. Boolean templates should be either 'Y' or 'T'. }ππ 'S': beginπ datastring := boxes[boxcount]^.dataptr;π tempstring := addr(boxes[boxcount]^.template);π while length(datastring^) < length(tempstring^) doπ datastring^ := datastring^ + ' ';π while length(tempstring^) < length(datastring^) doπ tempstring^ := tempstring^ + ' ';π end;π 'W', 'I', 'L', 'Y': for i := 1 to length(template) doπ boxes[boxcount]^.template[i] := '9';π 'B': beginπ boxes[boxcount]^.template[0] := #1;π if not (boxes[boxcount]^.template[1] in ['Y', 'T']) thenπ boxes[boxcount]^.template := 'T';π end;π end;π end;π end;π{π-------------------------------------------------------π}πprocedure clearboxes; { Free up all memory for "box" data. }πbeginπ while boxcount > 0 do beginπ dispose(boxes[boxcount]);π dec(boxcount);π end;π end;π{π-------------------------------------------------------π}πprocedure fixstring(boxnumber: byte); { Adjusts string for displaying }πvar i: byte; { so that each character adheres to }πbegin { the corresponding template char. }π for i := 1 to length(boxstring) doπ case upcase(boxes[boxnumber]^.template[i]) ofπ 'X': ;π '!': boxstring[i] := upcase(boxstring[i]);π '9': if not (boxstring[i] in ['-', '0' .. '9']) then boxstring[i] := ' ';π 'T': case upcase(boxstring[i]) ofπ 'Y', 'T': boxstring[i] := 'T';π 'N', 'F': boxstring[i] := 'F';π else boxstring[i] := ' ';π end;π 'Y': case upcase(boxstring[i]) ofπ 'Y', 'T': boxstring[i] := 'Y';π 'N', 'F': boxstring[i] := 'N';π else boxstring[i] := ' ';π end;π end;π qwrite(boxes[boxnumber]^.x, boxes[boxnumber]^.y, boxstring,π boxforeground, boxbackground);π end;π{π-------------------------------------------------------π}πprocedure displaybox(boxnumber: byte); { Convert data to string and display. }πvar lentemplate: byte;π pntr: pointer;πbeginπ pntr := boxes[boxnumber]^.dataptr;π lentemplate := length(boxes[boxnumber]^.template);π case boxes[boxnumber]^.datatype ofπ 'S': boxstring := string(pntr^);π 'I': str(integer(pntr^): lentemplate, boxstring);π 'W': str(word(pntr^): lentemplate, boxstring);π 'Y': str(byte(pntr^): lentemplate, boxstring);π 'L': str(longint(pntr^): lentemplate, boxstring);π 'B': if boolean(pntr^) then boxstring := 'T' else boxstring := 'F';π end;π fixstring(boxnumber);π end;π{π-------------------------------------------------------π}πprocedure deletekey; { delete: remove character at cursor and shift over }πvar i: byte;πbeginπ boxmodified := true;π for i := boxpos to boxlength - 1 do boxstring[i] := boxstring[i + 1];π boxstring[boxlength] := ' ';π end;ππprocedure backspace; { backspace: back up one and delete if we're }πbegin { still in the same box }π boxpos := boxpos - 1;π if boxpos = 0 then beginπ dec(thisbox);π boxpos := 255;π endπ else deletekey;π end;ππ{ Enter, Tab, and Shift-Tab move you to the beginning of prev/next box }ππprocedure enterkey; begin inc(thisbox); boxpos := 1; end;πprocedure tab; begin inc(thisbox); boxpos := 1; end;πprocedure reversetab; begin dec(thisbox); boxpos := 1; end;ππ{ PgUp, PgDn, Esc take you out of editing; "Esc" indicates that theπ "current" box should not be updated }ππprocedure pageup; begin thisbox := 0; end;πprocedure pagedown; begin thisbox := 0; end;πprocedure esckey; begin thisbox := 0; boxmodified := false; end;ππ{ Up / Down }ππprocedure moveup; begin dec(thisbox); end;πprocedure movedown; begin inc(thisbox); end;ππprocedure moveleft; { Move left; if we go too far left, move up }πbeginπ dec(boxpos);π if (boxpos = 0) then beginπ boxpos := 255;π moveup;π end;π end;ππprocedure moveright; { Move right; if we go too far right, move down }πbeginπ inc(boxpos);π if (boxpos > boxlength) then beginπ boxpos := 1;π movedown;π end;π end;ππprocedure literalkey(keyin: char); { accept character into field }πvar i: byte;π goodkey, insmode: boolean;π keyboardstat: byte absolute $0040:$0017;πbeginπ case upcase(boxes[thisbox]^.template[boxpos]) of { does char match tmplt? }π '9': goodkey := (keyin in ['-', '0'..'9']);π 'T': goodkey := (upcase(keyin) in ['T', 'F']);π 'Y': goodkey := (upcase(keyin) in ['T', 'F', 'Y', 'N']);π else goodkey := true;π end;π if goodkey then begin { character matches template -- use it }π boxmodified := true;π insmode := (keyboardstat and $80 = $80);π if insmode then beginπ i := length(boxstring); { "Insert" mode: make space for new char }π while i > boxpos do beginπ boxstring[i] := boxstring[i - 1];π dec(i);π end;π end;π boxstring[boxpos] := keyin; { enter character and move to the right }π moveright;π end;π end;π{π-------------------------------------------------------π}πprocedure readbox; { get data input on the box specified by THISBOX }πvar keyin: char;π startingbox, i: byte;π pntr: pointer;π dummyint: integer;π numstring: string;πbeginπ boxmodified := false; { "housekeeping" here }π startingbox := thisbox;π displaybox(thisbox);π boxlength := length(boxstring);π if boxpos > boxlength then boxpos := boxlength; { cursor positioning }π if boxpos < 1 then boxpos := 1;π while (thisbox = startingbox) andπ (boxpos >= 1) and (boxpos <= boxlength) do begin { process field }π fixstring(startingbox);π movecursor(startingbox, boxpos);π keyin := readkey; { Interpret keystrokes here }π case keyin ofπ #0: case readkey ofπ #15: reversetab;π #72: moveup;π #73: pageup;π #75: moveleft;π #77: moveright;π #80: movedown;π #81: pagedown;π #83: deletekey;π end;π #8: backspace;π #9: tab;π #13: enterkey;π #27: esckey;π else literalkey(keyin);π end;π end;π if boxmodified then begin { If data was changed, update variable }ππ { This section handles numeric decoding. Since "Val" gets real uppityπ if there are spaces in the middle of your string, these couple loopsπ isolates the first section of the data entry string surrounded byπ spaces. Then "Val" processes that part. }ππ i := 1;π while (i <= length(boxstring)) and (boxstring[i] = ' ') do inc(i);π numstring[0] := #0;π while (i <= length(boxstring)) and (boxstring[i] <> ' ') do beginπ inc(numstring[0]);π numstring[length(numstring)] := boxstring[i];π inc(i);π end;π pntr := boxes[startingbox]^.dataptr;ππ { Put the updated data back into its original variable. }ππ case boxes[startingbox]^.datatype ofπ 'S': string(pntr^) := boxstring;π 'I': val(numstring, integer(pntr^), dummyint);π 'W': val(numstring, word(pntr^), dummyint);π 'Y': val(numstring, byte(pntr^), dummyint);π 'L': val(numstring, longint(pntr^), dummyint);π 'B': boolean(pntr^) := (upcase(boxstring[1]) = 'Y') orπ (upcase(boxstring[1]) = 'T');π end;π end;ππ { Do a final data display. }ππ displaybox(startingbox);π movecursor(startingbox, boxlength + 1);π end;π{π-------------------------------------------------------π}πprocedure readboxes; { gets data input on all boxes }πvar oldcheckbreak: boolean;πbeginπ oldcheckbreak := checkbreak;π checkbreak := false;π for thisbox := 1 to boxcount do displaybox(thisbox); { display data boxes }π thisbox := 1;π boxpos := 1;π while (thisbox >= 1) and (thisbox <= boxcount) do readbox;π clearboxes;π checkbreak := oldcheckbreak;π end;π{π-------------------------------------------------------π}πbegin { initialize to "no boxes" }π boxcount := 0;π end.ππ==============================================================================πTEST PROGRAM:π==============================================================================πprogram datatest;πuses databox, crt;ππvar i: integer; s: string; w: word;π b: boolean; l: longint; y: byte;ππbeginπ clrscr;π i := 10; openbox(1, 1, i, '999999', 'i');π w := 10; openbox(1, 3, w, '999999', 'w');π s := 'SpamBurger'; openbox(1, 5, s, '!xxxxxxxxxxxxxxx', 's');π readboxes;π gotoxy(1, 18); writeln(i); writeln(w); writeln(s);ππ b := false; openbox(1, 7, b, 'Y', 'b');π l := 10; openbox(1, 9, l, '9999999999', 'l');π y := 20; openbox(1,11, y, '9999999999', 'y');π readboxes;π gotoxy(1, 21); writeln(b); writeln(l); writeln(y);π end.π 10 05-25-9408:13ALL JUSTIN FERGUSON FergSoft! ReadLn SWAG9405 61 3 {π Ok, y'all, here's a function I've been working on for a while, andπ I thought I'd post it for everybody. It's a modified ReadLnπ routine, and while there's no guarantees, <What's new?>, I _think_π it's bug free. <Crossing fingers> If y'all want to use it, goπ ahead, but I would like some credit, 'cuz it took me a while. Justπ credit FergSoft!, Artificial Reality, Whizard, or Justin Ferguson.π It's fairly well commented, but just throw any questions you mayπ have my way...ππ--- Cut Here ---π}ππunit FSRead;ππ{------------------------------------------------------------------------}π{π FergSoft! ReadLn Routine:ππ By Justin Ferguson of FergSoft!,π a. k. a. Whizard of Artificial Reality.ππ FSReadLn reads a string of specified length, at specifiedπ location, in specified colors, terminated by TAB or Enter.ππ Feel free to use this little unit anywhere y'all want, just giveπ credit for it.πππ Thanx, Whizardππ }π{------------------------------------------------------------------------}ππINTERFACEππuses Crt;ππFunction FSReadLn (X, {X Location}π Y, {Y Location}π FC, {Foreground Color}π BC, {Background Color}π StrLength : Byte; {Length of string to input. Will beπ padded with spaces (#32). }ππ Default : String {Default string, leave '' for noπ default }π ) : String;ππ{------------------------------------------------------------------------}ππIMPLEMENTATIONππFunction FSReadLn (X, Y, FC, BC, StrLength : Byte; Default : String)π : String;ππvar Temp : String; {Temporary string}π Location : Byte; {Current location in string}π QuitFlag, InsFlag : Boolean; {Flags}π Ch : Char; {Current Character}π Z : Integer; {Temp variable}π Cursor : Word absolute $0040:$0060; {Cursor format}ππbeginπ QuitFlag := False;π InsFlag := True;ππ For Z := 1 to 255 do {Clear string to spaces}π Temp[Z] := ' ';ππ For Z := 1 to Length(Default) do {Set to default string}π Temp[Z] := Default[Z];ππ Temp[0] := Chr(StrLength); {Set length of string}π Location := 1;π Ch := #1;π Temp[StrLength + 1] := #32;π GotoXY(X, Y);π Write(Temp);ππ Repeatπ Case Ch ofπ #32..#127 : begin {Regular ASCII}π If InsFlag = False thenπ beginπ If Location <= StrLength thenπ beginπ Location := Location + 1;π Temp[Location] := Ch;π end;π endπ elseπ beginπ If Location <= StrLength thenπ beginπ For Z := StrLength - 1 downtoπ Location doπ Temp[Z + 1] := Temp[Z];ππ Temp[Location] := Ch;π Location := Location + 1;π end;π end;π end;π #27 : begin {ESC}π For Z := 1 to StrLength doπ Temp[Z] := ' ';π Location := 1;π end;π #9, #13 : QuitFlag := True; {Tab}{Enter}π #8 : begin {Backspace}π If Location > 1 thenπ beginπ Location := Location - 1;π For Z := Location to StrLength doπ beginπ Temp[Z] := Temp[Z + 1];π end;π end;π end;ππ #0 : begin {Extended keys... }π Ch := ReadKey;π Case Ch ofππ #75 : begin {Left arrow}π If Location > 1 thenπ Location := Location - 1;π end;π #77 : begin {Right arrow}π If Location < (StrLength - 1) thenπ Location := Location + 1;π end;π #71 : Location := 1; {Home}π #79 : Location := StrLength; {End}π #82 : If InsFlag = True {Insert}π thenπ beginπ InsFlag := False;π asmπ MOV AH, $01π MOV CX, $0Fπ INT $10π end;π endπ elseπ beginπ InsFlag := True;π asmπ MOV AH, $01π MOV CL, $07π MOV CH, $06π INT $10π end;π end;π {Delete}π #83 : For Z := Location to StrLength doπ Temp[Z] := Temp[Z + 1];π end;π end;π end;ππ Temp[StrLength + 1] := #32;π GotoXY(X, Y);π Write(Temp);ππ TextColor(12);π GotoXY(79, 25);π If InsFlag = True then Write('I') else Write(' ');π {Note: Take out above 3 lines to not put an insertπ status 'I' at the bottom of the screen }ππ TextColor(FC);π TextBackground(BC);π GotoXY(X + Location - 1, Y);π If QuitFlag <> True then Ch := ReadKey;ππ until QuitFlag = True;ππ Temp[0] := Chr(StrLength);πend;ππ{--------------------------------------------------------------------------}ππbeginπend.π 11 05-25-9408:20ALL RICHARD FURMAN Readline Function SWAG9405 17 3 {πThe Readln statement can't really be used here, because this interchange isπtaking place in Graphics mode. I am writing a Graphics application thatπdoes take user inputπ}πFunction KBString:String; {* Gets string from keyboard using Scankey *}π Varπ bu,X,Inchar:Integer;π STRBUFF:STRING;π beginπ STRBUFF := '';π X:=20;π Repeatπ Inchar := Scankey;π IF FK and (Inchar = 60) thenπ Beginπ Cancel := True;π Exit;π End;π setcolor(0);π setlinestyle (0,0,1);π Rectangle(15,70,X+5,90);π setcolor(BLDCLR);π If Not FK then outtextxy (x,77,CHR(INCHAR));π If inchar <> 8 thenπ Beginπ X := X+ Textwidth(CHR(INCHAR));π setcolor(txtclr);π Rectangle(15,70,X+5,90);π Endπ elseπ beginπ setcolor(0);π setlinestyle (0,0,1);π Rectangle(15,70,X+5,90);π x:=x-textwidth(Strbuff[length(strbuff)]);π outtextxy(X,77,strbuff[length(strbuff)]);π setcolor(txtclr);π Rectangle(15,70,x+5,90);π Delete(Strbuff,Length(Strbuff),1);π setcolor(BLDCLR);π End;π If (Not FK) and (Inchar <> 8) then STRBUFF := STRBUFF +π CHR(Inchar);π Until inchar = 13;π Delete(strBuff,Length(StrBuff),1);π setcolor(txtclr);π KBString := STRBUFF;π End;ππThis code snippet should give you some ideas on getting user input. BTWπSCANKEY is a function I wrote to read the keyboard. You should be able toπuse READKEY in its place. This routine also features the ability to editπwith the backspace key. I hope it helps.π 12 05-26-9410:58ALL RICHARD GRIFFIN Simple Entry Routine IMPORT 84 3 unit GS_KeyI;ππ{ Written by Richard F Griffinππ 1 December 1988, (Released to the public domain)ππ 1110 Magnolia Circleπ Papillion, Nebraska 68128ππ CIS 75206.231ππ This unit allows you to set data entry routines quickly and simply.π It also gives the programmer the capability to override the entryπ routine and use another procedure to handle function keys.ππ}πππinterfaceππuses crt, dos;ππtypeπ GS_KeyI_str80 = string[80];ππvarπ GS_KeyI_Chr : char;π GS_KeyI_Fuc,π GS_KeyI_Esc : boolean;π GS_KeyI_Hlp : pointer;π GS_KeyI_Psn : integer;ππFunction GS_KeyI_Get : char;ππprocedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);ππfunction GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,π CVal:GS_KeyI_str80) : GS_KeyI_str80;ππfunction GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;π CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;ππfunction GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;π XVal,l,h:real;d:integer) : real;ππimplementationππvarπ Big_String : GS_KeyI_str80;ππ{$F+}πprocedure GS_KeyI_Dum;πbeginπ write(#7);πend;π{$F-}ππ{π This procedure is an Inline far call. The address is inserted byπ GS_KeyI_Call based on the address in GS_KeyI_Hlp. This address isπ initially to GS_KeyI_Dum, but may be changed by the using program.ππ ex: GS_KeyI_Hlp := @MyProcedureππ The procedure will be called when a special function key (F1, F2,π Home, RtArrow, etc.) is pressed during data entry. The using procedureπ may then use GS_KeyI_Chr to find which key was pressed. It is up to theπ using program to ensure the screen and window sizes are properly restored.π The programmer must ensure that the $F+ option is used in the procedureπ to force a Far Return.ππ ----------- DO NOT MODIFY THIS ROUTINE ------------π}ππprocedure GS_KeyI_Jmp;πbeginπ InLine ($9A/$00/$00/$00/$00); {CALLF [GS_KeyI_Hlp]}πend;ππ{π Inserts a Far Call address for GS_KeyI_Jmp.π Works in TP 4 and 5.π}ππprocedure GS_KeyI_Call;πbeginπ MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+11] := ofs(GS_KeyI_Hlp^);π MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+13] := seg(GS_KeyI_Hlp^);π GS_KeyI_Jmp;πend;ππFunction GS_KeyI_Get : char;πvar ch: char;πbeginπ Ch := ReadKey;π If (Ch = #0) then { it must be a function key }π beginπ Ch := ReadKey;π GS_KeyI_Fuc := true;π endπ else GS_KeyI_Fuc := false;π GS_KeyI_Get := Ch;πend;ππprocedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);πVarπ Big_S : GS_KeyI_str80;π i : integer;πbeginπ Big_s := '';π GS_KeyI_Psn := 0;π gotoxy(x,y);π Repeatπ GS_KeyI_Chr := GS_KeyI_Get;π GS_KeyI_Esc := false;π if not GS_KeyI_Fuc thenπ beginπ case GS_KeyI_Chr ofπ #08 : beginπ If GS_KeyI_Psn > 0 thenπ beginπ GS_KeyI_Psn := GS_KeyI_Psn - 1;π gotoxy(x+GS_KeyI_Psn,y);π write('_');π gotoxy(x+GS_KeyI_Psn,y);π delete(Big_S,length(Big_S),1);π end elseπ beginπ write('_');π gotoxy(x+GS_KeyI_Psn,y);π end;π end;π ' '..'}' : beginπ if (GS_KeyI_Psn = Fldcnt) and (wait) thenπ write(#7)π else beginπ if GS_KeyI_Psn = 0 thenπ beginπ for i := 1 to Fldcnt do write('_');π gotoxy(x,y);π end;π GS_KeyI_Psn := GS_KeyI_Psn + 1;π write(GS_KeyI_Chr);π Big_S := Big_S + GS_KeyI_Chr;π end;π end;π #27 : beginπ Big_S := ' ';π GS_KeyI_Esc := true;π end;π end;π end elseπ beginπ GS_KeyI_Call;π gotoxy(x+GS_KeyI_Psn,y);π end;π until (GS_KeyI_Chr in [#13,#27]) or ((GS_KeyI_Psn = Fldcnt) and (not wait));π Big_String := Big_S;πend;ππ{ The GS_KeyI_T function will process an input from the keyboard and displayπ it on the screen in a specified location. The length of the input field isπ given, as well as a default entry. The default entry is optionally shownπ on the screen.ππ Parameter descriptions are:ππ 1 Boolean flag to determine whether to wait for a carriage returnπ once the field is full.ππ 2 Length of input field.ππ 3 Horizontal location to start.ππ 4 Vertical position to start.ππ 5 Vertical line to place default value. Should be 0 to inhibitπ display of default. Will usually be the same as (4).ππ 6 The prompt to place on the screen prior to the data entry field.π Should be '' if no prompt.ππ 7 Default value.ππ}πππfunction GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,π CVal:GS_KeyI_str80) : GS_KeyI_str80;πvarπ i : integer;πbeginπ GS_KeyI_T := '';π gotoxy(x,y);π write(CTitl);π for i := 1 to Fl do write('_');π if B <> 0 thenπ beginπ gotoxy(x+length(CTitl),B);π write(CVal);π end;π GS_KeyI_Key(waitcr,FL,x+length(CTitl),y);π if Big_String = '' then Big_String := CVal;π if GS_KeyI_Esc then Big_String := ' ';π gotoxy(x+length(CTitl),y);π write(Big_String,'':Fl-length(Big_String));π if (B <> 0) and (B <> Y) thenπ beginπ gotoxy(x+length(CTitl),B);π write('':length(CVal));π end;π GS_KeyI_T := Big_String;πend;ππ{ The GS_KeyI_I function will accept an integer from the keyboard and displayπ it on the screen in a specified location. The length of the input field isπ given, as well as a default entry. The default entry is optionally shownπ on the screen. A range of acceptable values is also specified.ππ Parameter descriptions are:ππ 1 Boolean flag to determine whether to wait for a carriage returnπ once the field is full.ππ 2 Length of input field.ππ 3 Horizontal location to start.ππ 4 Vertical position to start.ππ 5 Vertical line to place default value. Should be 0 to inhibitπ display of default. Will usually be the same as (4).ππ 6 The prompt to place on the screen prior to the data entry field.π Should be '' if no prompt.ππ 7 Default value.ππ 8 Lowest value acceptable.ππ 9 Highest value acceptable.ππ}πππfunction GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;π CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;πVarπ Cod, q, i : integer;π CVal : GS_KeyI_str80;ππbeginπ str(XVal:Fl,CVal);π Cod := 1;π while Cod <> 0 doπ beginπ Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);π if GS_KeyI_Esc thenπ beginπ GS_KeyI_I := XVal;π Exit;π end;π if Big_String[length(Big_String)] = ' ' thenπ Big_String := 'z';π for i := 1 to length(Big_String) doπ if Big_String[i] = ' ' then Big_String[i] := '0';π val(Big_String,q,Cod);π if Cod <> 0 thenπ beginπ write(chr(7));π end elseπ beginπ if (q < l) or (q > h) thenπ beginπ Cod := 1;π write(chr(7));π end;π end;π end;π GS_KeyI_I := q;πend;πππ{ The GS_KeyI_R function will accept a real number from the keyboard andπ display it on the screen in a specified location. The length of theπ input field is given, as well as a default entry. The default entryπ is optionally shown on the screen. A range of acceptable values isπ also specified.ππ Parameter descriptions are:ππ 1 Boolean flag to determine whether to wait for a carriage returnπ once the field is full.ππ 2 Length of input field.ππ 3 Horizontal location to start.ππ 4 Vertical position to start.ππ 5 Vertical line to place default value. Should be 0 to inhibitπ display of default. Will usually be the same as (4).ππ 6 The prompt to place on the screen prior to the data entry field.π Should be '' if no prompt.ππ 7 Default value.ππ 8 Lowest value acceptable.ππ 9 Highest value acceptable.ππ 10 Number of decimal places.ππ}πππfunction GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;π XVal,l,h:real;d:integer) : real;πVarπ Cod, i : integer;π CVal : GS_KeyI_str80;π r : real;ππbeginπ str(XVal:Fl:d,CVal);π Cod := 1;π while Cod <> 0 doπ beginπ Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);π if GS_KeyI_Esc thenπ beginπ GS_KeyI_R := XVal;π Exit;π end;π if Big_String[length(Big_String)] = ' ' thenπ Big_String := 'z';π for i := 1 to length(Big_String) doπ if Big_String[i] = ' ' then Big_String[i] := '0';π val(Big_String,r,Cod);π if Cod <> 0 thenπ beginπ write(chr(7));π end elseπ beginπ if (r < l) or (r > h) thenπ beginπ Cod := 1;π write(chr(7));π end;π end;π end;π gotoxy(x+length(CTitl),y);π str(r:Fl:d,Big_String);π write(Big_String,'':Fl-length(Big_String));π GS_KeyI_R := r;πend;ππbeginπ GS_KeyI_Hlp := @GS_KeyI_Dum;πend.ππ{---------------- DEMO PROGRAM ------------------------ }ππprogram KeyIDemo;ππuses crt, dos, GS_KeyI;ππvarπ lin : string[80];π numi : integer;π numr : real;ππ{$F+}πprocedure tst;πbeginπ window(1,20,80,24);π ClrScr;π gotoxy(20,1);π case GS_KeyI_Chr ofπ #59 : write('Function Key F1 Pressed');π #60 : write('Function Key F2 Pressed');π #61 : write('Function Key F3 Pressed');π #62 : write('Function Key F4 Pressed');π #71 : write('The Home Key was Pressed');π #79 : write('The End Key was Pressed');π elseπ write(#7);π end;π window(1,1,80,25);πend;π{$F-}ππbeginπ clrscr;π GS_KeyI_Hlp := @tst;π lin := GS_KeyI_T(true, 8,10,1,1,'Enter Text Field: ','empty');π numi := GS_KeyI_I(true, 2,10,2,2,'Enter Integer Field (0-50): ',0,0,50);π numr:= GS_KeyI_R(true, 6,10,3,3,'Enter Real Field (0-99.99): ',0,0,99.99,2);πend. 13 05-26-9411:03ALL ROBERT MASHLAN Small Input Routines IMPORT 79 3 Unit InputUn;ππ{ This is a small unit with crash proof user input routines and someπ string formating functions. Compile the DemoInput program for moreπ information on how to use these functions.ππ Robert Mashlan [71160,3067] 3/11/89 }ππInterfaceππUses Crt;ππconstπ DefaultSet = [' '..'}'];ππVarπ InverseOn : boolean;π UpcaseOn : boolean;π ValidCharSet : set of char;ππProcedure Inverse;πProcedure UnderLine;πProcedure Normal;πProcedure Goback;πFunction ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;πFunction ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;πFunction ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;πFunction Left( AnyString : string; Width : byte ) : string;πFunction Center( AnyString : string; Width : byte ) : string;ππImplementationππconstπ esc = #27;ππProcedure Inverse;πbeginπ textbackground(white);π textcolor(black);πend;ππProcedure UnderLine;πbeginπ textbackground(white);π textcolor(blue);πend;ππProcedure Normal;πbeginπ textbackground(black);π textcolor(white);πend;πππProcedure Goback;πbeginπ GotoXY(WhereX,WhereY-1);π ClrEol;πend;ππFunction Left( AnyString : string; Width : byte ) : string;πvarπ len : byte absolute AnyString;π loop : byte;πbeginπ while length( AnyString ) < Width doπ AnyString:=AnyString+' ';π len:=Width; { truncate AnyString if Needed }π Left:=AnyString;πend;ππFunction Center( AnyString : string; Width : byte ) : string;πbeginπ repeatπ if length( AnyString ) < Widthπ then AnyString:=AnyString+' ';π if length( AnyString ) < Widthπ then AnyString:=' '+AnyString;π until length( AnyString ) >= Width;π Center:=AnyString;πend;πππFunction ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;πvarπ NewString : string;π InKey,InKey2 : char;π Start : byte;π index : integer;π InsertMode : boolean;ππ Procedure Display;π beginπ GotoXY(Start,WhereY);π if InverseOnπ then Inverse;π write(left(NewString,Width));π if InverseOnπ then Normal;π GotoXY(Start+index,WhereY);π end;ππ Procedure StripSpaces( var AnyString : string );π { decrease length of AnyString until a character until a char other than a space is found }π beginπ while AnyString[ ord(AnyString[0]) ]=' ' doπ dec(AnyString[0]);π end; { Procedure }ππππbeginπ InsertMode:=false;π Start:=WhereX;π index:=0;π NewString:=Prompt;π Display;π index:=1;π if UpCaseOnπ then Inkey:=UpCase(ReadKey)π else InKey:=ReadKey;π if InKey=#0π then beginπ InKey2:=ReadKey;π if InKey2 in [#77,#82]π then NewString:=Promptπ else NewString:='';π if Inkey2=#82π then beginπ InsertMode:=true;π index:=0;π end;π end { then }π else if InKey in ValidCharSetπ then NewString:=InKeyπ else beginπ NewString:='';π index:=0;π end;π if InKey=escπ then beginπ ReadString:=Prompt;π Escape:=true;π ValidCharSet:=defaultSet;π exit;π end;π if InKey=#13π then beginπ Escape:=false;π ReadString:=Prompt;π ValidCharSet:=DefaultSet;π exit;π end;π Display;π repeatπ if UpCaseOnπ then Inkey:=Upcase(readkey)π else InKey:=ReadKey;π if (InKey in ValidCharSet)π then beginπ if not InsertModeπ then Delete(NewString,index+1,1);π insert(InKey,NewString,index+1);π if index<> Width then inc(index)π end;π if (length(NewString)<>0) and (InKey=#8) { backspace }π then beginπ Delete(NewString,index,1);π if index<>0π then dec(index);π end;π if InKey=#0π then beginπ InKey:=ReadKey;π case InKey ofπ #77 : if (index<>length(NewString)) and (' ' in ValidCharSet)π then inc(index)π else if (index+1<>Width) and (' ' in ValidCharSet)π then beginπ NewString:=NewString+' ';π inc(index);π end;π #75 : if index<>0π then if length(NewString)+1<>indexπ then dec(index)π else if NewString[index]=' 'π then beginπ NewString[0]:=succ(NewString[0]);π dec(index);π endπ else dec(index);π #83 : if length(NewString)>0 then Delete(NewString,index+1,1);π #82 : if InsertModeπ then InsertMode:=falseπ else InsertMode:=true;π end; { case }π end; { then }π if Length(NewString)>width then dec( NewString[0] );π if index >= width then dec(index);π Display;π until (InKey=#13) or (InKey=esc);π ValidCharSet:=DefaultSet;π if not ( (InKey=esc) or (length(NewString)=0))π then beginπ StripSpaces(NewString);π ReadString:=NewStringπ endπ else ReadString:=Prompt;π if InKey=escπ then Escape:=trueπ else Escape:=false;ππend; { Procedure }ππFunction ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;πvarπ NewString : string;π code : integer;π OldNum : real;π Start : byte;πbeginπ OldNum:=Prompt;π Start:=WhereX;π repeatπ GotoXY(Start,WhereY);π str( Prompt:0:2, NewString );π ValidCharSet:=['0'..'9','.','-',' '];π NewString:=ReadString( NewString, Width, Escape );π val(NewString,Prompt,code);π until Escape or (code=0);π if Escape or (code<>0)π then ReadNum:=OldNumπ else ReadNum:=Prompt;πend;ππFunction ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;πvarπ NewString : string;π code : integer;π OldNum : longint;π Start : byte;πbeginπ OldNum:=Prompt;π Start:=WhereX;π repeatπ GotoXY(Start,WhereY);π str( Prompt, NewString );π ValidCharSet:=['0'..'9','-',' '];π NewString:=ReadString( NewString, Width, Escape );π val(NewString,Prompt,code);π until Escape or (code=0);π if Escapeπ then ReadInt:=OldNumπ else ReadInt:=Prompt;πend;ππbeginπ InverseOn:=true;π UpcaseOn:=false;π ValidCharSet:=DefaultSet;πend.ππ{ ----------------------------- DEMO PROGRAM ----------------------- }πProgram DemoInputUnit;ππUsesπ Crt, InputUn;ππvarπ InKey : char;π AnyString : string;π AnyInt : longint;π AnyNum : real;π Escape : boolean;ππbeginπ ClrScr;π writeln;π Inverse;π writeln(' Text in Inverse mode ');π writeln;π Underline;π writeln(' Text in Underline mode ( if using a monochrome monitor)');π writeln;π normal;π writeln(' Back to normal ');π writeln;π writeln(' The GoBack procedure is used...(press any key)................ ');π Inkey:=readkey;π goback;π writeln(' To erase a line and write a new one (press any key) ');π InKey:=readkey;π ClrScr;π writeln(' The ReadString function takes 3 parameters');π writeln(' Function ReadString( Prompt : string; width : byte; var Escape : boolean )');π writeln(' : string;');π writeln(' Prompt is the string that is first put into the edit field.');π writeln(' This is the string that the function returns if the function is exited with');π writeln(' an Esc at any time, or a return while it is there.');π writeln(' This prompt may be edited if the right arrow or the insert key is pressed');π writeln(' on the first input, otherwise the prompt will disappear. The return key ');π writeln(' will input all the visible characters in the field and exit the function.');π writeln(' The Del, left and right arrow keys work as does the backspace.');π writeln(' The Ins key toggles the insert mode where new characters are inserted ');π writeln(' instead of written over. It is initially off.');π writeln(' Esc will also exit the function, return the prompt as the result and set ');π writeln(' the Escape parameter to true (otherwise set to false with a return');π writeln(' the width parameter sets the maximum length of the string');π writeln(' This field is highlighted in Inverse. It may be turned off by setting the');π writeln(' InverseOn to true. Another Global varible that affects this function is');π writeln(' ValidCharSet which is initially set to the set of all printable characters.');π writeln(' You can change it before calling this function, and is reset to the ');π writeln(' DefaultSet const after calling it. The InverseOn varible will convert');π writeln(' all letters to uppercase if set to true. It is initially set to false');π writeln;π repeatπ write('Input a string->');π AnyString:=ReadString('This is your prompt',20,escape);π writeln;π goback;π if escapeπ then write(' Escape Exit ');π writeln('Your string is ''',AnyString,'''');π inkey:=readkey;π goback;π write('Input an integer ( ReadInt )->');π AnyInt:=ReadInt(123,5,Escape);π writeln;π goback;π if escapeπ then write(' Escape Exit ');π writeln('Your integer is ',AnyInt);π if escape then exit;π inkey:=readkey;π goback;π write('Input a real number ( ReadNum )->');π AnyNum:=ReadNum(1.23,8,escape);π writeln;π goback;π if escapeπ then write(' Escape Exit ');π writeln('Your Number is ',AnyNum:0:5);π if escape then exit;π if not escapeπ then beginπ Inkey:=readkey;π goback;π end;π until escape;πend.ππππππ
