* =====================================================================
*   PROCDEMO.PRG - demo for PROCFILE procedures using dBTOOLS
*                  (c) 1990 BERNATH COMPUTER
*                  07/20/1990
* =====================================================================
SET BELL OFF
SET STATUS OFF
SET COLOR TO W/N,N/W,,N

PUBLIC gFG,gBG,gPATH,gNUMOPT,gSYSTITL,gPRT
* Extract environment information
gPATH = GETENV("DBTOOLS")
IF LEN(gPATH) = 0
    gPATH = SPACE(48)
    CLEAR
    @ 5,0 SAY "Path for PROCFILE demo files and DBTOOLS.BIN: "
    @ 6,0 GET gPATH PICTURE "@!"
    READ
    gPATH = TRIM(gPATH)
ENDIF
SET PATH TO &gPATH
mEXP = gPATH+"\DBTOOLS"                         && Load dBTools
LOAD &mEXP
CALL DBTOOLS WITH "23,0"                        && blink off
CALL DBTOOLS WITH "24,1,6/38"                   && brown-->orange
mEXP = gPATH+"\PROCFILE"
SET PROCEDURE TO &mEXP                          && Load procedure file
gPRT = GETENV("DBTPRT")

gSYSTITL = "d B T o o l s    P R O C E D U R E    D E M O"
EXITNOW = .F.
ABORT = .F.
gFG = 0
gBG = 7
m_CHOICE = 1
DO WHILE .T.
    DO SCRHEAD WITH gSYSTITL,"Main Menu",12,1
    DO MENUMSG WITH 1,0,7
    mMENUSTR="20,Y,"+STR(m_CHOICE,2)+",0,7,20,14,55,0,3,1,1,11,0,2,"
    mMENUSTR=mMENUSTR+"Error Message,Not Available,Data Entry Example,Fun with Boxes,YesNo and Getkey,Quit,@"
    CALL DBTOOLS WITH mMENUSTR
    m_CHOICE = VAL(mMENUSTR)
    DO CASE
       CASE m_CHOICE = 1
          DO ERRMSG WITH "This is an example error message."
       CASE m_CHOICE = 2
          DO NOTAVAIL
       CASE m_CHOICE = 3
          DO SCRHEAD WITH "SAMPLE DATA ENTRY PROGRAM","Introduction",0,1
          CALL DBTOOLS WITH "3,6,5,19,73,14,2,2,0,1"
          CALL DBTOOLS WITH "1,S,7,23,10,1,0,Accounting Data Entry Example"
          SET COLOR TO N/G
          @ 9,8 SAY "This is some sample code from part of an accounting application"
          @ 10,8 say "I wrote. This particular module maintains the Chart of Accounts."
          @ 12,8 say "Trying printing the Chart of Accounts first, and then edit a few"
          @ 13,8 say "of the existing accounts. Note how a validation is done on the"
          @ 14,8 say "Parent account (ie, it must already exist). Add a few accounts."
          @ 15,8 say "Take a look at the code, and see how dBTools can turn your dBASE"
          @ 16,8 say "applications from drab to flashy!"
          m_VAR = "10,Y,18,20,14,2,ESC to exit, any other key to continue..."
          CALL DBTOOLS WITH m_VAR
          IF ASC(m_VAR)-1 <> 27                 && extract scancode
              DO ACCTMENU
          ENDIF

       CASE m_CHOICE = 4                        && Box fun
          CALL DBTOOLS WITH "15,1"
          CALL DBTOOLS WITH "13,0,0,24,79,8,0"
          mKEY = 0
          mULR=8
          mULC=25

          DO WHILE mKEY<>27                     && end loop on ESC
              * setup window
              mPARM="21,9,"+STR(mULR,2)+","+STR(mULC,2)+","+STR(mULR+5,2)+","+STR(mULC+40,2)+",15,4,1,1"
              CALL DBTOOLS WITH mPARM
              * print message
              CALL DBTOOLS WITH "1,"+STR(mULR+1,2)+","+STR(mULC+2,2)+",7,4,0,Move the box with the arrow keys"
              * use PAUSE to trap direction keys
              m_VAR="10,Y,"+STR(mULR+4,2)+","+STR(mULC+2,2)+",15,4,Press <-->  Home End PgUp PgDn ESC"
              CALL DBTOOLS WITH m_VAR
              mKEY = ASC(m_VAR)-1
              mSCAN= ASC(SUBSTR(m_VAR,2,1))-1
              DO CASE
                 CASE mSCAN = 75                 && west
                    mULC = mULC - 1
                    IF mULC < 0
                        ? CHR(7)
                        mULC = 0
                    ENDIF
                 CASE mSCAN = 77                 && east
                    mULC = mULC + 1
                    IF mULC > 39
                        ? CHR(7)
                        mULC = 39
                    ENDIF
                 CASE mSCAN = 80                 && south
                    mULR = mULR + 1
                    IF mULR > 18
                       ? CHR(7)
                       mULR = 18
                    ENDIF
                 CASE mSCAN = 72                 && north
                    mULR = mULR - 1
                    IF mULR < 0
                       ? CHR(7)
                       mULR = 0
                    ENDIF
                 CASE mSCAN = 71                 && home
                    mULR = 0
                    mULC = 0
                 CASE mSCAN = 79                 && end
                    mULC = 39
                    mULR = 18
                 CASE mSCAN = 73                 && PgUp
                    mULR = 0
                 CASE mSCAN = 81                 && PgDn
                    mULR = 18
                 OTHERWISE
                    ?? CHR(7)
              ENDCASE
              CALL DBTOOLS WITH "19,9"          && unpop window
          ENDDO                                 && loop back

       CASE m_CHOICE = 5
          CALL DBTOOLS WITH "13,0,0,24,79,8,0"
          CALL DBTOOLS WITH "3,9,22,17,65,14,6,5,0,0"
          CALL DBTOOLS WITH "1,10,33,14,6,0,YesNo and Validkey example"
          CALL DBTOOLS WITH "1,11,38,14,6,0,(ESC to quit)"
          CALL DBTOOLS WITH "1,12,25,15,6,0,You're monitor is about to turn into"
          CALL DBTOOLS WITH "1,13,25,15,6,0,a heap of molten slag."
          CALL DBTOOLS WITH "1,14,30,14,6,0,Do you wish to continue (Y/N)?"
          mYN = " "
          @ 14,61 SAY mYN
          DO YESNO WITH mYN
          CALL DBTOOLS WITH "5,12,23,14,64,6"
          CALL DBTOOLS WITH "1,12,25,15,6,0,LEGAL KEYS:  D B T O L S"
          CALL DBTOOLS WITH "1,14,25,14,6,0,Press a key:"
          DO WHILE mYN<>"Q"
             mYN = " "
             gFG=8
             gBG=0
             @ 14,39 SAY mYN
             DO VALIDKEY WITH mYN,"DBTOLS"
             IF EXITNOW .OR. mYN = "Q"
                EXIT
             ELSE
                CALL DBTOOLS WITH "1,15,39,0,6,0,"+mYN+" Valid"
             ENDIF
          ENDDO
          gFG = 0
          gBG = 7
       CASE m_CHOICE = 6 .OR. m_CHOICE = 0
           ABORT = .T.
       CASE m_CHOICE = 99
           mKEY  = ASC(SUBSTR(mMENUSTR,4,1))-1
           mSCAN = ASC(SUBSTR(mMENUSTR,5,1))-1
           m_CHOICE = ASC(SUBSTR(mMENUSTR,6,1))
    ENDCASE
    IF ABORT

        EXIT
    ENDIF
ENDDO
CALL DBTOOLS WITH "23,1"
QUIT