;************************************ ;* * ;*(C)Copyright 1986 by Paul B. Loux * ;* * ;* These routines are in the public * ;* domain, and are not to be sold * ;* for a profit. They may be freely * ;* distributed, provided that this * ;* header remains in place. Use and * ;* enjoy! PBL, CIS 72337,2073. * ;* * ;************************************ ; ; CARD FUNC EntryI() ; ; Universal integer-entry routine, ; requires PROC EntryS(), the ; universal string entry routine. ; Includes range check, a null- ; entry ok flag, and uses the ; the same XIT flag as ENTRYS. ; ; This routine takes input from ; K: in string form (through ; EntryS) and checks for legal ; value (<=65535) and other useful ; features before converting to ; an actual INT value. ; ; Use of EntryS allows the same ; user interface (ESC and ^-Z ; handling, timeouts, etc.) ; ; Parameters are self-explanatory; ; minval and maxval are the range ; limits for acceptable response ; (limted to +/-32767 of course); ; the XIT and nullok flags are 1 ; for yes and 0 for no. ; ;************************************ ; INCLUDE "ENTRYS.ACT" ; ;************************************ INT FUNC EntryI(BYTE col,row INT minval,maxval BYTE nullok, xeq,xit BYTE POINTER err_ptr) BYTE ARRAY u_limit(0)="32767", l_limit(0)="-32767", field(0)="......" BYTE fldlen=field BYTE accept,min,max,typec INT chk,tmp INT value,tmpval CARD temp,minchk,maxchk,offset min=0 IF nullok=0 THEN IF minval<0 THEN temp=-minval min==+1 ELSE temp=minval FI IF temp>0 THEN min==+1 FI IF temp>10 THEN min==+1 FI IF temp>100 THEN min==+1 FI IF temp>1000 THEN min==+1 FI IF temp>10000 THEN min==+1 FI FI max=1 IF maxval<0 THEN temp=-maxval max==+1 ELSE temp=maxval FI IF temp>0 THEN max==+1 FI IF temp>10 THEN max==+1 FI IF temp>100 THEN max==+1 FI IF temp>1000 THEN max==+1 FI IF temp>10000 THEN max==+1 FI IF max0 THEN MSG(7) ELSE value=VALI(field) IF minval<0 THEN offset=-minval minchk=0 maxval==+offset maxchk=maxval tmpval=value tmpval==+offset IF tmpval<0 THEN tmpval=maxval+1 FI temp=tmpval ELSE temp=value maxchk=maxval minchk=minval FI IF tempmaxchk THEN MSG(7) ELSE accept=1 FI FI UNTIL accept OD RETURN(value) ;************************************ ; ; Example of use of EntryC() PROC Test4() BYTE x,y,nullflg INT min,max,value BYTE errcde BYTE POINTER err_ptr errcde=0 err_ptr=@errcde min=-20000 max=-1000 nullflg=0 x=19 y=7 PUT(125) POSITION(5,5) PUTE() PRINTE("Enter a number between ") PRINTI(min) PRINT(" and ") PRINTI(max) PRINT(": ") value=EntryI(x,y,min,max,nullflg, 0,0,err_ptr) POSITION(5,17) PUTE() PRINTIE(value) PRINTE("Done...") RETURN