*=====================================================================
*   DBTPROC.PRG - procedure file for dBTools demo
*                 (c) 1990 BERNATH COMPUTER
*                 07/18/1990
*====================================================================
* --------------------------------------------------------------------
*     ERRMSG - Prints error message and pauses
*              DO ERRMSG WITH msg
* --------------------------------------------------------------------
PROCEDURE Errmsg
    PARAMETERS Msg
    MSGLEN = LEN(Msg)
    IF MSGLEN < 32
        MSGLEN = 32
    ENDIF
    ULC=40-(MSGLEN/2)-5
    LRC = 40+(MSGLEN/2)+5

    CALL DBTOOLS WITH "2"
    mWIND = "21,24,8,"+STR(ULC,2)+",11,"+STR(LRC)+",15,4,1,1"
    CALL DBTOOLS WITH mWIND
    mPARAM = "1,9,"+STR(ULC+5,2)+",15,4,0,"+TRIM(Msg)
    CALL DBTOOLS WITH mPARAM
    mPARAM="10,10,"+STR(ULC+5,2)+",15,4"
    CALL DBTOOLS WITH mPARAM
    CALL DBTOOLS WITH "19,24"
RETURN

* ---------------------------------------------------------------------
*   NOTAVAIL - Prints message if a menu option is not complete
* ---------------------------------------------------------------------
PROCEDURE NOTAVAIL
    ? CHR(7)
    CALL DBTOOLS WITH "21,24,9,20,12,62,14,4,1,1"
    CALL DBTOOLS WITH "1,10,25,14,4,0,This option is not yet available"
    CALL DBTOOLS WITH "10,11,28,14,4"
    CALL DBTOOLS WITH "19,24"
RETURN

* ----------------------------------------------------------------
PROCEDURE YESNO
PARAMETERS mYN
    OK = .F.
    mR = ROW()
    mC = COL() - 1
    DO WHILE .NOT. OK
        SET CONFIRM OFF
        SET ESCAPE OFF
        @ mR,mC GET mYN PICTURE "!"
        READ
        SET CONFIRM ON
        DO KEYTRAP
        IF mYN $"YN" .OR. EXITNOW
            OK = .T.
        ELSE
            ? CHR(7)
        ENDIF
    ENDDO
    SET ESCAPE ON
    IF mYN=CHR(27)
        EXITNOW = .T.
    ENDIF
RETURN

* ------------------------------------------------------------------------
*   KEYTRAP - Traps ESCAPE key for Exiting
* ------------------------------------------------------------------------
PROCEDURE KEYTRAP
   IF READKEY() = 12
           CALL DBTOOLS WITH "1,24,0,7,1,0,"+SPACE(78)
           CALL DBTOOLS WITH "1,24,5,7,1,0,Do you wish to exit (Y/N)?"
           @ 24,32 SAY " "
           mYN = " "
           DO YESNO WITH mYN
           DO CASE
               CASE mYN = "Y"
                   EXITNOW = .T.
               CASE mYN = "N"
                   EXITNOW = .F.
           ENDCASE
       CALL DBTOOLS WITH "1,24,0,7,1,0,"+SPACE(78)
   ENDIF
RETURN


* ---------------------------------------------------------------------
*   GETKEY - get a key, check against a valid list
* ---------------------------------------------------------------------
PROCEDURE GETKEY
PARAMETERS mVAR,mGOODKEYS
    GOOD = .F.
    mROW = ROW()
    mCOL = COL() - 1
    SET CONFIRM OFF
    DO WHILE .NOT. GOOD
        @ mROW, mCOL GET mVAR PICTURE "!"
        READ
        DO KEYTRAP
        IF EXITNOW
           EXIT
        ENDIF
        IF mVAR $ mGOODKEYS
            GOOD = .T.
        ELSE
            ? CHR(7)
        ENDIF
    ENDDO
    SET CONFIRM ON
RETURN

