home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / commands.zip / GLIST.PRG < prev    next >
Text File  |  1986-05-28  |  10KB  |  438 lines
  1.  
  2. * Program......: GLIST.PRG
  3. * Author.......: Glenn R. Abelson
  4. * Date(s)......: 05/10/86
  5. * Notice.......: Copyright 1986, Glenn Abelson Inc., All Rights Reserved
  6. * Notes........: Dbase/Clipper Report Generator
  7. *
  8. PUBLIC CLIPPER,MTOWHERE,MWHERE,MFIELD,MCMD
  9. *
  10. DO WHIL .T.
  11. SET DEVICE TO SCREEN
  12. SET TALK OFF
  13. SET SAFETY OFF
  14. CLEAR
  15. *
  16. * -- MENU OPTIONS
  17. *
  18. IF CLIPPER
  19. frame = CHR(201)+CHR(205)+CHR(187)+CHR(186)+CHR(188)+CHR(205)+CHR(200) +;
  20. CHR(186)
  21. @ 6,20,16,60 BOX frame
  22. @ 7,22,14,58 BOX frame
  23. ELSE
  24. @ 6,20 TO 16,60 DOUBLE
  25. @ 7,22 TO 14,58 DOUBLE
  26. ENDI
  27. @ 1,1 SAY 'Lists may be indexed and conditional for certain records.'
  28. @ 2,1 SAY 'Totals may be generated after Report is printed.'
  29. @ 3,1 SAY 'Lists may be sent to Screen, Printer or a File for later editing.'
  30. @ 4,1 SAY 'Double line Lists cannot be created here.'
  31. *
  32. *
  33. @ 8,30 SAY 'List Options'
  34. @ 10,30 SAY '1. Run an exisiting list'
  35. @ 11,30 say '2. Create and run a list'
  36. @ 12,30 say '<enter> to exit '
  37. *
  38. *
  39. @ 19,0 SAY 'Using &MBASE'
  40. @ 20,0 SAY 'Index &MINDEX'
  41. WAIT 'Your selection ? ' TO CHOICE
  42.    DO CASE
  43. *
  44. * -- EXIT ON <ENTER>
  45. *
  46.       CASE "" = CHOICE
  47.          RETURN
  48. *
  49. *
  50.       CASE CHOICE = '1'
  51. *
  52. * -- Show existing Lists
  53. *
  54.             DIR *.LST
  55.             ?'Be sure list matches with database in use.'
  56.             ACCEPT 'List to run (do not include extension).... ' to MLST
  57. *
  58. * -- MAKE SURE ONLY 8 LETTERS & NO EXT IS USED
  59. *
  60.                     IF LEN(MLST) > 8 
  61.                        ?'CAN NOT ACCEPT THAT NAME -- TOO LONG '
  62.                        WAIT
  63.                        LOOP
  64.                     ENDI
  65. *
  66. * -- CHECK FOR EXISTENCE
  67. *
  68.                    IF .NOT. FILE ('&MLST' + '.LST')
  69.                     ?'Check your typing '
  70.                     wait
  71.                     loop
  72.                   ELSE
  73.                      STORE '&MLST' + '.LST' TO MLST
  74.                   ENDI
  75. *
  76. * -- .LST files are really memory variable files with database and field
  77. * -- information
  78. *
  79.              RESTORE FROM &MLST  ADDITIVE
  80. *
  81. * -- Use the database and index option from restore
  82. *
  83.              SELECT 1
  84.              USE &MBASE
  85.              SET INDEX TO &MINDEX
  86. *
  87. * -- Open error check file
  88. *
  89.                SELE 2
  90.                USE DATADICT
  91. *         
  92. * -- JUMP TO CONDITIONS SECTION
  93. * 
  94. *
  95. *********************
  96.          CASE CHOICE = '2'
  97. *
  98. * -- Exit on empty entry
  99. *
  100.        IF MBASE < "!"
  101.         RETURN
  102.        ENDI
  103. *
  104. * -- LIST FIELDS
  105. *
  106. CLEAR
  107. MLIST = 'N'
  108. @ 8,1 SAY 'DO YOU WANT A FIELD LIST Y/N ? ' 
  109. @ 8,34 GET MLIST
  110. READ
  111.  IF UPPER(MLIST) = 'Y'
  112. *
  113. * -- Use field list for clipper, because it is fast
  114. *
  115.    IF CLIPPER
  116.      ROW = 2
  117.      CLEAR
  118.   COUNT TO MCOUNT
  119.   SELECT 1
  120.   DO WHIL .T.
  121.      FOR N = 1 TO MCOUNT
  122.        IF ROW > 22
  123.         WAIT
  124.         ROW = 2
  125.         CLEAR
  126.        ENDI
  127.        @ ROW()+1,1 SAY N PICTURE "@B"
  128.        @ ROW(),8 SAY FIELDNAME(N)
  129.         N = N+1
  130.        @ ROW(),22 SAY N PICTURE "@B"
  131.        @ ROW(),28 SAY FIELDNAME(N)
  132.          N = N+1
  133.        @ ROW(),42 SAY N PICTURE "@B"
  134.        @ ROW(),48 SAY FIELDNAME(N)
  135.          N=N+1
  136.        @ ROW(),62 SAY N PICTURE "@B"
  137.        @ ROW(),70 SAY FIELDNAME(N)
  138.          ROW = ROW + 1
  139.         NEXT N
  140.           IF "" = FIELDNAME(N)
  141.            WAIT
  142.            SELECT 2
  143.            EXIT
  144.           ENDI
  145.        LOOP
  146.    ENDD
  147. *
  148. * -- IF NOT CLIPPER DO BELOW, BECAUSE ITS FASTER IN DBASE
  149. *
  150.   ENDI
  151.     IF .NOT. CLIPPER
  152.       SELE 2
  153.       USE DATADICT 
  154.   ?'Please write down field names in your List. '
  155.   ?'Field name, type, length and decimals will be given.'
  156.   WAIT
  157.   CLEAR
  158.  DO WHIL .T.
  159.   DISPLAY NEXT 19 FIELD_NAME, FIELD_TYPE, FIELD_LEN, FIELD_DEC
  160.   WAIT 'More Y/N ? ' TO MMORE
  161.      IF UPPER(MMORE) = 'Y'
  162.         CLEAR
  163.         LOOP
  164.      ELSE
  165.         CLEAR
  166.         EXIT
  167.      ENDI
  168.  ENDD
  169. *
  170. * -- End of Clipper/Not Clipper
  171. *
  172. ENDI
  173. *
  174. * -- End of display fields routine
  175. *
  176. ENDI
  177. *
  178. * -- Put the List fields together
  179. *     
  180. * -- GET THE List WIDTH, CONTROL INPUTS
  181. *
  182. MWIDTH = 80
  183. @ 12,1 SAY 'List width (80 - 233 columns)... '
  184. @ 12,34 GET MWIDTH PICTURE '999' 
  185. READ
  186. *
  187. * -- THESE MEMVARS ARE USED AS BUILDING BLOCKS FOR THE List
  188. *
  189. MBUILD = ' '             && Combines field names with +
  190. MSPACES = 0              && Columns remaining in List
  191. *
  192. * -- GET THE FIELDS
  193. * -- KEEP LOOPING UNTIL DONE
  194. *
  195. *
  196. * -- Screen, Printer, File DETERMINES HOW MEMVARS ARE STORED
  197. * -- Screen and Printer are natural and seperated by ,
  198. * -- To file converts all to Character and seperates by +
  199. * -- Before fields are entered, ultimate direction must be determined
  200. *
  201. WAIT 'Is List to go to <F>ile, <S>creen or <P>rinter ' to MWHERE
  202.   DO CASE
  203.    CASE UPPER(MWHERE) = 'P'
  204.    STORE ' PRINT' TO MTOWHERE
  205.   
  206.    CASE UPPER(MWHERE) = 'S'
  207.    STORE ' SCREEN ' TO MTOWHERE
  208.   
  209.    CASE UPPER(MWHERE) = 'F'
  210.     ACCEPT 'File name to sent List to (.txt extension is automatic) .... ' TO MFILE
  211.                 IF LEN(MFILE) > 8
  212.                  ?'File name is too long - 8 letter max'
  213.                  WAIT
  214.                  LOOP
  215.                 ENDI
  216.  
  217.    OTHERWISE
  218.      WAIT
  219. ENDCASE
  220.  
  221. *
  222. * -- PREPARE FOR List ERROR CHECK ON FIELD NAMES
  223. *
  224.   SELECT 2
  225.   USE DATADICT
  226. *
  227. CLEAR
  228. DO WHILE  .T.
  229. ACCEPT 'Field name for List or <enter> if done... ' TO MFIELD
  230. *
  231. *  -- If done exit
  232. *
  233.   IF "" = MFIELD
  234.     EXIT
  235.   ENDI
  236. *
  237. * -- ERROR CHECK FIELD NAME AND TYPE
  238. *
  239.   STORE UPPER(MFIELD) TO MFIELD
  240.   SET EXACT ON
  241.    LOCATE FOR FIELD_NAME = '&MFIELD'
  242.          IF EOF()
  243.            ?'Not a field name '
  244. *
  245. * -- If an error, get rid of field name
  246. *
  247.            MFIELD = SPACE(10)
  248.            LOOP
  249.          ENDI
  250. *
  251. * -- CHECK COLUMNS LEFT
  252. *
  253. STORE MWIDTH - FIELD_LEN  TO MWIDTH
  254.  IF MWIDTH < 1
  255.   ?' OUT OF SPACE '
  256.   ?' Field not accepted'
  257.   MFIELD = SPACE(10)
  258.   WAIT
  259.   LOOP
  260.  ENDI
  261. *
  262. * -- IN CLIPPER or
  263. * -- To send data to a file, all must be converted to 'C' type fields
  264. * -- First field is top condition, then lower condition
  265. * -- Because List treats all fields as characters, non C fields must
  266. * -- be converted prior to being added to the Build list
  267. * -- My programs do no use L fields (just C fields 1 character long)
  268. *
  269.   IF CLIPPER
  270.       IF FIELD_TYPE = 'N'
  271.          STORE 'STR('+'&MFIELD'+')'+ ' ' TO MFIELD
  272.       ENDI
  273. *
  274.       IF FIELD_TYPE = 'D'
  275.          STORE 'DTOC('+'&MFIELD'+')' TO MFIELD
  276.       ENDI
  277.   ENDI
  278. **********
  279. *
  280. * -- Must be done in DBASE for File directed programs, but will
  281. * -- be restored twice in Clipper without .NOT. CLIPPER
  282. *
  283. IF .NOT. CLIPPER
  284.   IF UPPER(MWHERE) = 'F'
  285.       IF FIELD_TYPE = 'N'
  286.          STORE 'STR('+'&MFIELD'+')' TO MFIELD
  287.       ENDI
  288. *
  289.       IF FIELD_TYPE = 'D'
  290.          STORE DTOC(MFIELD) TO MFIELD
  291.       ENDI
  292.    ENDI
  293. ENDI
  294. * -- Clipper cannot read commas in memvars AND
  295. * -- FILE DIRECTED Lists REQUIRE + INSTEAD OF ,
  296. *
  297.  IF MBUILD = ' '
  298.      STORE MFIELD TO MBUILD
  299.  ELSE
  300.      IF CLIPPER
  301.          STORE MBUILD + "+" + " " + MFIELD TO MBUILD
  302.      ENDI
  303. *
  304.    IF .NOT. CLIPPER
  305.      IF UPPER(MWHERE) = 'F'
  306.          STORE MBUILD + "+"  + " " + MFIELD  TO MBUILD
  307.      ELSE
  308.          STORE MBUILD + ","  + MFIELD  TO MBUILD
  309.      ENDI
  310.    ENDI
  311.  ENDI
  312.  
  313. *
  314. * -- Display space left
  315. *
  316. ?'TOTAL COLUMNS LEFT '
  317. ? MWIDTH
  318. LOOP
  319. *
  320. * -- Option to save format
  321. *
  322. ENDDO
  323.   WAIT 'Save this List format  Y/N ? ' TO MSAVE
  324.        IF UPPER(MSAVE)='Y'
  325.         ?'Indicate in list name which database is in use.'
  326.         ?'If saving a list for database named MASTER.DBF'
  327.         ?'and the list consisted of Company, First, Last...'
  328.         ?'you might name the list MSCONAME  (MS -Master CO -company NAME).'
  329.         ?
  330.         ACCEPT '1-8 letter name (.LST extension is automatic).. 'TO MNAME
  331.         STORE MNAME + '.LST' TO MNAME
  332.         SAVE ALL LIKE M* TO &MNAME
  333.        ENDI
  334. ******************************************************
  335. *
  336. * -- END OF CASE CONDITIONS -- BELOW APPLIES FOR 1 OR 2
  337. *
  338. ENDCASE
  339. *
  340. * -- Set conditions if any
  341. * -- Only single conditions allowed i.e. FIELD > 6  etc
  342. * -- I stay away from supplying clients with complex routines like
  343. * -- multiple conditions, since it quadruples my tech support and
  344. * -- eventually puts me out of business.
  345. *
  346. WAIT 'Is List for <A>ll records, or just <S>ome ' TO MMANY
  347.  IF UPPER(MMANY) = 'S'
  348.    MCMD = "LIST "
  349.    DO ERRORCHK
  350. *
  351. * -- MOVE FIELD LIST TO MFIELD TO DISPLAY AGAINST ERROR CHECKING
  352. *
  353.   STORE '&MCOND' TO MFIELD
  354.   STORE 'LIST ' TO MCMD
  355.  ELSE
  356. *
  357. * -- SET A 'DUMMY' CONDITION  i.e. all records, because the hard coded word
  358. * FOR must be in code for this to run under Clipper
  359. *
  360.   STORE 'RECNO() > 0' TO MCOND
  361.  ENDI
  362.  
  363. *
  364. * -- Send List to a text file for editing
  365. *
  366. IF UPPER(MWHERE) = 'F'
  367.       CLEAR
  368.       @ 12,12 SAY 'Sending data to file and screen '
  369.       SET ALTERNATE TO &MFILE
  370.       SET ALTERNATE ON
  371. ENDI
  372. *
  373. * -- RUN List
  374. *
  375. CLOSE DATABASES
  376. SELE 1
  377. USE &MBASE
  378. SET INDEX TO &MINDEX 
  379. CLEAR
  380. SET FILTER TO &MCOND
  381. GOTO TOP
  382. *
  383. *
  384. * -- SHOW FIELDS
  385. *
  386. IF UPPER(MWHERE) = 'P'
  387. DISPLAY ALL &MBUILD OFF TO PRINT
  388. ENDI
  389. *
  390. IF UPPER(MWHERE) = 'F'
  391. MCOUNTER = 1
  392. DO WHIL .NOT. EOF() 
  393. *
  394. * -- &MBUILD prints the field contents
  395. * -- Send to file
  396. *
  397.    ?&MBUILD
  398. SKIP
  399. LOOP
  400. ENDDO
  401. ENDI
  402. *
  403. IF UPPER(MWHERE) = 'S'
  404.  DO WHIL .NOT. EOF()
  405.    DISPLAY NEXT 17 &MBUILD OFF
  406.    WAIT 'MORE Y/N ' TO MMORE
  407.       IF UPPER(MMORE) = 'N'
  408.         EXIT
  409.       ENDI
  410.   LOOP
  411.  ENDD
  412. ENDI
  413. *
  414. * -- Totals are merely a re summing of field names
  415. *
  416.            WAIT ' DO YOU WANT TOTALS ON ANY FIELDS Y/N? ' TO MTOTAL
  417.                  IF UPPER(MTOTAL) = 'Y'
  418.                   DO WHIL .T.
  419.                     ACCEPT 'Field to total or <enter> to exit ... ' TO MTOTAL
  420.                        IF "" = MTOTAL
  421.                         EXIT
  422.                        ENDI
  423.                     SUM ALL &MTOTAL TO MNUMBER
  424.                     ?'Total for &MTOTAL '
  425.                     ? MNUMBER
  426.                     LOOP
  427.                   ENDD
  428.                  ENDI
  429.                     
  430. *
  431.              IF UPPER(MWHERE) = 'F'
  432.                SET ALTERNATE TO
  433.                SET ALTERNATE OFF
  434.              ENDI
  435.    SET DEVICE TO SCREEN
  436.    CLOSE DATABASE
  437. ENDD
  438.