Output of file : ENTRY.SWG contained in archive :
ALLSWAGS.ZIP
SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00009 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 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 }ã 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.ã
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/