Simtel MSDOS 1992 September/Simtel20_Sept92.cdr/msdos/ventura/vpapp_7s.arc/EXAMP4.PRG

Text File | 1989-10-09 | 14KB | 483 lines

* dBase III(R) to Ventura Publisher(R) Professional Extension(R)
*
* Written by John Meyer. Copyright (c) John Meyer 1989.
*
* This program is offerred as is with no warranty expressed or implied.
* You may use and modify this program, but it may not be sold, nor
* may any part of it be incorporated into any other program
* which is to be sold.
*
* This dBase program will extract fields in any order from
* any database you choose. These fields are then formatted
* so that they can be directly read into the Professional Extension
* using the ASCII selection in the Load Text/Picture option.
*
* Memo fields are allowed and are converted to a column width of
* 40 characters. This is hard-wired into the program, but can easily
* be changed.
*
* Set the initial environment variables.
*
set confirm on
set scoreboard off
set status off
set safety off
set exact on
set talk off
set echo off
set deleted off
close all
clear all
clear
*
* Let user specify the database and, optionally, the index by which
* the database should be sorted. Let the user also specify which fields
* in the database should be extracted, and in which order.
*
* First, initialize the input variables.
*
mdrv = '                              '
mdbf = '            '
midx = '            '
mout = '            '
entry=.F.
do while .not. entry
  entry=.T.
*
* Re-initialize the length of the input variables for successive passes
* through the input questions.
*
  mdrv = mdrv+replicate(" ",30-len(mdrv))
  mdbf = mdbf+replicate(" ",12-len(mdbf))
  midx = midx+replicate(" ",12-len(midx))
  mout = mout+replicate(" ",12-len(mout))
*
* Generate input screen.
*
  @ 2,4 say 'Enter drive and directory (optional) : ' get mdrv pict '@! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
  @ 3,4 say 'Enter Database File Name             : ' get mdbf pict '@! XXXXXXXXXXX'
  @ 4,4 say 'Enter Index File Name (optional)     : ' get midx pict '@! XXXXXXXXXXX'
  @ 5,4 say 'Output File Name (default-TABLE.TXT) : ' get mout pict '@! XXXXXXXXXXX'
  @ 24,10 say 'Press "Ctrl" plus "End" or "Ctrl" plus "W" when finished.'
  read
*
* Clear the alert lines.
*
  @ 7,0
  @ 8,0
  @ 9,0
*
* Change the default drive and directory, if specified.
*
  if .not. mdrv='                              '
    if ":"$mdrv
      store at(":",mdrv) to start
      store trim(substr(mdrv,start-1,start)) to temp
      set default to &temp
      store trim(substr(mdrv,start+1,len(mdrv))) to temp
      set path to &temp
    else
      set path to &mdrv
    endif
  endif
*
* Check to see if user added the DBF extension to database file name.
* If not, add it.
*
  if .not. "."$mdbf
    mdbf=trim(mdbf)+".DBF"
  else
    mdbf=trim(mdbf)
  endif
*
* Check to see if database file exists.
*
  if .not. file(mdbf)
    clear
    ? chr(7)
    @ 7,10 say '---> Database file ' + mdbf + ' not found <---'
    entry=.F.
  endif
*
* Check if user entered an index file name. If yes, then
* check to see if the file exists.
*
  if midx='                              '
    midx=' '
  else
    if .not. "."$midx
      midx=trim(midx)+".NDX"
    else
      midx=trim(midx)
    endif
    if .not. file(midx)
      clear
      ? chr(7)
      @ 8,10 say '---> Index file ' + midx + ' not found <---'
      entry=.F.
    endif
  endif
*
* If no output file name was specified, assign a default file name called
* TABLE.TXT. Then, check to see if the output file name exists. If
* no extension is specified, dBase will assume .TXT.
*
  if mout='                              '
    mout="table.txt"
  endif
  if .not. "."$mout
    mout=trim(mout)+".txt"
  else
    mout=trim(mout)
  endif
  if file(mout)
    ? chr(7)
    @ 9,10 say '---> Ouput file ' + mout + ' already exists. Pick a new one. <---'
    entry=.F.
  endif
enddo
*
* Open the data base requested by the user.
*
if "."$midx
  midx='index '+midx
endif
use &mdbf &midx
*
* Create a database which contains the field names and
* length of the chosen database.
*
copy structure extended to temptabl
sele b
use temptabl
*
* Check to see if database has more fields than this sample program
* can handle
*
go bott
if recno()>22
  ? chr(7)
  clear
  @ 10,5 say "This database contains more than 22 fields."
  @ 11,5 say "The input form for this program is only"
  @ 12,5 say "set up for 22 fields. If you want this program to work"
  @ 13,5 say "with an unlimited number of fields, you must modify it"
  @ 14,5 say "yourself."
  cancel