*-------------------------------------------------------------------
*  FADELBL
*-------------------------------------------------------------------
PROCEDURE FADELBL
PARAMETERS mLBL
   CALL DBTOOLS WITH "3,7,25,9,43,14,2,4,0,1"
   CALL DBTOOLS WITH "1,8,28,15,2,0,Fade Type "+STR(mLBL,1)
   CALL DBTOOLS WITH "6,18"
RETURN

*--------------------------------------------------------------------
*   RECCOL - recolor column for RECOLOR demo
*--------------------------------------------------------------------
PROCEDURE RECCOL
PARAMETERS mK,mCLR,mLEN
      mCOL = mLEN+(mK-1)*mLEN
      mPARM = "13,2,"+STR(mCOL,2)+",22,"+STR(mCOL+mLEN,2)+","+STR(mCLR,2)+",0"
      CALL DBTOOLS WITH mPARM
RETURN


*------------------------------------------------------------------
* CLRSTAT
*------------------------------------------------------------------
PROCEDURE CLRSTAT
PARAMETERS mFG,mBG
   mP = STR(mFG,2)+","+STR(mBG,2)+",0,"+REPLICATE("±",80)
   CALL DBTOOLS WITH "1,22,0,"+mP
   CALL DBTOOLS WITH "1,23,0,"+mP
   CALL DBTOOLS WITH "1,24,0,"+mP
RETURN
* ---------------------------------------------------------------------
*  SCRHEAD - screen heading
* ---------------------------------------------------------------------
PROCEDURE SCRHEAD
PARAMETERS mSUBTITL
   SET COLOR TO +w/bg
   CALL DBTOOLS WITH "7,2,0,3,0"
   CALL DBTOOLS WITH "3,1,0,5,79,15,1,2,0,0"
   CALL DBTOOLS WITH "1,2,20,15,1,0,d B T O O L S  -  dBASE Enhancement Tools"
   CALL DBTOOLS WITH "1,2,65,7,1,0,Printer:"
   CALL DBTOOLS WITH "1,3,65,7,1,0,"+gPRT
   mL = LEN(mSUBTITL)
   mTAB=39-(mL/2)
   CALL DBTOOLS WITH "1,S,3,"+STR(mTAB,2)+",15,4,0,"+mSUBTITL
   RETURN
*------------------------------------------------------------------------
PROCEDURE MENUMSG
PARAMETERS mT,mFG,mBG
   mPARM = "1,24,13,"+STR(mFG,2)+","+STR(mBG,2)+",0,"
   DO CASE
      CASE mT = 1
         mPARM = mPARM + "Press  and ÄÙ, or first letter to select, Esc to Exit"
      CASE mT = 2
         mPARM = mPARM + "Press  and ÄÙ, or first digit to select, Esc to Exit"
   ENDCASE
   CALL DBTOOLS WITH mPARM
RETURN
* -----------------------------------------------------------------------
*  PAGEHEAD  - Page Heading Routine
* -----------------------------------------------------------------------
PROCEDURE PAGEHEAD
    PARAMETERS mTITLE, mRPTDATE, mPGNUM, mOUTPUT
    mPGNUM = mPGNUM + 1
    mCONT = " "
    DO CASE
        CASE mOUTPUT = "S"
            IF mPGNUM > 1
                @ 23,0
                WAIT "<Q> to Quit, any other key to continue...." TO mCONT
            ENDIF
            CLEAR
            mLINES = 0
            IF UPPER(mCONT)="Q"
                EXITNOW=.T.
                RETURN
            ENDIF
        CASE mOUTPUT = "P"
            IF mPGNUM >1
                EJECT
            ENDIF
            IF LEN(mTITLE)<37
                SPACEFILL = 37-LEN(mTITLE)
            ELSE
                SPACEFILL = 1
            ENDIF
            IF gWIDE
               mTLEN = 128
            ELSE
               mTLEN = 78
            ENDIF
            ? REPLICATE("Í",mTLEN)
            ?  "  F R O N T I E R   E N G I N E E R I N G   I N C ."
            ?  SPACE(2) + TRIM(mTITLE) + SPACE(SPACEFILL) + SPACE(10) + DTOC(mRPTDATE) + SPACE(5) + "Page " + STR(mPGNUM,2)
            ? REPLICATE("Í",mTLEN)
            ?
           mLINES = 7
    ENDCASE
