Power-Programmierung/CD1.mdf/xbase/library/dbase/commands/glist.prg

Text File | 1986-05-28 | 9.9 KB | 438 lines

* Program......: GLIST.PRG
* Author.......: Glenn R. Abelson
* Date(s)......: 05/10/86
* Notice.......: Copyright 1986, Glenn Abelson Inc., All Rights Reserved
* Notes........: Dbase/Clipper Report Generator
*
PUBLIC CLIPPER,MTOWHERE,MWHERE,MFIELD,MCMD
*
DO WHIL .T.
SET DEVICE TO SCREEN
SET TALK OFF
SET SAFETY OFF
CLEAR
*
* -- MENU OPTIONS
*
IF CLIPPER
frame = CHR(201)+CHR(205)+CHR(187)+CHR(186)+CHR(188)+CHR(205)+CHR(200) +;
CHR(186)
@ 6,20,16,60 BOX frame
@ 7,22,14,58 BOX frame
ELSE
@ 6,20 TO 16,60 DOUBLE
@ 7,22 TO 14,58 DOUBLE
ENDI
@ 1,1 SAY 'Lists may be indexed and conditional for certain records.'
@ 2,1 SAY 'Totals may be generated after Report is printed.'
@ 3,1 SAY 'Lists may be sent to Screen, Printer or a File for later editing.'
@ 4,1 SAY 'Double line Lists cannot be created here.'
*
*
@ 8,30 SAY 'List Options'
@ 10,30 SAY '1. Run an exisiting list'
@ 11,30 say '2. Create and run a list'
@ 12,30 say '<enter> to exit '
*
*
@ 19,0 SAY 'Using &MBASE'
@ 20,0 SAY 'Index &MINDEX'
WAIT 'Your selection ? ' TO CHOICE
   DO CASE
*
* -- EXIT ON <ENTER>
*
      CASE "" = CHOICE
         RETURN
*
*
      CASE CHOICE = '1'
*
* -- Show existing Lists
*
            DIR *.LST
            ?'Be sure list matches with database in use.'
            ACCEPT 'List to run (do not include extension).... ' to MLST
*
* -- MAKE SURE ONLY 8 LETTERS & NO EXT IS USED
*
                    IF LEN(MLST) > 8
                       ?'CAN NOT ACCEPT THAT NAME -- TOO LONG '
                       WAIT
                       LOOP
                    ENDI
*
* -- CHECK FOR EXISTENCE
*
                   IF .NOT. FILE ('&MLST' + '.LST')
                    ?'Check your typing '
                    wait
                    loop
                  ELSE
                     STORE '&MLST' + '.LST' TO MLST
                  ENDI
*
* -- .LST files are really memory variable files with database and field
* -- information
*
             RESTORE FROM &MLST  ADDITIVE
*
* -- Use the database and index option from restore
*
             SELECT 1
             USE &MBASE
             SET INDEX TO &MINDEX
*
* -- Open error check file
*
               SELE 2
               USE DATADICT
*
* -- JUMP TO CONDITIONS SECTION
*
*
*********************
         CASE CHOICE = '2'
*
* -- Exit on empty entry
*
       IF MBASE < "!"
        RETURN
       ENDI
*
* -- LIST FIELDS
*
CLEAR
MLIST = 'N'
@ 8,1 SAY 'DO YOU WANT A FIELD LIST Y/N ? '
@ 8,34 GET MLIST
READ
 IF UPPER(MLIST) = 'Y'
*
* -- Use field list for clipper, because it is fast
*
   IF CLIPPER
     ROW = 2
     CLEAR
  COUNT TO MCOUNT
  SELECT 1
  DO WHIL .T.
     FOR N = 1 TO MCOUNT
       IF ROW > 22
        WAIT
        ROW = 2
        CLEAR
       ENDI
       @ ROW()+1,1 SAY N PICTURE "@B"
       @ ROW(),8 SAY FIELDNAME(N)
        N = N+1
       @ ROW(),22 SAY N PICTURE "@B"
       @ ROW(),28 SAY FIELDNAME(N)
         N = N+1
       @ ROW(),42 SAY N PICTURE "@B"
       @ ROW(),48 SAY FIELDNAME(N)
         N=N+1
       @ ROW(),62 SAY N PICTURE "@B"
       @ ROW(),70 SAY FIELDNAME(N)
         ROW = ROW + 1
        NEXT N
          IF "" = FIELDNAME(N)
           WAIT
           SELECT 2
           EXIT
          ENDI
       LOOP
   ENDD