endif
*
* Save the stucture database's decimal setting in an "array" variable.
* Then, initialize the sort/selection (field_dec) for each field to 0.
*
* This is required because the selection criteria will be stored in
* the structure database so that it can be sorted. This sorted database
* is then used to print out the fields of the chosen database in the
* order specified.
*
go top
do while .not. eof()
  i=ltrim(str(recno()))
  store field_dec to m_dec&i
  replace field_dec with 0
  skip +1
enddo
*
* Display the headings for the input form.
*
clear
@ 1,0
TEXT
                                 Enter numbers in the Sort Order
                                 column for every field you wish to
                                 retrieve. Enter 1 for the field you wish
                                 to appear in column 1 of the Ventura
                                 Publisher table, 2 for field you wish
                                 to appear in column 2, etc. If you leave
                                 the Sort Order column blank, ALL records
                                 are retrieved.

                                 Enter names in the Tag Name column
                                 if you want a particular field tagged
                                 with a tag other than TABLE TEXT.
ENDTEXT
@ 0,0 say "Sort"
@ 1,0 say "Order"
@ 0,8 say "Field"
@ 1,8 say "Name"
@ 0,22 say "Tag"
@ 1,22 say "Name"
*
* Create the input form for the selection criteria.
* The selection numbers will be stored in the "array" called
* M_ORDER&I. This array information will then be transferred to
* the FIELD_DEC field of the structure database.
*
Y=2
go top
do while .not. eof()
  i=ltrim(str(recno()))
  m_order&i="  "
  @ Y,2 get m_order&i picture "99"
  @ Y,7 say field_name
  Y=Y+1
  skip +1
enddo
*
* Create the input form for special tag names which can be associated
* with each cell in the table, if desired. These tag names are stored
* in the "array" variable called M_TAG&Y.
*
go top
Y=2
do while .not. eof()
  i=ltrim(str(recno()))
  m_tag&i="             "
  @ Y,18 get m_tag&i picture "@!"
  Y=Y+1
  skip +1
enddo
@ 24,10    say 'Press "Ctrl" plus "End" or "Ctrl" plus "W" when finished.'
*
* Enter the information.
*
go top
read
*
* Replace field_dec with order information prior to sorting.
*
go top
do while .not. eof()
  i=ltrim(str(recno()))
  replace field_dec with val(m_order&i)
  skip +1
enddo
*
* Sort the field database so that it can later be used to retrieve
* fields from the chosen database in the order just specified.
*
index on field_dec to temptabl
*
* If at least one criteria was specified, delete all fields which were
* not selected. This will prevent these fields from being extracted to
* the table. If NO selection criteria were given, assume that ALL records
* are to be retrieved in the "natural" order of the database.
*
go bott
if field_dec <>0
  delete all for field_dec=0
endif
*
* Figure out how many fields are in database
*
set deleted on
count all to rec_tot
store ltrim(str(rec_tot)) to srec_tot
*
* We're now ready to begin creating the table file.
* Place the table output into the file specified by the user.
*
set alternate to &mout
*
* Create table header. Only some of the Ventura Publisher
* Professional Extension table parameters are used. The number
* of fields in the structure database determines the number of
* columns.
*
set alternate on
? "@Z_TBL_BEG = COLUMNS("+srec_tot+"), DIMENSION(PT), "
set alternate off
*
* Figure out the widths for each table entry. These are passed to
* Ventura Publisher with the COLWIDTHS parameter.
*
go top
mrow=""
do while .not. eof()
*
* If the field type is NOT a memo field, then use the FIELD_LEN
* value to set the field width of the table.
*
  if field_type <>"M"
    mrow=mrow+"E"+ltrim(str(field_len))+","
  else
*
* If the field type for this record IS a memo field, set the field
* length to 40. If you want to change this, change the "E40" value
* below to a different number. You could also have the user provide
* this value.
*
    mrow=mrow+"E40,"
  endif
  skip +1
