SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00005 INPUT AND FIELD ENTRY ROUTINES 1 05-31-9308:59ALL GAYLE DAVIS Simple Field Input IMPORT 23 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 { 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 π{ 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 (****************************************************************)π(* 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 {π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.ππ
