Liren Large Software Subsidy 5/05.iso/a/a013/1.ddi/SAMPLES.EXE/T_SELVAL.PRG

Text File | 1991-01-25 | 3.8 KB | 137 lines

*****************************************************************
* Test program for SELVALUE function -  FILE T_SELVAL.PRG
*****************************************************************

* Copyright(c) 1991 -- James Occhiogrosso

* Demonstrates use of selection values before running a report


INITGLOBAL()
SETCOLOR(colstd)

* Open the selection database
SELECT 0
USE ITFILE

* Initialize memory variables
INITVARS()

DO WHILE .T.
    CLEAR
    CENTERON(12, 'Selection value demonstration. Proceed? Y/N  ')
    @ 12, COL() - 2 say ''
    IF .NOT. OPCONFIRM()
        EXIT
    ENDIF

    * Select database to use before calling SELVALUE
    SELECT ITFILE

    * Call SELVALUE to allow operator to enter selection values.
    temp_file = SELVALUE("itfile_say", "itfile_get")

    * Check for error condition or operator abort.
    IF EMPTY(temp_file)
        CENTERON(24, 'Aborted! ' + hitanykey)
        INKEY(0)
        LOOP
    ELSE
        CENTERON(24, 'The temporary file is ' + temp_file + ;
                     ' ' + hitanykey)
        INKEY(0)

        /********************************************************
        * Code to run your report goes here. Your report should
        * use the temporary file and index. It file is open and
        * selected in current area. A standard PRG file or a FRM
        * report can be used.
        */*******************************************************

        * Close the temporary file
        USE

        * Erase the temporary DBF and index files

        ERASE (temp_file)
        temp_file = SUBSTR(temp_file, 1, 8) + INDEXEXT()
        ERASE (temp_file)

        * Check for a temporary DBT file. If it exists, erase it
        temp_file = SUBSTR(temp_file, 1, 8) + '.DBT'
        IF FILE(temp_file)
            ERASE (temp_file)
        ENDIF
    ENDIF
ENDDO

FREEVARS()
CLOSE DATABASES
RETURN NIL

/****************************************************************
The procedures below are sample SAY and GET procedures to pass
to SELVALUE.  You may include any number of fields. For best
appearance, do not write below line 18. SELVALUE writes messages
from line 20 to line 24.
****************************************************************/


*****************************************************************
PROCEDURE ITFILE_SAY
*****************************************************************
*
* A typical display procedure to pass to SELVALUE

@  2, 16 SAY 'MAIN INQUIRY FILE -- SELECTION VALUE SCREEN'
@  3, 16 SAY REPLICATE('▀', 43)
@  5,  1 SAY '  Entry Date: '
@  5, 55 SAY 'General Category: '
@  8,  1 SAY '  Company Name: '
@  9,  1 SAY '       Address: '
@ 10,  1 SAY '       Address: '
@ 11,  1 SAY '          City: '
@ 11, 38 SAY 'State: '
@ 11, 61 SAY 'Zip: '
@ 12,  1 SAY '  Contact Last: '
@ 12, 33 SAY 'First '
@ 12, 57 SAY 'PHONE: '
@ 14,  1 SAY '  Last mailing: '
@ 14, 27 SAY 'Number of mailings:   '
@ 14, 54 SAY 'Last Contact: '
@ 15,  1 SAY '  Inquiry date: '
@ 15, 27 SAY 'Follow up date: '
@ 15, 54 SAY 'Print Label? Y/N  '

@ 1, 0 TO 18, 79 DOUBLE
RETURN

*****************************************************************
PROCEDURE ITFILE_GET
*****************************************************************

*  A typical GET procedure to pass to SELVALUE

@ 5,  15 GET mentry
@ 5,  73 GET mfileid PICTURE "99"
@ 8,  17 GET mcompany
@ 9,  17 GET maddres1
@ 10, 17 GET maddres2
@ 11, 17 GET mcity
@ 11, 45 GET mstate PICTURE "@! "
@ 11, 66 GET mzip PICTURE "@! "
@ 12, 17 GET mlname
@ 12, 39 GET mfname
@ 12, 64 GET mphone PICTURE "999-999-9999"
@ 14, 17 GET mlstmail
@ 14, 49 GET mmailno PICTURE  '@Z 99'
@ 14, 68 GET mlstsale
@ 15, 17 GET minqdate
@ 15, 43 GET mfoldate
@ 15, 72 GET mprnlabl PICTURE "Y"

RETURN