enddo
*
* Set the column widths. Also, set above and below space to 12 points,
* space between columns to 0, space between rows to 12 points, vertical
* justification above and below the table to 12 points maximum, and
* use the ruling line definitions for the tags Z_DOUBLE and Z_SINGLE
* for the various ruling lines. Turn KEEP off so the table can break
* across page boundaries
*
* You will probably want to change the HGUTTER to put some space between
* columns. It is set to zero here to avoid ever generating a nuisance
* message within Ventura Publisher that can result if your table has
* lots of columns. If you specify HGUTTER other than zero, you may create
* a situation where no space is left for some of the really narro columns.
*
set alternate on
? "COLWIDTHS("+subst(mrow,1,len(mrow)-1)+"),"
? "ABOVE(12), BELOW(12), HGUTTER(0), VGUTTER(12), VJTOP(12), VJBOT(12), "
? "BOX(Z_DOUBLE), HGRID(Z_SINGLE), VGRID(Z_SINGLE), KEEP(OFF)"
? ""
set alternate off
*
* Generate the tags for each cell in the table. If no tag is
* specified, use TABLE TEXT.
*
go top
tag="@Z_TBL_BODY = "
do while .not. eof()
  i=ltrim(str(recno()))
  if m_tag&i = "                "
    tag=tag+"TABLE TEXT, "
  else
    tag=tag+upper(trim(ltrim(m_tag&i)))+", "
  endif
  skip +1
enddo
set alternate on
? substr(tag,1,len(tag)-2)
? ""
set alternate off
*
* The following code transmits the data from the database.
* Each type of field requires slightly different processing.
*
sele a
go top
do while .not. eof()
  sele b
  go top
  mrow=""
  do while .not. eof()
    store field_name to mfname
    if field_type<>"M"
      store A->&mfname to mtable
    endif
    do case
*
* If the field is a character ("C") field, each comma followed by a
* space must be converted to TWO commas followed by a space. This
* is required because the Professional Extension's table feature uses
* COMMA SPACE as the delimiter between cells in a table.
*
        case field_type="C"
        store 1 to lc
        do while at(", ",substr(mtable,lc,field_len))<>0
          store lc+at(", ",substr(mtable,lc,field_len)) to lc
          store stuff(mtable,lc,1,", ") to mtable
          lc=lc+1
        enddo
*
* If the field is a numeric ("N") field, it must be translated to
* a string field. Since the FIELD_DEC field was overwritten in the
* earlier part of this program, the "array" variable m_dec&i is used
* to specify how many places to generate to the right of the decimal
* point.
*
      case field_type="N"
        i=ltrim(str(recno()))
        store str(mtable,field_len,m_dec&i) to mtable
*
* If the field is a date ("D") field, it must be converted to
* a string field.
*
      case field_type="D"
        store dtoc(mtable) to mtable
*
* If the field is a Logical ("L") field, it must be converted to
* a string field.
*
      case field_type="L"
        if mtable
          store "T" to mtable
        else
          store "F" to mtable
        endif
*
* If the field is a Memo ("M") field, we have to play some tricks to
* get it to print out, since dBase doesn't allow string manipulation
* with memo fields. Fortunately, when Ventura Publisher reads ASCII
* text, it doesn't care whether text is all on one line or whether it
* is spread over several lines. Until Ventura Publisher sees two
* carriage return-line feeds in a row WITH NOTHING IN BETWEEN, it
* assumes that everything should be combined together into one big
* paragraph.
*
      case field_type="M"
        store "" to mtable
        store recno() to mrecn
        sele a
        store field(mrecn) to mmemo
        set alternate on
        ? substr(mrow,1,len(mrow))
        ? &mmemo
        set alternate off
        store "" to mrow
        sele b
    endcase
*
* Combine this cell entry with all previous cell entries. Use the
* SKIP function to get the next database field.
*
    mrow=mrow+ltrim(trim(mtable))+", "
    skip +1
  enddo
*
* Put out the rest of the data unless the last field was a memo field
* (i.e., if mrow contains nothing but a comma followed by a space, then
* the last record was a memo field and all previous fields were already
* sent as part of the memo case statement.
*
  if mrow<>", "
    set alternate on
    ? substr(mrow,1,len(mrow)-2)
    set alternate off
  endif
*
* Use the SKIP function to get the next database record.
*
  sele a
  skip +1
  set alternate on
  ? ""
  set alternate off
enddo
*
* Send the end of table information to the Ventura Publisher file.
* Then, close all files and delete all temporary files.
*
set alternate on
? "@Z_TBL_END = "
? ""
? ""
set alternate off
close alternate
*
* Return all variables to factory defaults. Delete all temporary files.
*
close all
clear all
!del temptabl.*
set default to
set path to
set confirm off
set scoreboard on
set status on
set safety on
set exact off
set deleted on
set talk on
set echo on
return