Piper's Pit BBS/FTP: ibm 0010 - 0019/ibm0010-0019/ibm0010.tar/ibm0010/CLIPB52.ZIP/ZINKY.ZIP/REPORTS.PRG

Text File | 1990-04-30 | 5.6 KB | 227 lines

************************************
*        REPORTS.PRG               *
*     MODULE OF SAMPLE.PRG         *
************************************

CLEAR
DO WHILE .T.
  SET COLOR TO gr+/b,n/w

  @ 0,0,24,79 BOX boxframe

*Place boxframe characters in
*box defined by x,y locations
*0,0 and 24, 29.

  @5,5  SAY  DATE()  &&Display date at location 5,5.
  @5,67 SAY  TIME()  &&Display time at location 5,67.

  DO Makedbf         && Checking For Indexes

  @7,20,19,60 BOX boxfram2  &&box for second frame
  @11,25 to 11,55           &&and display it.
  @8,31 SAY  "REPORTS"
  SET WRAP ON
  main_in = 0         &&Establish variable main_in.
  SET MESSAGE TO 21 CENTER
  @12,30 PROMPT " ONE "
  @13,30 PROMPT " ALL "
  @14,30 PROMPT " QUIT"
  MENU TO main_in
  IF LASTKEY()=27
    CLEAR
    RETURN
  ENDIF
  SAVE SCREEN TO scr2
  DO CASE
    CASE main_in = 1
      @ 15,29 TO 18,40
      @ 16,30 PROMPT 'SCREEN '
      @ 17,30 PROMPT 'PRINTER'
      MENU TO m_where
      IF LASTKEY()=27
        CLEAR
        RETURN
      ENDIF
      CLEAR
      @ 5,10 TO 9,50
      m_artist=SPACE(40)
      m_title=SPACE(40)
      @ 6,15 SAY 'ENTER ARTIST:'GET  m_artist;
        PICTURE'@S15!'
      @ 7,15 SAY 'ENTER TITLE :'GET m_title;
        PICTURE'@S15!'
      READ
      IF LASTKEY()=27
        CLEAR
        RETURN
      ENDIF
      SEEK m_artist + m_title
      IF EOF()
        ?? CHR(7)
        @ 20,15 SAY 'CANNOT FIND'
        INKEY(0)
        LOOP
      ELSE
      IF m_where = 2
        DO Printopt
      ENDIF
        CLEAR
        row=5
        col=10
        @ row,col SAY 'ARTIST:'+artist
        @ row+1,col SAY 'TITLE:'+title
        @ row+2,col SAY 'CONDITION:'+condition
        @ row+3,col SAY 'REMARK:' +remarks
        @ row+4,col SAY 'MEMO:'
        @ row+5,col say memo
        INKEY(0)
        IF m_where == 2
          EJECT
        ENDIF
      ENDIF
      SET DEVICE TO SCREEN
      SET PRINTER TO
      RESTORE SCREEN FROM scr2
    CASE main_in = 2
      SET DEVICE TO SCREEN
      @ 15,29 TO 18,40
      @ 16,30 PROMPT 'SCREEN '
      @ 17,30 PROMPT 'PRINTER'
      MENU TO m_where
      IF LASTKEY()=27
        CLEAR
        RETURN
      ENDIF
      IF m_where = 2
        DO Printopt
      ENDIF
      CLEAR
      GO TOP
      row=3
      @ row,15 SAY 'ENTIRE COLLECTION'
      row=row+2
      @ row,5 SAY REPLICATE("=",65)
      row=row+1
      DO WHILE .NOT. EOF()
        @ row,5 SAY artist
        @ row,40 SAY title
        row=row+1
        @ row,5 SAY condition
        @ row+1,5 SAY memo
        row=row+2
        IF m_where = 1
          IF row > 18
            WAIT
            CLEAR SCREEN
            row=3
            @ row,15 SAY 'ENTIRE COLLECTION'
            row=row+2
            @ row,5 SAY REPLICATE("=",65)
            row=row+1
          ENDIF
        ELSE
          IF row>54
            EJECT
            row=5
            @ row,15 SAY 'ENTIRE COLLECTION'
            row=row+2
            @ row,5 SAY REPLICATE("=",65)
            row=row+1
          ENDIF
        ENDIF
        SKIP
      ENDDO
    WAIT

    SET DEVICE TO SCREEN
    SET PRINTER TO
    CASE main_in = 3
      CLEAR SCREEN
      RETURN
  ENDCASE
ENDDO

*************************
*Printopt  Procedure    *
* 4/28/90               *
*************************
PROCEDURE Printopt
PUBLIC m_compres,prtr1, mt_comp, m_outfile
@ 16,15 SAY '┌───<< Printer Selection >>─────┐  '
@ 17,15 SAY '│ HP LaserJet series II         │██'
@ 18,15 SAY '│ EPSON dot matrix printer      │██'
@ 19,15 SAY '│ Other output device           │██'
@ 20,15 SAY '│ Output to file                │██'
@ 21,15 SAY '└───────────────────────────────┘██'
@ 21,15 SAY '  █████████████████████████████████'
@ 17,17 PROMPT 'HP LaserJet series II   '
@ 18,17 PROMPT 'EPSON dot matrix printer'
@ 19,17 PROMPT 'Other output device     '
@ 20,17 PROMPT 'Output to file          '
MENU TO mprint
IF LASTKEY()==27
  CLEAR
  RETURN
ENDIF

DO CASE
  CASE mprint==1
    SET DEVICE TO PRINT
    @0,0 SAY chr(27)+chr(40)+chr(115) ;
            +chr(49)+chr(54)+chr(46) ;
            +chr(54)+chr(54)+chr(72)
  CASE mprint==2
    SET DEVICE TO PRINT
    @0,0 SAY chr(15)
  CASE mprint==3
    STORE ;
    '027 015 000 000 000 000 000 000 000 000 000 000';
    TO prtr1
    mt_comp=prtr1
    m_compres=''
    CLEAR
    @ 3,9 SAY;
    '▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓'
    @ 4,9 SAY;
    '▓▓ You will be allowed to enter your own   ▓▓▓'
    @ 5,9 SAY;
    '▓▓ printer ESCAPE CODES and save them to   ██▓'
    @ 6,9 SAY;
    '▓▓ a special file that will be called each ██▓'
    @ 7,9 SAY;
    '▓▓ time you select choice 3                ██▓'
    @ 8,9 SAY;
    '▓▓ Enter the CHR() CODES in multiples of 3 ██▓'
    @ 9,9 SAY;
    '▓▓ as shown in the example:                ██▓'
    @ 10,9 SAY;
    '▓▓▓▓█████████████████████████████████████████▓'
    @ 11,9 SAY;
    '▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓'
    @ 14,1 GET prtr1 PICTURE;
    '999 999 999 999 999 999 999 999 999 999 999 999'
    READ
    IF LASTKEY()==27
      CLEAR
      RETURN
    ENDIF
    FOR i = 1 TO 48 STEP 4
      STORE m_compres+CHR(VAL(SUBSTR(mt_comp,i,3)));
      TO m_compres
    NEXT
    SET DEVICE TO PRINT
    @ 0,0 SAY m_compres
    SET DEVICE TO SCREEN
  CASE mprint==4
    m_outfile=SPACE(12)
    @ 20,8 SAY 'ENTER OUTFILE NAME' GET m_outfile;
    PICTURE '!!!!!!!!!!!!'
    READ
    SET PRINTER TO &m_outfile
    SET DEVICE TO PRINT
  ENDCASE
RETURN