*
* -- IF NOT CLIPPER DO BELOW, BECAUSE ITS FASTER IN DBASE
*
  ENDI
    IF .NOT. CLIPPER
      SELE 2
      USE DATADICT
  ?'Please write down field names in your List. '
  ?'Field name, type, length and decimals will be given.'
  WAIT
  CLEAR
 DO WHIL .T.
  DISPLAY NEXT 19 FIELD_NAME, FIELD_TYPE, FIELD_LEN, FIELD_DEC
  WAIT 'More Y/N ? ' TO MMORE
     IF UPPER(MMORE) = 'Y'
        CLEAR
        LOOP
     ELSE
        CLEAR
        EXIT
     ENDI
 ENDD
*
* -- End of Clipper/Not Clipper
*
ENDI
*
* -- End of display fields routine
*
ENDI
*
* -- Put the List fields together
*
* -- GET THE List WIDTH, CONTROL INPUTS
*
MWIDTH = 80
@ 12,1 SAY 'List width (80 - 233 columns)... '
@ 12,34 GET MWIDTH PICTURE '999'
READ
*
* -- THESE MEMVARS ARE USED AS BUILDING BLOCKS FOR THE List
*
MBUILD = ' '             && Combines field names with +
MSPACES = 0              && Columns remaining in List
*
* -- GET THE FIELDS
* -- KEEP LOOPING UNTIL DONE
*
*
* -- Screen, Printer, File DETERMINES HOW MEMVARS ARE STORED
* -- Screen and Printer are natural and seperated by ,
* -- To file converts all to Character and seperates by +
* -- Before fields are entered, ultimate direction must be determined
*
WAIT 'Is List to go to <F>ile, <S>creen or <P>rinter ' to MWHERE
  DO CASE
   CASE UPPER(MWHERE) = 'P'
   STORE ' PRINT' TO MTOWHERE

   CASE UPPER(MWHERE) = 'S'
   STORE ' SCREEN ' TO MTOWHERE

   CASE UPPER(MWHERE) = 'F'
    ACCEPT 'File name to sent List to (.txt extension is automatic) .... ' TO MFILE
                IF LEN(MFILE) > 8
                 ?'File name is too long - 8 letter max'
                 WAIT
                 LOOP
                ENDI

   OTHERWISE
     WAIT
ENDCASE

*
* -- PREPARE FOR List ERROR CHECK ON FIELD NAMES
*
  SELECT 2
  USE DATADICT
*
CLEAR
DO WHILE  .T.
ACCEPT 'Field name for List or <enter> if done... ' TO MFIELD
*
*  -- If done exit
*
  IF "" = MFIELD
    EXIT
  ENDI
*
* -- ERROR CHECK FIELD NAME AND TYPE
*
  STORE UPPER(MFIELD) TO MFIELD
  SET EXACT ON
   LOCATE FOR FIELD_NAME = '&MFIELD'
         IF EOF()
           ?'Not a field name '
*
* -- If an error, get rid of field name
*
           MFIELD = SPACE(10)
           LOOP
         ENDI
*
* -- CHECK COLUMNS LEFT
*
STORE MWIDTH - FIELD_LEN  TO MWIDTH
 IF MWIDTH < 1
  ?' OUT OF SPACE '
  ?' Field not accepted'
  MFIELD = SPACE(10)
  WAIT
  LOOP
 ENDI
*
* -- IN CLIPPER or
* -- To send data to a file, all must be converted to 'C' type fields
* -- First field is top condition, then lower condition
* -- Because List treats all fields as characters, non C fields must
* -- be converted prior to being added to the Build list
* -- My programs do no use L fields (just C fields 1 character long)
*
  IF CLIPPER
      IF FIELD_TYPE = 'N'
         STORE 'STR('+'&MFIELD'+')'+ ' ' TO MFIELD
      ENDI
*
      IF FIELD_TYPE = 'D'
         STORE 'DTOC('+'&MFIELD'+')' TO MFIELD
      ENDI
  ENDI
**********
*
* -- Must be done in DBASE for File directed programs, but will
* -- be restored twice in Clipper without .NOT. CLIPPER
*
IF .NOT. CLIPPER
  IF UPPER(MWHERE) = 'F'
      IF FIELD_TYPE = 'N'
         STORE 'STR('+'&MFIELD'+')' TO MFIELD
      ENDI
*
      IF FIELD_TYPE = 'D'
         STORE DTOC(MFIELD) TO MFIELD
      ENDI
   ENDI
