Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DBT10.ZIP
Filename : DBTPRDEF.PRG
* : (c) 1989 BERNATH COMPUTER
* : 11:25:51 11/1/1989
EXITNOW = .F.
EDITING = .F.
mADDIT = " "
gFG=0
gBG=3
IF LEN(TRIM(gPRT))<8
mKEY = TRIM(gPRT)+SPACE(8-LEN(TRIM(gPRT)))
ELSE
mKEY = gPRT
ENDIF
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:"
CALL DBTOOLS WITH "4,1,0"
@ 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
DO CLRSTAT WITH gFG,gBG
IF .NOT. EDITING
mPRDESC = SPACE(24)
mPRTYPE = 0
mNUMESC = 0
mDFNFILE = mKEY+".PRT"
IF LEN(mDFNFILE)<12
mDFNFILE=TRIM(mDFNFILE)+SPACE(12-LEN(TRIM(mDFNFILE)))
ENDIF
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 mOPT
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,["+mKEY+"]"
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
? STR(mPRTYPE,1)
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
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/