RETURN
*-------------------------------------------------------------------
*  SELPRT - lists available printer dfn files, prompts for selection,
*           validates and loads dfn file
*-------------------------------------------------------------------
PROCEDURE SELPRT
PARAMETERS mRESET,mPRT
         OKPRINT = .F.
         DO WHILE .NOT. OKPRINT
            CALL DBTOOLS WITH "7,0,0,3,0"
            mSPEC = gPATH+"*.PRT"
            CALL DBTOOLS WITH "1,S,4,5,15,1,0,Select a file compatible with your printer, or ESC"
            CALL DBTOOLS WITH "1,6,5,0,3,0,(Do not include extension. .PRT assumed.)"
            set color to n/bg,+bg/n,,bg
            @ 6,0
            DIR &mSPEC
            OKPRINT = .F.
            mL=LEN(TRIM(mPRT))
            IF mL<=7
               mPRT = mPRT + SPACE(8-mL)
            ENDIF
            @ 4,57 get mPRT PICTURE "@!"
            READ
            DO KEYTRAP
            IF EXITNOW
               EXIT
            ENDIF
            mPRTFILE = gPATH+TRIM(mPRT)+".PRT"
            IF FILE(mPRTFILE)
               OKPRINT = .T.
               IF mRESET
                  mPARM = "11,0,0,"+mPRTFILE
                  CALL DBTOOLS WITH mPARM
                  IF SUBSTR(mPARM,1) = "0"
                     OKPRINT = .F.
                     CALL DBTOOLS WITH "2"
                  ENDIF
                  gPRT = mPRT
                  gPRTFILE = gPATH+TRIM(gPRT)+".PRT"
               ENDIF
            ELSE
               DO ERRMSG WITH "Printer file does not exist."
            ENDIF
         ENDDO
         IF mRESET
         mNUMCMDS = 0
         mPRTYPE = 0
         mPRNAME = SPACE(36)
         mTYPEDESC = SPACE(20)
         DO GETPRINFO WITH mNUMCMDS,mPRTYPE,mPRNAME,mTYPEDESC
         @ 6,0 CLEAR
         @ 7,10 SAY mPRNAME
         @ 8,10 SAY "Number of commands: "+STR(mNUMCMDS,2)
         @ 9,10 SAY "Printer type: "+mTYPEDESC
         @ 10,10
         WAIT
         ENDIF
RETURN

*------------------------------------------------------------------
*   GETPRINFO - get printer information
*------------------------------------------------------------------
PROCEDURE GETPRINFO
PARAMETERS mNUMCMDS,mPRTYPE,mPRNAME,mTYPEDESC
   mPARM="11,0,1,"+SPACE(31)
   CALL DBTOOLS WITH mPARM
   mNUMCMDS=ASC(SUBSTR(mPARM,1,1))              && number of defined esc seq
   mPRTYPE=ASC(SUBSTR(mPARM,2,1))               && printer type
   mPRNAME=SUBSTR(mPARM,3,36)                   && printer name
         DO CASE
            CASE mPRTYPE = 0
               mTYPEDESC = "Nonprogrammable"
            CASE mPRTYPE = 1
               mTYPEDESC = "80 col dot matrix"
            CASE mPRTYPE = 2
               mTYPEDESC = "132 col do matrix"
            CASE mPRTYPE = 3
               mTYPEDESC = "Laser/Inkjet"
         ENDCASE
RETURN

