290 lines
8.9 KiB
QBasic
290 lines
8.9 KiB
QBasic
\ ********************************************
|
||
\ * TEST PROGRAM FOR PC DOS SCREEN CONTROL *
|
||
\ ********************************************
|
||
\ * This program was written and tested by *
|
||
\ * Digital Research Technical Support *
|
||
\ ********************************************
|
||
integer ROW, COL, RET, I, J
|
||
string PAD, SP, TL
|
||
|
||
%include PCSCRN.DEF
|
||
|
||
TL = string$(8,"0123456789")
|
||
PAD = string$(76,chr$(1))
|
||
SP = string$(60," ")
|
||
|
||
def PRTCTR (S$,ROW)
|
||
integer PRTCTR, ROW, COL
|
||
COL = int%((79-len(S$))/2)
|
||
call setcur(ROW,COL) : print S$;
|
||
fend
|
||
|
||
|
||
def TST.OK (TEST)
|
||
integer TST.OK, TEST
|
||
string YN, ERR.TST
|
||
YN = ucase$(chr$(inkey))
|
||
if YN <> "N" then return
|
||
on TEST goto 1,2,3,4,5,6,7,8,9,10,11,12,13
|
||
1: ERR.TST = "CLEAR SCREEN" : goto EXIT
|
||
2: ERR.TST = "HOME CURSOR" : goto EXIT
|
||
3: ERR.TST = "ERASE TO END OF LINE" : goto EXIT
|
||
4: ERR.TST = "ERASE TO END OF SCREEN" : goto EXIT
|
||
5: ERR.TST = "SET CURSOR POSITION" : goto EXIT
|
||
6: ERR.TST = "GET CURRENT CURSOR POSITION" : goto EXIT
|
||
7: ERR.TST = "MOVE CURSOR UP ONE LINE" : goto EXIT
|
||
8: ERR.TST = "MOVE CURSOR DOWN ONE LINE" : goto EXIT
|
||
9: ERR.TST = "MOVE CURSOR RIGHT ONE COLUMN" : goto EXIT
|
||
10: ERR.TST = "MOVE CURSOR LEFT ONE COLUMN" : goto EXIT
|
||
11: ERR.TST = "ADD NEW LINE AND SCROLL SCREEN DOWN" : goto EXIT
|
||
12: ERR.TST = "PRINT STRING IN REVERSE VIDEO MODE" : goto EXIT
|
||
13: ERR.TST = "PRINT STRING IN BLINKING VIDEO MODE" : goto EXIT
|
||
EXIT: call cls
|
||
call prtctr("====> ABNORMAL TERMINATION <=====",10)
|
||
call setcur(12,10)
|
||
print using "TEST: [&] failed";ERR.TST
|
||
call setcur(23,0) : stop
|
||
fend
|
||
|
||
def PRT.ROW.NUM(I)
|
||
integer I
|
||
string L
|
||
L = str$(I)
|
||
call setcur(I,0) : print using "//: ";L;
|
||
fend
|
||
|
||
def BLK.FILL
|
||
integer BLK.FILL, I
|
||
string L
|
||
call cls : print TL;
|
||
for I = 1 to 23
|
||
call prt.row.num(I)
|
||
print PAD;
|
||
next I
|
||
fend
|
||
|
||
\ ************************************
|
||
\ * (1) TEST CLEAR SCREEN FUNCTION *
|
||
\ ************************************
|
||
|
||
call BLK.FILL : TMP1$ = " Test CLEAR SCREEN Function "
|
||
TMP2$ = " press any key "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call setcur(11,COL) : call prtblnk(TMP1$)
|
||
call setcur(13,COL) : call prtrev(TMP2$)
|
||
I = inkey
|
||
call cls
|
||
call prtctr(" Well, did it clear the screen? ",11)
|
||
call TST.OK(1)
|
||
|
||
\ ************************************
|
||
\ * (2) TEST HOME CURSOR FUNCTION *
|
||
\ ************************************
|
||
|
||
TMP1$ = " HOME CURSOR TEST "
|
||
call setcur(11,10) : print SP;
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call setcur(11,COL) : call prtrev(TMP1$)
|
||
call HOME
|
||
print " <=== Is the cursor at Row 0, Column 0 ?";
|
||
call HOME
|
||
call TST.OK(2)
|
||
|
||
\ ***********************************
|
||
\ * (3) TEST ERASE TO END OF LINE *
|
||
\ ***********************************
|
||
|
||
TMP1$ = " ERASE TO END OF LINE "
|
||
call BLK.FILL
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(10,4) : call eraeol
|
||
call setcur(11,4) : print \
|
||
"Is the above line erased except for column # ? ";
|
||
call TST.OK(3)
|
||
|
||
\ *************************************
|
||
\ * (4) TEST ERASE TO END OF SCREEN *
|
||
\ *************************************
|
||
|
||
TMP1$ = " ERASE NEXT LINE TO END OF SCREEN "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(10,5) : print \
|
||
" ===> hit any key to erase <=== ";
|
||
I = inkey : call eraeos
|
||
print "....OK ? "; : call TST.OK(4)
|
||
|
||
\ **********************************
|
||
\ * (5) TEST SET CURSOR POSITION *
|
||
\ **********************************
|
||
|
||
TMP1$ = " SET CURSOR POSITION "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(9,0) : call prtrev(TL)
|
||
call setcur(10,6) : print \
|
||
" This message should begin with a space at Row 10, Col 6 ";
|
||
call TST.OK(5)
|
||
|
||
\ ******************************************
|
||
\ * (6) TEST GET CURRENT CURSOR POSITION *
|
||
\ ******************************************
|
||
|
||
TMP1$ = " GET CURRENT CURSOR POSITION "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL : COLS% = COL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(11,0) : call prtrev(TL)
|
||
call setcur(12,15)
|
||
print " Hit any key to get current cursor position ";
|
||
I = inkey : RET = getpos
|
||
ROW = ret/256 : COL = ret-row*256
|
||
call cls
|
||
print TL;
|
||
for I = 1 to 23
|
||
call prt.row.num(I)
|
||
next I
|
||
call setcur(2,COLS%) : call prtrev(TMP1$)
|
||
call setcur(5,10) : print "ROW =";ROW
|
||
call setcur(7,10) : print "COLUMN =";COL
|
||
call setcur(9,10)
|
||
print "Is the above = ROW 12 COLUMN 60 ? ";
|
||
call TST.OK(6)
|
||
|
||
\ *********************************
|
||
\ * (7) TEST CURSOR UP FUNCTION *
|
||
\ *********************************
|
||
|
||
TMP1$ = " UP CURSOR COMMAND "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(5,10) : print \
|
||
" This test will print a space on Row 10, Column 10 ";
|
||
call setcur(6,10) : print \
|
||
" It will then issue the UP CURSOR command ";
|
||
I = inkey
|
||
call setcur(11,0) : call prtrev(TL)
|
||
call setcur(10,10) : print " "; : call UPCUR : print \
|
||
" This line should start with a space on Row 9, Column 11 ";
|
||
call TST.OK(7)
|
||
|
||
\ ***********************************
|
||
\ * (8) TEST CURSOR DOWN FUNCTION *
|
||
\ ***********************************
|
||
|
||
TMP1$ = " DOWN CURSOR COMMAND "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(5,10) : print \
|
||
" This test will print a space on Row 10, Column 10 ";
|
||
call setcur(6,10) : print \
|
||
" It will then issue the DOWN CURSOR command ";
|
||
I = inkey
|
||
call setcur(9,0) : call prtrev(TL)
|
||
call setcur(10,10) : print " "; : call DWNCUR : print \
|
||
" This line should start with a space on Row 11, Column 11 ";
|
||
call TST.OK(8)
|
||
|
||
\ *********************************************
|
||
\ * (9) TEST MOVING CURSOR RIGHT ONE COLUMN *
|
||
\ *********************************************
|
||
|
||
TMP1$ = " MOVE CURSOR RIGHT ONE COLUMN "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(5,10) : print \
|
||
" This test will print a space on Row 10, Column 10 ";
|
||
call setcur(6,10) : print \
|
||
" It will then issue the CURSOR RIGHT command ";
|
||
I = inkey
|
||
call setcur(9,0) : call prtrev(TL)
|
||
call setcur(10,10) : print " "; : call CUR.RT : print \
|
||
"This line will start on Row 10, Column 12 if OK ";
|
||
call TST.OK(9)
|
||
|
||
\ ********************************************
|
||
\ * (10) TEST MOVING CURSOR LEFT ONE COLUMN *
|
||
\ ********************************************
|
||
|
||
TMP1$ = " MOVE CURSOR LEFT ONE COLUMN "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(5,10) : print \
|
||
" This test will print a space on Row 10, Column 10 ";
|
||
call setcur(6,10) : print \
|
||
" It will then issue the CURSOR LEFT command ";
|
||
I = inkey : call setcur(9,0) : call prtrev(TL)
|
||
call setcur(10,10) : print " "; : call CUR.LT : print \
|
||
"This line will start on Row 10, Column 10 if OK ";
|
||
call TST.OK(10)
|
||
|
||
\ *************************************************
|
||
\ * (11) TEST ADDING ONE LINE AND SCROLLING DOWN *
|
||
\ *************************************************
|
||
|
||
TMP1$ = " ADD LINE "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call BLK.FILL
|
||
call setcur(2,COL) : call prtblnk(TMP1$)
|
||
call setcur(5,10) : print \
|
||
" This test will go to Row 10 and Insert a New Line ";
|
||
call setcur(6,10) : print \
|
||
" The 10th line and below will be scrolled down ";
|
||
I = inkey
|
||
call setcur(10,0) : call ADDLINE
|
||
call prtctr("Is this message on new line",getpos/256)
|
||
call TST.OK(11)
|
||
|
||
\ ****************************************************
|
||
\ * (12) TEST PRINTING STRING IN REVERSE VIDEO MODE *
|
||
\ ****************************************************
|
||
|
||
call BLK.FILL : call setcur(10,4) : call ADDLINE
|
||
TMP1$ = " IS THIS IN REVERSE VIDEO "
|
||
COL = int%((79-len(TMP1$))/2)
|
||
call setcur(10,COL) : call prtrev(TMP1$)
|
||
call TST.OK(12)
|
||
|
||
\ *****************************************************
|
||
\ * (13) TEST PRINTING STRING IN BLINKING VIDEO MODE *
|
||
\ *****************************************************
|
||
|
||
call BLK.FILL : call setcur(10,5) : call ADDLINE
|
||
call setcur(10,30) : call PRTBLNK("IS THIS BLINKING")
|
||
call TST.OK(13)
|
||
|
||
|
||
DS$ = " ***************************************"
|
||
MSG$ = "====> T E S T C O M P L E T E <===="
|
||
call cls
|
||
H$ = chr$(6)
|
||
HL$ = string$(78,H$)
|
||
call setcur(1,1) : call prtblnk(HL$)
|
||
for I = 2 to 21
|
||
call setcur(I,1) : call prtblnk(H$)
|
||
call setcur(I,78) : call prtblnk(H$)
|
||
next I
|
||
call setcur(22,1) : call prtblnk(HL$)
|
||
|
||
call setcur(2,2) : print left$(HL$,76);
|
||
for I = 3 to 20
|
||
call setcur(I,2) : print H$;
|
||
call setcur(I,77) : print H$;
|
||
next I
|
||
call setcur(21,2) : print left$(HL$,76);
|
||
|
||
call prtctr(DS$,9)
|
||
COL = int%((79-len(MSG$))/2)
|
||
call setcur(10,COL) : call prtrev(MSG$)
|
||
call prtctr(DS$,11)
|
||
call setcur(23,0)
|
||
stop
|
||
end
|
||
|