ENDI
* -- Clipper cannot read commas in memvars AND
* -- FILE DIRECTED Lists REQUIRE + INSTEAD OF ,
*
 IF MBUILD = ' '
     STORE MFIELD TO MBUILD
 ELSE
     IF CLIPPER
         STORE MBUILD + "+" + " " + MFIELD TO MBUILD
     ENDI
*
   IF .NOT. CLIPPER
     IF UPPER(MWHERE) = 'F'
         STORE MBUILD + "+"  + " " + MFIELD  TO MBUILD
     ELSE
         STORE MBUILD + ","  + MFIELD  TO MBUILD
     ENDI
   ENDI
 ENDI

*
* -- Display space left
*
?'TOTAL COLUMNS LEFT '
? MWIDTH
LOOP
*
* -- Option to save format
*
ENDDO
  WAIT 'Save this List format  Y/N ? ' TO MSAVE
       IF UPPER(MSAVE)='Y'
        ?'Indicate in list name which database is in use.'
        ?'If saving a list for database named MASTER.DBF'
        ?'and the list consisted of Company, First, Last...'
        ?'you might name the list MSCONAME  (MS -Master CO -company NAME).'
        ?
        ACCEPT '1-8 letter name (.LST extension is automatic).. 'TO MNAME
        STORE MNAME + '.LST' TO MNAME
        SAVE ALL LIKE M* TO &MNAME
       ENDI
******************************************************
*
* -- END OF CASE CONDITIONS -- BELOW APPLIES FOR 1 OR 2
*
ENDCASE
*
* -- Set conditions if any
* -- Only single conditions allowed i.e. FIELD > 6  etc
* -- I stay away from supplying clients with complex routines like
* -- multiple conditions, since it quadruples my tech support and
* -- eventually puts me out of business.
*
WAIT 'Is List for <A>ll records, or just <S>ome ' TO MMANY
 IF UPPER(MMANY) = 'S'
   MCMD = "LIST "
   DO ERRORCHK
*
* -- MOVE FIELD LIST TO MFIELD TO DISPLAY AGAINST ERROR CHECKING
*
  STORE '&MCOND' TO MFIELD
  STORE 'LIST ' TO MCMD
 ELSE
*
* -- SET A 'DUMMY' CONDITION  i.e. all records, because the hard coded word
* FOR must be in code for this to run under Clipper
*
  STORE 'RECNO() > 0' TO MCOND
 ENDI

*
* -- Send List to a text file for editing
*
IF UPPER(MWHERE) = 'F'
      CLEAR
      @ 12,12 SAY 'Sending data to file and screen '
      SET ALTERNATE TO &MFILE
      SET ALTERNATE ON
ENDI
*
* -- RUN List
*
CLOSE DATABASES
SELE 1
USE &MBASE
SET INDEX TO &MINDEX
CLEAR
SET FILTER TO &MCOND
GOTO TOP
*
*
* -- SHOW FIELDS
*
IF UPPER(MWHERE) = 'P'
DISPLAY ALL &MBUILD OFF TO PRINT
ENDI
*
IF UPPER(MWHERE) = 'F'
MCOUNTER = 1
DO WHIL .NOT. EOF()
*
* -- &MBUILD prints the field contents
* -- Send to file
*
   ?&MBUILD
SKIP
LOOP
ENDDO
ENDI
*
IF UPPER(MWHERE) = 'S'
 DO WHIL .NOT. EOF()
   DISPLAY NEXT 17 &MBUILD OFF
   WAIT 'MORE Y/N ' TO MMORE
      IF UPPER(MMORE) = 'N'
        EXIT
      ENDI
  LOOP
 ENDD
ENDI
*
* -- Totals are merely a re summing of field names
*
           WAIT ' DO YOU WANT TOTALS ON ANY FIELDS Y/N? ' TO MTOTAL
                 IF UPPER(MTOTAL) = 'Y'
                  DO WHIL .T.
                    ACCEPT 'Field to total or <enter> to exit ... ' TO MTOTAL
                       IF "" = MTOTAL
                        EXIT
                       ENDI
                    SUM ALL &MTOTAL TO MNUMBER
                    ?'Total for &MTOTAL '
                    ? MNUMBER
                    LOOP
                  ENDD
                 ENDI

*
             IF UPPER(MWHERE) = 'F'
               SET ALTERNATE TO
               SET ALTERNATE OFF
             ENDI
   SET DEVICE TO SCREEN
   CLOSE DATABASE
ENDD