home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / rroutine.zip / RRTEST.PRG < prev   
Text File  |  1988-07-16  |  725b  |  46 lines
  1. clear
  2. ?getprn(.t.)
  3. return
  4.  
  5.  
  6. * ***************
  7. FUNCTION GetPrn *
  8. *****************
  9. PARA asciiok
  10. PRIVATE retval,i,prncnt,scr
  11. retval=""
  12. scr=SPACE(4096)
  13. SAVE SCREEN TO scr
  14. DECLARE prntbl[10]
  15. prncnt=0
  16. FOR i=1 to 8
  17.     prntbl[i]=RrPrn(i)
  18.     IF !EMPTY(prntbl[i])
  19.         prncnt=prncnt+1
  20.     ENDIF
  21. NEXT
  22. IF asciiok
  23.     prncnt=prncnt+1
  24.     prntbl[prncnt]="ASCII"
  25. ENDIF
  26. IF prncnt>0
  27.     @ 5,0 CLEAR
  28.     @ 5,20 to 6+prncnt,50 DOUBLE
  29.     FOR i=1 TO prncnt
  30.     @ 5+i,25 PROMPT prntbl[i]
  31.     NEXT i
  32.     SET MESSAGE TO
  33.     i=0
  34.     MENU TO i
  35.     DO CASE
  36.         CASE i=0
  37.     CASE asciiok .AND. i=prncnt
  38.         retval="A"
  39.     OTHERWISE
  40.         retval=STR(i,1)
  41.     ENDCASE
  42. ENDIF
  43. RESTORE SCREEN FROM scr
  44. RETURN(retval)
  45.  
  46.