*--------------------------------------------------------------------
*  ACQ - accept, change, quit
*--------------------------------------------------------------------
PROCEDURE ACQ
   PARAMETERS mOPT
   mOPT = 1
   mMENUSTR = "9,"+STR(mOPT,2)+",24,25,15,0,1,3,A)ccept,C)hange,Q)uit,@"
   CALL DBTOOLS WITH mMENUSTR
   mOPT = VAL(mMENUSTR)
   DO CLRSTAT WITH gFG,gBG
RETURN

*------------------------------------------------------------------------
*     COLOR CHART
*------------------------------------------------------------------------
PROCEDURE COLCHART
    CALL DBTOOLS WITH "3,4,10,22,44,15,0,2,0,0"
    CALL DBTOOLS WITH "1,5,22,14,0,0,COLOR CHART"
    mFG = 0
    mBG = 0
    DO WHILE mBG < 16
       DO WHILE mFG < 16
          mROW = 6+mBG
          mCOL = 12+(2*mFG)
          mPARM = "1,"+STR(mROW,2)+","+STR(mCOL,2)+","+STR(mFG,2)+","+STR(mBG,2)+",0,a"
          CALL DBTOOLS WITH mPARM
          mFG = mFG + 1
       ENDDO
       mFG = 0
       mBG = mBG + 1
    ENDDO
RETURN

* ----------------------------------------------------------------
*	SHOW_SCAN - show keyboard scancodes using GETKEY
* ----------------------------------------------------------------
procedure SHOW_SCAN
mKEY = 0
mSCAN = 0
set color to w/b
call dbtools with "21,7,13,10,17,66,7,1,3,1"
do while mKEY<>27
   call dbtools with "5,14,12,15,65"
   call dbtools with "1,14,12,14,1,0,Trap a keystoke without echo:"
   call dbtools with "1,15,12,14,1,0,Trap a keystroke with echo:"
   call dbtools with "1,16,12,15,1,0,Press ESC twice to quit"
   mPARM = "25,0"
   @ 14,41 say " "
   call dbtools with mPARM
   mKEY=asc(mPARM)-1
   mSCAN=asc(substr(mPARM,2,1))-1
   @ 14,45 say "Key: "+transform(mKEY,"999")+"  Scan: "+transform(mSCAN,"999")
   mPARM="25,1"
   @ 15,41 say " "
   call dbtools with mPARM
   mKEY=asc(mPARM)-1
   mSCAN=asc(substr(mPARM,2,1))-1
   @ 15,45 say "Key: "+transform(mKEY,"999")+"  Scan: "+transform(mSCAN,"999")
   call dbtools with "6,36"
enddo
call dbtools with "19,7"
return

* --------------------------------------------------------------
*   POPPED - displays option chosen for pulldown menus
* --------------------------------------------------------------
procedure popped
parameters mopt,mprompt
    call dbtools with "21,5,12,45,17,76,1,7,1,1"
    call dbtools with "1,13,48,1,7,0,You have chosen option"
    mSTUFF="number "+str(mopt,1)+" of "+trim(mprompt)
    call dbtools with "1,14,48,1,7,0,"+mSTUFF
    call dbtools with "10,16,47,15,7"
    call dbtools with "19,5"
return

* --------------------------------------------------------
*   TRAPIT - pulldown menu sys control key processor
* --------------------------------------------------------
procedure TRAPIT
PARAMETERS mPARMSTR,HCHOICE,mMAXVAL,mHOTKEY
    mKEY=ASC(SUBSTR(mPARMSTR,4,1))-1            && extract 1st scancode
    mSCAN=ASC(SUBSTR(mPARMSTR,5,1))-1           && extract 2nd scancode
    mRETVAL=0
    DO CASE
       CASE mSCAN = 75   && WEST
           IF HCHOICE=1
               mRETVAL=mMAXVAL
           ELSE
               mRETVAL=HCHOICE-1
           ENDIF
       CASE mSCAN = 77   && EAST
           IF HCHOICE = mMAXVAL
               mRETVAL = 1
           ELSE
               mRETVAL = HCHOICE+1
           ENDIF
        OTHERWISE
           DO &mHOTKEY WITH mKEY,mSCAN,HCHOICE
    ENDCASE
    HCHOICE = -mRETVAL
