home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
DATABASE
/
DBT123S.ZIP
/
DBTPRDEF.PRG
< prev
next >
Wrap
Text File
|
1990-07-24
|
5KB
|
185 lines
* Program : DBTPRDEF.PRG
* : (c) 1990 BERNATH COMPUTER
* : 07/24/1990
EXITNOW = .F.
EDITING = .F.
mADDIT = " "
gFG=0
gBG=3
mP = GETE("DBTPRT")
mKEY = mP+SPACE(8-LEN(mP))
SELECT B
USE PRNDEF INDEX PRNDEF
SELECT A
USE ESCCODES INDEX ESCCODES
DO WHILE .NOT. EXITNOW
SET COLOR TO B/BG,+BG/N,,BG
DO SCRHEAD WITH "Edit Printer Escape Codes"
CALL DBTOOLS WITH "3,7,5,15,75,15,3,1,0,0"
CALL DBTOOLS WITH "1,8,7,1,3,0,Printer key:"
CALL DBTOOLS WITH "1,8,30,1,3,0,Description:"
CALL DBTOOLS WITH "1,10,7,1,3,0,Printer type:"
CALL DBTOOLS WITH "1,13,7,1,3,0,Maximum number of escape sequences:"
CALL DBTOOLS WITH "1,14,7,1,3,0,Printer definition file:"
@ 8,20 GET mKEY PICTURE "@!"
READ
DO KEYTRAP
IF EXITNOW
EXIT
ENDIF
SELECT B
SEEK mKEY
IF .NOT. FOUND()
CALL DBTOOLS WITH "2"
DO CLRSTAT WITH gFG,gBG
CALL DBTOOLS WITH "1,24,5,11,0,0,Printer definition not found. Add (Y/N)?"
mADDIT = " "
@ 24,46 SAY mADDIT
DO YESNO WITH mADDIT
IF .NOT. EDITING
mPRDESC = SPACE(24)
mPRTYPE = 0
mNUMESC = 0
mDFNFILE = gPRT+SPACE(30-LEN(TRIM(gPRT)))
ENDIF
ELSE
IF .NOT. EDITING
mPRDESC = PRDESC
mPRTYPE = PRTYPE
mNUMESC = NUMESC
mDFNFILE = DFNFILE
ENDIF
ENDIF
@ 8,43 GET mPRDESC
READ
DO KEYTRAP
IF EXITNOW
EXIT
ENDIF
mMENUSTR="9,"+STR(mPRTYPE+1,2)+",11,7,0,3,11,1,"
mMENUSTR=mMENUSTR+"0. Nonprog,1. 80 col dot matrix,2. 132 col dot matrix,3. Laser,@"
CALL DBTOOLS WITH mMENUSTR
mPRTYPE = VAL(mMENUSTR)-1
IF mPRTYPE<0 .OR. EXITNOW
EXIT
ENDIF
@ 13,45 GET mNUMESC PICTURE "99"
@ 14,32 GET mDFNFILE PICTURE "@!"
READ
DO KEYTRAP
IF EXITNOW
EXIT
ENDIF
mOPT = 1
DO ACQ WITH mOPT
DO CASE
CASE mOPT = 1
IF mADDIT = "Y"
APPEND BLANK
ENDIF
REPLACE KEY WITH mKEY,;
PRDESC WITH mPRDESC,;
PRTYPE WITH mPRTYPE,;
NUMESC WITH mNUMESC,;
DFNFILE WITH mDFNFILE
EDITING = .F.
mADDIT = " "
CASE mOPT = 2
EDITING = .T.
CASE mOPT = 3 .OR. mOPT = 0
EXITNOW = .T.
EXIT
ENDCASE
IF mOPT = 1
EXIT2 = .F.
DO WHILE .NOT. EXIT2
CALL DBTOOLS WITH "7,2,0,3,0"
CALL DBTOOLS WITH "3,1,5,4,75,15,1,2,0,0"
CALL DBTOOLS WITH "1,2,20,15,1,0,Edit escape codes for printer:"
CALL DBTOOLS WITH "1,2,51,11,1,0,["+mDFNFILE+"]"
mL = LEN(TRIM(mPRDESC))
mT = 40-(mL/2)
CALL DBTOOLS WITH "1,3,"+STR(mT,2)+",11,1,0,"+mPRDESC
CALL DBTOOLS WITH "3,6,5,20,75,15,3,1,0,1"
SELECT A
LOCATE FOR KEY = mKEY
IF .NOT. FOUND()
KOUNT = 1
DO WHILE KOUNT <= mNUMESC
APPEND BLANK
REPLACE KEY WITH mKEY,;
SEQNUM WITH KOUNT,;
ATTRDESC WITH SPACE(24)
REPLACE ESC01 WITH 0,ESC02 WITH 0,ESC03 WITH 0,ESC04 WITH 0,;
ESC05 WITH 0,ESC06 WITH 0,ESC07 WITH 0,ESC08 WITH 0
REPLACE ESC09 WITH 0,ESC10 WITH 0,ESC11 WITH 0,ESC12 WITH 0,;
ESC13 WITH 0,ESC14 WITH 0,ESC15 WITH 0,ESC16 WITH 0
KOUNT = KOUNT + 1
ENDDO
GO TOP
LOCATE FOR KEY = mKEY
ENDIF
set filter to KEY=mKEY
BROWSE && LOCK 2 NOAPPEND
set filter to
mFILE = gPATH+mDFNFILE
IF FILE(mFILE)
? CHR(7)
CALL DBTOOLS WITH "21,10,8,15,11,70,15,4,2,1"
CALL DBTOOLS WITH "1,9,18,15,4,0,File "+TRIM(mFILE)+" already exists."
CALL DBTOOLS WITH "1,10,18,15,4,0,Overwrite (Y/N)?"
mYN = " "
@ 10,35 say mYN
DO YESNO WITH mYN
CALL DBTOOLS WITH "19,10"
IF mYN <> "Y"
EXITNOW = .T.
EXIT
ENDIF
ENDIF
SET ALTERNATE TO &mFILE
SET ALTERNATE ON
?? "@PRNDEF"
? mPRDESC
KOUNT = 1
LOCATE FOR KEY=mKEY
DO WHILE KOUNT <= mNUMESC
mESC = 1
mSTUFF = STR(KOUNT,2)+": "
NOMORE = .F.
DO WHILE .NOT. NOMORE
mFLD = FIELD(mESC+3)
IF &mFLD = 0
mSTUFF=mSTUFF+" 0,@"
NOMORE = .T.
ELSE
mSTUFF=mSTUFF+STR(&mFLD,3)+","
ENDIF
mESC = mESC + 1
IF mESC > 16
NOMORE = .T.
ENDIF
ENDDO
? mSTUFF
KOUNT = KOUNT + 1
SKIP
ENDDO
? "@@"
SET ALTERNATE OFF
SET ALTERNATE TO
?
CALL DBTOOLS WITH "10,24,25,0,3"
EXIT2 = .T.
ENDDO
ENDIF
ENDDO
CLOSE DATABASES
RELEASE ALL EXCEPT g*
gNUMOPT = 2
EXITNOW = .F.
RETURN