home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / DB / DB009B.ZIP / 1.ZIP / III_OVL3.PRG < prev    next >
Text File  |  1989-09-29  |  24KB  |  941 lines
  1.  
  2.  
  3. ************************************************************
  4. *                         III_INIT                         *
  5. ************************************************************
  6.  
  7. PROCEDURE III_INIT
  8. *************************************************************************
  9. *
  10. * (c) COPYRIGHT 1987,1988 I on I Computer Solutions, Inc.  All Rights Reserved
  11. *
  12. **************************************************************************
  13.  
  14. * III_INIT
  15.  
  16. * INITIAL VARIABLES
  17.  
  18. CLEAR
  19. SET TALK OFF
  20. SET EXCLUSIVE ON
  21. SET MEMO TO 75
  22. SET SAFE OFF
  23. SET ESCAPE OFF
  24.    CLEAR
  25.    SET ESCAPE OFF
  26.    @ 0,1 SAY "(c) Copyright 1987-1989 I on I Computer Solutions, Inc.  All Rights Reserved"
  27.    @ 1,0 SAY "═══════════════════════════════════════════════════════════════════════════════"
  28.  
  29. TEXT
  30.      1 on 1 = 3!! can only be distributed by authorized vendors.  By our
  31.      distributing though these vendors you can determine if 1 on 1 = 3!! is
  32.      useful at a nominal fee. 
  33.  
  34.      Many companies provide you with crippled copies of their software.  They
  35.      might limit you to 1000 or or even 100 records.  We limit you to 1 BILLION
  36.      records.  There are no artificial limits in your copy of 1 on 1 = 3!!.
  37.  
  38.      If you do find 1 on 1 = 3!! useful, we request that you register your copy
  39.      for only $69.  Besides the use of a programmable, relational database
  40.      management system that is fully dBASE III PLUS compatible, registration
  41.      will bring you the following benefits: 
  42.  
  43.                > The most current version of the software. 
  44.                > Free upgrades for one year. 
  45.                > Free technical support for one year. 
  46.                > Discounts on other software we sell. 
  47.  
  48.      Register by phone at 203-375-0914 or use the order form 'ORDER'.  To print
  49.      this form type COPY ORDER PRN.  We take Visa, Mastercard or American
  50.      Express.
  51. ENDTEXT
  52.  
  53. * ?? MAKE SURE ALL FILES AVAIBLE
  54.  
  55. PUBLIC III_MAXDB, III_MAXDOS, III_DBL, III_DBP, III_DOSL, III_DOSP, III_PROMPT ;
  56.        III_HFILE, III_HIDX1, III_HIDX2, III_HOUT, III_HREAD, III_ASSI, III_DOT
  57.  
  58. PUBLIC MAX_MACC, III_MDBF, III_MIDX, III_MMEM, III_MFAST, III_MGROUP, ;
  59.        III_HSET, III_USERPA, III_READON, III_MAXLIN, III_DIR
  60.  
  61. PUBLIC III_COLOR1, III_COLOR2, III_MONO, III_HFAST, III_NHTOP, III_DESCRW, ;
  62.         III_COMPON, III_SEL, III_READ, III_HELPON, III_FAST, III_FASTA, I_RNUM
  63.  
  64. PUBLIC  I_RKEY(6), I_RLINK(6), I_RINDEX(6)
  65.  
  66. PUBLIC III_MASTER, III_PFOUND, III_TIMCOM, III_TIMMEN
  67.  
  68. III_TIMCOM = 0
  69. III_TIMMEN = 0
  70. III_MASTER = .F.
  71. III_PFOUND = .T.
  72.  
  73.  
  74. III_FAST = .T.
  75. III_FASTA = '   '
  76.  
  77. III_SEL = ' '
  78.  
  79.  
  80. * SAVE CURRENT DIRECTORY
  81.  
  82. iii_error = .F.
  83. on error do iii_eswi
  84. SET CONSOLE OFF
  85. RUN CD > III_TMP.OUT
  86. SET CONSOLE ON
  87. IF III_ERROR
  88.     III_DIR = ''
  89. ELSE
  90. SELECT 0
  91. USE III_ADD
  92. ZAP
  93. APPEND FROM III_TMP.OUT SDF
  94. GO TOP
  95.  
  96. III_DIR=TRIM(III_INSTR)
  97. IF SUBSTR(III_DIR,LEN(III_DIR),1) <> '\'
  98.     III_DIR = III_DIR + '\'
  99. ENDIF
  100. ENDIF
  101. ON ERROR 
  102.  
  103. * OPEN THE SYSTEM FILE
  104.  
  105. USE III_SYS.FOX
  106.  
  107. III_READ = LREAD_ONLY
  108.  
  109. III_COLOR1 = COLOR_STAN
  110. III_COLOR2 = COLOR_ENHA
  111. III_MONO = LMONOCHROM
  112.  
  113. III_MAXLIN = MAX_CODE
  114. III_COMPON = LCOM_SAVE
  115.  
  116. III_DESCRW = DESC_LINE                && LINE TO PUT THE DESCRIPTION ON
  117.  
  118. III_HFILE = III_DIR+HELP_DBF        && THE HELP DATABASE
  119. III_HIDX1 = III_DIR+HELP_IDX1        && THE HELP INDEX 1
  120. III_HIDX2 = III_DIR+HELP_IDX2        && THE HELP INDEX 2
  121. III_HTOPIC = HELP_TOPIC                && THE HELP TOPIC FILE
  122. III_HFAST = LFAST_HELP                && FAST HELP?
  123.  
  124.  
  125. III_HOUT = III_DIR+'III_HOUT.TXT'            && THE ALTERNATE FILE USED BY HELP
  126. III_HREAD = III_DIR+'III_HPRT'                && THE HELP DATABASE FOR BROWSING
  127.  
  128. III_MAXDB = MAX_DBLINE                && NUMBER OF LINES SAVED AT DOT PROMPT
  129. III_PROMPT = TRIM(PROMPT)+' '
  130. III_MAXDOS = MAX_DOSLIN                && NUMBER OF LINES SAVE AT DOS
  131.  
  132. III_USERPA = LUSER_PASS            && IS THERE A USER PASSWORD
  133. III_READON = LREAD_ONLY            && IS IT READ ONLY
  134.  
  135. MAX_MACC = MAX_MACRO                && NUMBER MACROS ALLOWED
  136. III_MDBF = III_DIR+MENU_DBF            && MENU DATA BASE
  137. III_MIDX = III_DIR+MENU_IDX            && MENU INDEX FILE
  138. III_MMEM = III_DIR+MENU_MEM            && MENU MEMORY FILE
  139. III_MFAST = LMENU_MEM                && TAKE MENU FROM MEMORY FILE
  140. III_MGROUP = MENU_GROUP                && NUMBER GROUPS IN MENU
  141.  
  142. USE
  143.  
  144. PUBLIC  III_DBLINE(III_MAXDB), III_DOSLINE(III_MAXDOS)
  145.  
  146. III_DBL = 0
  147. III_DBP = 1
  148. III_DOSL = 0
  149. III_DOSP = 1
  150. III_DBLINE = ' '
  151. III_DOSLINE = ' '
  152.  
  153. III_ASSI = .F.                        && IN ASSIST MODE
  154. III_HSET = 'START'
  155. III_DOT = .F.                        && IN DOT PROMPT MODE
  156.  
  157. * CHECK IF THE HELP FILE IS THERE
  158.  
  159. IF .NOT. FILE(III_HFILE+'.DBF')
  160.  
  161.     ? 
  162.     ? 'Help file not found, there will be no help'
  163.     ?
  164.     III_HELPON = .F.
  165. ELSE
  166.     III_HELPON = .T.
  167.  
  168. * GET IN THE HELP PROMPTS
  169.  
  170.     USE &III_HTOPIC
  171.     GO TOP
  172.     III_NHTOP = RECCOUNT()
  173.  
  174.     PUBLIC III_HTOP(III_NHTOP)
  175.  
  176.     III_I = 1
  177.     DO WHILE III_I <= III_NHTOP
  178.         III_HTOP(III_I) = III_HELP2
  179.         SKIP
  180.         III_I = III_I + 1
  181.     ENDDO
  182.     USE
  183.  
  184.     SELECT 9
  185.     USE &III_HFILE INDEX &III_HIDX1, &III_HIDX2
  186.  
  187.     ON KEY = 315 DO III_HELP
  188.  
  189. ENDIF
  190. LOAD III_CD
  191.  
  192. * PICK UP IF PROGRAM TO RUN
  193.  
  194. PUBLIC III_RUNPROG
  195.  
  196. IF FILE('III_RUN.TXT')
  197.     USE III_ADD
  198.     ZAP
  199.     APPEND FROM III_RUN.TXT SDF
  200.     GO TOP
  201.  
  202.     III_RUNPROG=TRIM(III_INSTR)
  203. ELSE
  204.     III_RUNPROG = 'ECHO is off'
  205. ENDIF
  206.  
  207. * GO TO THE DIRECTORY THIS WAS STARTED FROM
  208.  
  209. IF FILE('III_BACK.TXT')
  210.  
  211.     USE III_ADD
  212.     ZAP
  213.     APPEND FROM III_BACK.TXT SDF
  214.     IF LEN(LTRIM(RTRIM(III_INSTR))) > 1
  215.         ERASE III_BACK.TXT
  216.         III_TMP = SUBSTR(III_INSTR,1,2)
  217.         RUN &III_TMP
  218.         III_TMP = SUBSTR(III_INSTR,1,1)
  219.         SET DEFAULT TO &III_TMP
  220.         III_TMP = TRIM(SUBSTR(III_INSTR,3))
  221.         *    RUN CD &III_TMP
  222.         DO III_CD WITH III_TMP
  223.     ENDIF LEN(LTRIM(RTRIM(III_STR))) > 1
  224.     
  225.  
  226. ENDIF FILE('III_BACK')
  227. USE
  228.  
  229.  
  230. ************************************************************
  231. *                         III_DOS                          *
  232. ************************************************************
  233.  
  234. PROCEDURE III_DOS
  235. *************************************************************************
  236. *
  237. * (c) COPYRIGHT 1987 I on I Computer Solutions, Inc.  All Rights Reserved
  238. *
  239. **************************************************************************
  240.  
  241. * QC_DOS.PRG
  242.  
  243. * EXECUTE A DOS COMMAND
  244.  
  245. PRIVATE   COMMAND, DIRECTION,  MORE, KQ
  246.  
  247. STORE ' ' TO COMMAND
  248. STORE ' ' TO DIRECTION
  249. CLEAR
  250. SET COLOR TO W/N,W/N
  251. MORE=.T.
  252. DO WHILE MORE
  253.  
  254.     DO CASE
  255.         CASE DIRECTION = 'U'
  256.             III_DOSP=III_DOSP-1
  257.             IF III_DOSP < 1
  258.                 III_DOSP = III_MAXDOS
  259.             ENDIF III_DOSP < 1
  260.             COMMAND = III_DOSLINE(III_DOSP)
  261.         CASE DIRECTION = 'D'
  262.             III_DOSP=III_DOSP+1
  263.             IF III_DOSP > III_MAXDOS
  264.                 III_DOSP = 1
  265.             ENDIF III_DOSP > III_MAXDOS
  266.             COMMAND = III_DOSLINE(III_DOSP)
  267.         OTHERWISE
  268.             III_DOSL=III_DOSL+1
  269.             IF III_DOSL > III_MAXDOS
  270.                 III_DOSL = 1
  271.             ENDIF III_DOSL > III_MAXDOS
  272.             III_DOSLINE(III_DOSL) = COMMAND
  273.             III_DOSP = III_DOSL + 1
  274.             COMMAND = ' '
  275.     ENDCASE
  276.  
  277.     COMMAND=COMMAND + REPLICATE(' ',200-LEN(COMMAND))
  278.  
  279.     ?
  280.     RUN CD
  281.  
  282.     DO III_SSEL
  283.     SELECT 9
  284.  
  285.     @ 24,0 SAY III_PROMPT GET COMMAND PIC '@S60'
  286.     READ
  287.     DO III_RSEL
  288.     kq = READKEY()
  289.     DIRECTION = ' '
  290.     DO CASE
  291.         CASE kq = 4 .OR. kq = 260  && [UP]
  292.             DIRECTION = 'U'
  293.             
  294.  
  295.         CASE kq = 5 .OR. kq = 261  && [DOWN]
  296.             DIRECTION = 'D'
  297.             
  298.  
  299.         CASE COMMAND = 'QUIT'
  300.             MORE = .F.
  301.  
  302.         OTHERWISE
  303.             ON ERROR DO III_DBER
  304.             ?
  305.             COMMAND=TRIM(COMMAND)
  306.             IF LEN(COMMAND) = 0
  307.                 MORE = .F.
  308.             ELSE
  309.                 RUN &COMMAND
  310.             ENDIF
  311.     ENDCASE
  312. ENDDO
  313. ON ERROR
  314. RETURN
  315.  
  316.  
  317. ************************************************************
  318. *                         III_HELP                         *
  319. ************************************************************
  320.  
  321. PROCEDURE III_HELP
  322. *************************************************************************
  323. *
  324. * (c) COPYRIGHT 1987 I on I Computer Solutions, Inc.  All Rights Reserved
  325. *
  326. **************************************************************************
  327.  
  328. * III_HELP
  329.  
  330. * THE HELP ROUTINE
  331.  
  332. PRIVATE III_SCR
  333.  
  334. IF .NOT. III_HELPON
  335.     RETURN
  336. ENDIF
  337.  
  338. SAVE SCREEN TO III_SCR
  339. CLEAR
  340.  
  341. * TURN OFF THE HELP
  342.  
  343. DO III_SSEL
  344.  
  345. ON KEY = 315
  346. SET EXACT OFF
  347.  
  348. IF III_ASSI
  349.     III_TMP = SUBSTR(GROUP(GR),1,1) + ' '
  350.  
  351.     IF SUBSTR(NM(IR),3,1) = '-'
  352.         III_HS = III_TMP + SUBSTR(NM(IR),5)
  353.     ELSE
  354.         III_HS = III_TMP + NM(IR)
  355.     ENDIF SUBSTR(NM(IR),3,1) = '-'
  356.     III_HS = UPPER(III_HS)
  357.  
  358. ELSE
  359.     SELECT 9
  360.     USE &III_HFILE INDEX &III_HIDX1, &III_HIDX2
  361.     III_HS = III_HSET
  362. ENDIF
  363.  
  364.  
  365. IF III_HFAST
  366.     SELECT 9
  367.     SET ORDER TO 1
  368.     III_HS = III_FILL(III_HS,10)
  369.     SEEK III_HS
  370.     IF EOF()
  371.         FIND START
  372.     ENDIF
  373.     SET ORDER TO 0
  374.     SET MENU OFF
  375.     BROW NOAPPEND NOMOD FIELDS III_HELP
  376.  
  377.     III_DBNM=' '
  378.     DO WHILE .T.
  379.         KEYSTOKESQ = 0
  380.         DO III_HPC
  381.         IF III_DBNM = ' '
  382.             EXIT
  383.         ENDIF
  384.         III_HS = TRIM(III_DBNM)
  385.         IF SUBSTR(III_HS,2,1) = ' '
  386.             SET ORDER TO 1
  387.         ELSE
  388.             SET ORDER TO 2
  389.         ENDIF
  390.         III_HS = III_FILL(III_HS,25)
  391.         SEEK III_HS
  392.         IF EOF()
  393.             DO III_PRER WITH 'HELP TOPIC NOT FOUND'
  394.         ELSE
  395.             SET MENU OFF
  396.             IF SUBSTR(III_HS,2,1) <> ' '
  397.                 SET ORDER TO 0
  398.             ENDIF
  399.             BROW NOAPP NOMOD FIELDS III_HELP
  400.         ENDIF
  401.     ENDDO
  402.     SET ORDER TO 1
  403. ELSE
  404.  
  405.     SELECT 9
  406.     USE &III_HFILE INDEX &III_HIDX1, &III_HIDX2
  407.     SEEK III_HS
  408.     IF EOF()
  409.         FIND 'X HELP'
  410.     ENDIF
  411.     SET CONSOLE OFF
  412.     SET ALTER TO &III_HOUT
  413.     SET ALTER ON
  414.     DISPLAY III_HELP OFF
  415.     SET ALTER TO
  416.     USE
  417.     SELECT 0
  418.     USE &III_HREAD
  419.     ZAP
  420.     APPEND FROM &III_HOUT SDF
  421.     SET CONSOL ON
  422.     GO TOP
  423.     ON KEY = 215
  424.     SET MENU OFF
  425.     BROW NOMENU NOAPPEND NOMODIFY
  426.     USE
  427. ENDIF III_HFAST
  428.  
  429. ON KEY = 315 DO III_HELP
  430. IF .NOT. III_ASSI
  431.     SELECT 9
  432.     USE
  433. ENDIF
  434. DO III_RSEL
  435.  
  436. RESTORE SCREEN FROM III_SCR
  437.  
  438.  
  439. ************************************************************
  440. *                         III_CHAR                         *
  441. ************************************************************
  442.  
  443. PROCEDURE III_CHAR
  444. * III_CHAR
  445.  
  446. * SET COMPUTER CHARACTERISTICS
  447.  
  448. CLEAR
  449.  
  450. SELECT 1
  451. USE &III_DIR.III_SYS.FOX
  452. GO TOP
  453.  
  454. DO WHILE .T.
  455.     ANS = ' '
  456.     @ 12,2 SAY 'Enter M for monochrome, C for color' GET ANS
  457.     READ
  458.     ANS = UPPER(ANS)
  459.     IF ANS = 'M' .OR. ANS = 'C'
  460.         EXIT
  461.     ENDIF
  462. ENDDO
  463. IF ANS = 'M'
  464.     REPLACE LMONOCHROM WITH .T.
  465. ELSE
  466.     REPLACE LMONOCHROM WITH .F.
  467. ENDIF
  468.  
  469. III_MONO = LMONOCHROM
  470.  
  471.  
  472. DO WHILE .T.
  473.     ANS = ' '
  474.     @ 14,2 SAY 'Enter R for read only, U for update' GET ANS
  475.     READ
  476.     ANS = UPPER(ANS)
  477.     IF ANS = 'R' .OR. ANS = 'U'
  478.         EXIT
  479.     ENDIF
  480. ENDDO
  481.  
  482. IF ANS = 'R'
  483.     REPLACE LREAD_ONLY WITH .T.
  484.     III_READ = .T.
  485. ELSE
  486.     REPLACE LREAD_ONLY WITH .F.
  487.     III_READ = .F.
  488. ENDIF
  489.  
  490. USE
  491.  
  492.  
  493. ************************************************************
  494. *                         III_FILL                         *
  495. ************************************************************
  496.  
  497. PROCEDURE III_FILL
  498. * III_FILL
  499.  
  500. * FUNCTION TO FILL TO A SIZE WITH BLANKS
  501.  
  502. PARAMETERS VAR, SIZE
  503.  
  504. PRIVATE NEW
  505.  
  506. IF LEN(VAR) >= SIZE
  507.     RETURN SUBSTR(VAR,1,SIZE)
  508. ELSE
  509.     NEW = VAR+REPLICATE(' ',SIZE-LEN(VAR))
  510.     RETURN NEW
  511. ENDIF
  512.  
  513.  
  514. ************************************************************
  515. *                         III_HPC                          *
  516. ************************************************************
  517.  
  518. PROCEDURE III_HPC
  519. *************************************************************************
  520. *
  521. * (c) COPYRIGHT 1987 I on I Computer Solutions, Inc.  All Rights Reserved
  522. *
  523. **************************************************************************
  524.  
  525. * III_HPC
  526.  
  527. * CHOOSE A HELP ITEM
  528.  
  529. PRIVATE ROWQ, COLQ, IQ
  530.  
  531. III_WIDDIR=3
  532. III_DBNM=' '
  533. lisselq=2
  534. fldlimitq = III_NHTOP
  535. CLEAR
  536. iq=1
  537. DO WHILE IQ <= III_NHTOP
  538.    rowq=INT((iq-1)/III_WIDDIR)
  539.    colq=26*MOD(iq-1,III_WIDDIR)
  540.    @ rowq, colq say III_HTOP(iq)
  541.    iq=iq+1
  542. ENDDO
  543.                   *
  544.                   * --- Create a field list
  545.                   fieldnoq=1
  546.  
  547.  
  548.                            * --- Pick a field from the list on top
  549.                            DO WHILE .T.
  550.                               rowq=INT((fieldnoq-1)/III_WIDDIR)
  551.                               colq=26*MOD(fieldnoq-1,III_WIDDIR)
  552.                               IF III_ASSI
  553.                                   III_COLOR = C2(IR)
  554.                               ELSE
  555.                                   III_COLOR = III_COLOR2
  556.                               ENDIF
  557.                               SET COLOR TO &III_COLOR
  558.                               @ rowq,colq SAY III_HTOP(fieldnoq)
  559.                               IF III_ASSI
  560.                                   III_COLOR = C1(IR)
  561.                               ELSE
  562.                                   III_COLOR = III_COLOR1
  563.                               ENDIF
  564.                               SET COLOR TO &III_COLOR
  565.                               SELKEYQ=0
  566.                               DO WHILE SELKEYQ=0
  567.                                   selkeyq=INKEY()
  568.                               ENDDO
  569.                               DO CASE
  570.                                  CASE selkeyq=27 && Exit
  571.                                      III_DBNM = ' '
  572.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  573.                                     EXIT
  574.                                  CASE selkeyq=4 && [Right]
  575.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  576.                                     fieldnoq=IIF(fieldnoq<fldlimitq,fieldnoq+1,1)
  577.                                  CASE selkeyq=19 && [Left]
  578.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  579.                                     fieldnoq=IIF(fieldnoq>1,fieldnoq-1,fldlimitq)
  580.                                  CASE selkeyq=5 && [Up]
  581.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  582.                                     fieldnoq=IIF(fieldnoq>III_WIDDIR,fieldnoq-III_WIDDIR,(INT((fldlimitq-1)/III_WIDDIR)*III_WIDDIR)+fieldnoq)
  583.                                     fieldnoq=IIF(fieldnoq>fldlimitq,fieldnoq-III_WIDDIR,fieldnoq)
  584.                                  CASE selkeyq=24 && [Down]
  585.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  586.                                     fieldnoq=IIF(fieldnoq<=fldlimitq-III_WIDDIR,fieldnoq+III_WIDDIR,fieldnoq-(INT((fldlimitq-1)/III_WIDDIR)*III_WIDDIR))
  587.                                     fieldnoq=IIF(fieldnoq<1,fieldnoq+III_WIDDIR,fieldnoq)
  588.                                  CASE selkeyq=13 && Select Field
  589.                                     III_DBNM=III_HTOP(fieldnoq)
  590.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  591.                                     EXIT
  592.                                  CASE selkeyq=1 && [Home]
  593.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  594.                                     fieldnoq=1
  595.                                  CASE selkeyq=6 && [End]
  596.                                     @ rowq,colq SAY III_HTOP(fieldnoq)
  597.                                     fieldnoq=fldlimitq
  598.                                  OTHERWISE
  599.                                     III_MAT=CHR(SELKEYQ)
  600.                                     IF SELKEYQ > 60 .AND. SELKEYQ < 123
  601.                                         III_MAT = UPPER(III_MAT)
  602.                                     ENDIF
  603.                                     III_I=FIELDNOQ+1
  604.                                        IF III_I > FLDLIMITQ
  605.                                            III_I=1
  606.                                        ENDIF
  607. *SUSPEND
  608.  
  609.                                     DO WHILE III_I <> FIELDNOQ
  610.                                         IF SUBSTR(III_HTOP(III_I),1,1) = III_MAT
  611.                                             @ ROWQ,COLQ SAY III_HTOP(FIELDNOQ)
  612.                                             FIELDNOQ=III_I
  613.                                             EXIT
  614.                                         ENDIF
  615.                                         III_I=III_I+1
  616.                                         IF III_I > FLDLIMITQ
  617.                                             III_I=1
  618.                                         ENDIF
  619.                                     ENDDO
  620.                               ENDCASE 
  621.                            ENDDO 
  622.  
  623.  
  624. ************************************************************
  625. *                         III_CD                           *
  626. ************************************************************
  627.  
  628. PROCEDURE III_CD
  629. parameter dir
  630. call iii_cd with dir
  631. return
  632.  
  633.  
  634. ************************************************************
  635. *                         III_PAUS                         *
  636. ************************************************************
  637.  
  638. PROCEDURE III_PAUS
  639. * iii_paus
  640.  
  641. * pause routine
  642.  
  643. PARAMETER SECONDS
  644.  
  645. PRIVATE START, STOP, III
  646.  
  647. START = VAL(SYS(2))
  648.  
  649. STOP = START + SECONDS
  650.  
  651. START = 0
  652.  
  653. DO WHILE START < STOP
  654.     IF FILE('3!!.ON')
  655.         EXIT
  656.     ENDIF
  657.     START = VAL(SYS(2))
  658. ENDDO
  659.  
  660. RETURN
  661.  
  662.  
  663. ************************************************************
  664. *                         III_RSEL                         *
  665. ************************************************************
  666.  
  667. PROCEDURE III_RSEL
  668. *************************************************************************
  669. *
  670. * (c) COPYRIGHT 1987 I on I Computer Solutions, Inc.  All Rights Reserved
  671. *
  672. **************************************************************************
  673.  
  674. * III_RSEL
  675.  
  676. * RESTORE THE CURRENT SELECTED DRIVE BY THE USER
  677.  
  678. *ON ERROR DO III_NOTH
  679. IF III_SEL <> '*' .AND. III_SEL <> ' '
  680.     SELECT &Iii_SEL 
  681. ELSE
  682.     SELECT 1
  683. ENDIF
  684. *ON ERROR
  685. RETURN
  686.  
  687.  
  688. ************************************************************
  689. *                         III_SSEL                         *
  690. ************************************************************
  691.  
  692. PROCEDURE III_SSEL
  693. * III_SSEL
  694.  
  695. * SAVE THE CURRENT SELECTED DEVISE
  696.  
  697. ON ERROR DO III_NOTH
  698. Iii_SEL = STR(SELECT(),1,0)
  699. ON ERROR DO III_DBER
  700. RETURN
  701.  
  702.  
  703. ************************************************************
  704. *                         III_DOCU                         *
  705. ************************************************************
  706.  
  707. PROCEDURE III_DOCU
  708. * --- iii_docu.prg
  709. * c COPYRIGHT 1987 Fox & Geller, Inc.  All Rights Reserved
  710. * This Menu is Repeated until user exits
  711. DO WHILE .T.
  712.    SET TALK OFF
  713.    SET COLOR TO W/N
  714.    CLEAR
  715.    SET ESCAPE OFF
  716.    @ 0,3 SAY "(c) Copywrite 1987, I on I Computer Solutions, Inc.  All Rights Reserved"
  717.    @ 1,0 SAY "═══════════════════════════════════════════════════════════════════════════════"
  718.    @ 3,30 SAY "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄"
  719.    @ 4,30 SAY "▌ 1 on 1 = 3!! ▐"
  720.    @ 5,30 SAY "▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀"
  721.    @ 6,19 SAY "╔═══════════════════════════════════╗"
  722.    @ 7,19 SAY "║  I on I Computer Solutions, Inc.  ║"
  723.    @ 8,19 SAY "║        26 Finchwood Drive         ║"
  724.    @ 9,19 SAY "║        Trumbull, CT  06611        ║"
  725.    @ 10,19 SAY "╚═══════════════════════════════════╝"
  726.    @ 11,19 SAY "┌───────────────────────────────────┐"
  727.    @ 12,19 SAY "│"
  728.    @ 12,55 SAY "│"
  729.    @ 13,19 SAY "│"
  730.    @ 13,55 SAY "│"
  731.    @ 14,19 SAY "│"
  732.    @ 14,55 SAY "│"
  733.    @ 15,19 SAY "│"
  734.    @ 15,55 SAY "│"
  735.    @ 16,19 SAY "│"
  736.    @ 16,55 SAY "│"
  737.    @ 17,19 SAY "│"
  738.    @ 17,55 SAY "│"
  739.    @ 18,19 SAY "│"
  740.    @ 18,55 SAY "│"
  741.    @ 19,19 SAY "│"
  742.    @ 19,55 SAY "│"
  743.    @ 20,19 SAY "│"
  744.    @ 20,55 SAY "│"
  745.    @ 21,19 SAY "└───────────────────────────────────┘"
  746.    * display entries the first time:
  747.    @ 13,35 SAY "Index"
  748.    @ 16,35 SAY "Help"
  749.    @ 19,35 SAY "Quit"
  750.    * set up entry info. for processing
  751.    iii_selq1="1335Index"
  752.    iii_selq2="1635Help"
  753.    iii_selq3="1935Quit"
  754.    * corresponding prompts:
  755.    iii_prtq1="         Print out the index for the help file"
  756.    iii_prtq2="              Print out the help listing"
  757.    iii_prtq3="                 Return to main menu"
  758.    * Other variables
  759.    iii_listq="IHQ"  && list of first characters of entries
  760.    iii_lineq1=24      && line on which prompts appear
  761.    iii_colq1=10       && column at which prompts appear
  762.    iii_lineq2=24      && line on which prompts appear
  763.    iii_colq2=10       && column at which prompts appear
  764.    iii_lineq3=24      && line on which prompts appear
  765.    iii_colq3=10       && column at which prompts appear
  766.    SET EXACT ON
  767.    iii_sizeq=LEN(iii_listq)
  768.    iii_iq=1
  769.    DO WHILE .T.
  770.       * --- Display highlighted selection
  771.       iii_jq=IIF(iii_iq<10,STR(iii_iq,1,0),STR(iii_iq,2,0))  && entry # -> string
  772.       SET COLOR TO N/W
  773.       @ VAL(SUBSTR(iii_selq&iii_jq,1,2)),VAL(SUBSTR(iii_selq&iii_jq,3,2))  SAY SUBSTR(iii_selq&iii_jq,5)
  774.       SET COLOR TO W/N
  775.       @ iii_lineq&iii_jq,iii_colq&iii_jq SAY iii_prtq&iii_jq
  776.       * --- Wait for a keystroke
  777.       iii_kq=0
  778.       DO WHILE iii_kq=0
  779.          iii_kq=INKEY()
  780.       ENDDO
  781.       * --- Process the keystroke
  782.       DO CASE
  783.          CASE III_KQ=28
  784.              DO III_HELP
  785.          CASE iii_kq=4 .OR. iii_kq=24      && [Right] or [Down]
  786.             @ VAL(SUBSTR(iii_selq&iii_jq,1,2)),VAL(SUBSTR(iii_selq&iii_jq,3,2)) SAY SUBSTR(iii_selq&iii_jq,5)
  787.             iii_iq=IIF(iii_iq<iii_sizeq, iii_iq+1,1)
  788.  
  789.          CASE iii_kq=19 .OR. iii_kq=5      && [Left] or [Up]
  790.             @ VAL(SUBSTR(iii_selq&iii_jq,1,2)),VAL(SUBSTR(iii_selq&iii_jq,3,2)) SAY SUBSTR(iii_selq&iii_jq,5)
  791.             iii_iq=IIF(iii_iq>1, iii_iq-1,iii_sizeq)
  792.  
  793.          CASE iii_kq=1      && [Home]
  794.             @ VAL(SUBSTR(iii_selq&iii_jq,1,2)),VAL(SUBSTR(iii_selq&iii_jq,3,2)) SAY SUBSTR(iii_selq&iii_jq,5)
  795.             iii_iq=1
  796.  
  797.          CASE iii_kq=6      && [End]
  798.             @ VAL(SUBSTR(iii_selq&iii_jq,1,2)),VAL(SUBSTR(iii_selq&iii_jq,3,2)) SAY SUBSTR(iii_selq&iii_jq,5)
  799.             iii_iq=iii_sizeq
  800.  
  801.          CASE iii_kq=13      && [Return]
  802.             EXIT
  803.  
  804.          CASE iii_kq=27      && [Esc]
  805.             iii_iq=0
  806.             EXIT
  807.  
  808.          CASE UPPER(CHR(iii_kq))$iii_listq   && A letter choice
  809.             iii_iq=AT(UPPER(CHR(iii_kq)),iii_listq)   && Find its location
  810.             EXIT
  811.       ENDCASE
  812.       @ iii_lineq&iii_jq,iii_colq&iii_jq SAY SPACE(LEN(iii_prtq&iii_jq))
  813.    ENDDO      && WHILE .T.
  814.    * --- Perform Action based on choice
  815.    DO CASE
  816.       CASE iii_iq=1
  817.          do iii_pidx
  818.       CASE iii_iq=2
  819.          do iii_phlp
  820.       CASE iii_iq=3
  821.          return
  822.    ENDCASE
  823.    SET EXACT OFF
  824.    SET ESCAPE ON
  825. ENDDO
  826.  
  827.  
  828. ************************************************************
  829. *                         III_PIDX                         *
  830. ************************************************************
  831.  
  832. PROCEDURE III_PIDX
  833. CLEAR
  834. INDENT = 0
  835. @ 12,2 SAY 'Enter number of spaces to indent' GET INDENT
  836. READ
  837. INDENTC=''
  838. IF INDENT > 0
  839.     INDENTC = REPLICATE(' ',INDENT)
  840. ENDIF
  841. SELECT 9
  842. USE &III_HFILE 
  843. *SET ALTERNATE TO 3!!_HIDX.DOC
  844. *SET ALTERNA ON
  845. SET PRINT ON
  846. GO TOP
  847. COUNTIT = 0
  848. DO WHILE .NOT. EOF()
  849.     IF SUBSTR(III_HELP,32,2) = '--' .AND. ;
  850.         SUBSTR(III_HELP,4,3) <> '---'
  851.         SKIP -1
  852.         ?
  853.         ? INDENTC+TRIM(III_HELP)
  854.         COUNTIT = COUNTIT + 2
  855.         IF COUNTIT > 53
  856.             EJECT
  857.             COUNTIT = 0
  858.         ENDIF
  859.         SKIP
  860.     ENDIF
  861.     SKIP
  862. ENDDO
  863. EJECT
  864. USE
  865. *SET ALTERNAT TO
  866. SET PRINT OFF
  867.  
  868.  
  869.  
  870. ************************************************************
  871. *                         III_PHLP                         *
  872. ************************************************************
  873.  
  874. PROCEDURE III_PHLP
  875. * III_PHLP
  876.  
  877. * PRINT OUT HELP FILE
  878.  
  879. PRIVATE START, STOP, PAGE, COUNTIT
  880.  
  881. CLEAR
  882. START=0
  883. STOP=0
  884. INDENT=0
  885.  
  886. DO WHILE .T.
  887.  
  888.     @ 12,2 SAY 'Enter the start page' GET START
  889.  
  890.     @ 14,2 SAY 'Enter the end page' GET STOP
  891.  
  892.     @ 16,2 SAY 'Enter the number of spaces to indent' GET INDENT
  893.  
  894.     READ
  895.  
  896.     IF STOP = 0
  897.         RETURN
  898.     ENDIF
  899.  
  900.     IF START > STOP
  901.         @ 16,2 SAY 'END GREATER THEN START, TRY AGAIN'
  902.         WAIT 
  903.         CLEAR
  904.     ELSE
  905.         EXIT
  906.     ENDIF
  907. ENDDO
  908.  
  909. INDENTC=''
  910. IF INDENT > 0
  911.     INDENTC = REPLICATE(' ',INDENT)
  912. ENDIF
  913. SELECT 9
  914. USE &III_HFILE 
  915. SET PRINT ON
  916. GO TOP
  917. PAGE=1
  918. IF START > 1
  919.     PAGE = START
  920.     GO (PAGE-1)*53+1
  921. ENDIF
  922. COUNTIT = 1
  923. DO WHILE PAGE <= STOP .AND. .NOT. EOF()
  924.     ? INDENTC+TRIM(III_HELP)
  925.     COUNTIT = COUNTIT + 1
  926.     IF COUNTIT > 53
  927.         ?
  928.         ?
  929.         ? '                                  PAGE '+STR(PAGE,3,0)
  930.         EJECT
  931.         ?
  932.         ?
  933.         COUNTIT = 1
  934.         PAGE = PAGE+1
  935.     ENDIF
  936.     SKIP
  937. ENDDO
  938. USE
  939. SET PRINT OFF
  940.  
  941.