RETURN


* ------------------------------------------------------------
*   HKMAIN - hotkey processor for DBTMAIN.PRG
* ------------------------------------------------------------
PROCEDURE HKMAIN
PARAMETERS mKEY,mSCAN,HCHOICE
    DO CASE
       CASE mKEY=0 .AND. mSCAN=35               && Alt-h hotkey help window
       * Note: If you wanted to write a context sensitive help routine, you
       * could pass both HCHOICE and VCHOICE to a help routine which would
       * identify which vertical menu and option you were on. Then a DO CASE
       * could be used to display the appropriate help.
           DO HKHELP
           mRETVAL=HCHOICE
       CASE mKEY=0 .AND. mSCAN=31               && Alt-s
           mRETVAL = 1
       CASE mKEY=0 .AND. mSCAN=30               && Alt-a
           mRETVAL = 2
       CASE mKEY=0 .AND. mSCAN=17               && Alt-w
           mRETVAL = 3
       CASE mKEY=0 .AND. mSCAN=50               && Alt-m
           mRETVAL = 4
       CASE mKEY=0 .AND. mSCAN=25               && Alt-p
           mRETVAL = 5
       CASE mKEY=0 .AND. mSCAN=24               && Alt-o
           mRETVAL = 6
       CASE mKEY=17 .AND. mSCAN=0               && Cntrl-q
           mRETVAL = 7
       OTHERWISE
           mRETVAL = -HCHOICE
    ENDCASE
    HCHOICE = -mRETVAL
RETURN

* ------------------------------------------------------------
*   HKPULDN - hotkey processor for DBTPULDN.PRG
* ------------------------------------------------------------
PROCEDURE HKPULDN
PARAMETERS mKEY,mSCAN,HCHOICE
    DO CASE
       CASE mKEY=4 .AND. mSCAN=0   && ^D
           mRETVAL = 1
       CASE mKEY=18 .AND. mSCAN=0  && ^R
           mRETVAL = 2
       CASE mKEY=21 .AND. mSCAN=0  && ^U
           mRETVAL = 3
       CASE mKEY=17 .AND. mSCAN=0  && ^Q
           mRETVAL = 4
       OTHERWISE
            mRETVAL = -HCHOICE
    ENDCASE
    HCHOICE = -mRETVAL
RETURN

* -----------------------------------------------------------
*   HKHELP - popup hotkey help window
* -----------------------------------------------------------
PROCEDURE HKHELP
    CALL DBTOOLS WITH "21,23,5,40,18,74,0,3,2,1"
    CALL DBTOOLS WITH "1,S,6,48,15,1,0,HOTKEY HELP WINDOW"
    CALL DBTOOLS WITH "1,8,41,1,3,0,The following hotkeys are active:"
    CALL DBTOOLS WITH "1,10,50,0,3,0,Screen  : Alt-S"
    CALL DBTOOLS WITH "1,11,50,0,3,0,Audio   : Alt-A"
    CALL DBTOOLS WITH "1,12,50,0,3,0,Windows : Alt-W"
    CALL DBTOOLS WITH "1,13,50,0,3,0,Menus   : Alt-M"
    CALL DBTOOLS WITH "1,14,50,0,3,0,Printer : Alt-P"
    CALL DBTOOLS WITH "1,15,50,0,3,0,Other   : Alt-O"
    CALL DBTOOLS WITH "1,16,50,0,3,0,Quit    : Cntrl-Q"
    CALL DBTOOLS WITH "10,17,44,15,3"
    CALL DBTOOLS WITH "19,23"
RETURN


PROCEDURE DEBUGON
SET TALK ON
SET ECHO ON
SET STEP ON
RETURN

PROCEDURE DEBUGOFF
SET TALK OFF
SET ECHO OFF
SET STEP OFF
RETURN