$CPU 8086 'make compatible with XT systems $LIB ALL OFF 'turn off all PowerBASIC libraries $ERROR ALL OFF 'turn off all PowerBASIC error checking $OPTIMIZE SIZE 'optimize for smaller code $COMPILE UNIT 'compile to a UNIT (.PBU) '$COMPILE EXE 'compile to a UNIT (.PBU) DEFINT A-Z 'Required for all numeric functions, forces PB to not 'include floating point in UNIT (makes it smaller) '/*--- Define Code Seqment Name -------------------------------------- $CODE SEG "MLIB11" '/*--- Declare Needed Functions/Subroutines -------------------------- DECLARE SUB BBOX(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Rows AS INTEGER, BYVAL Cols AS INTEGER, BYVAL Attr AS BYTE, BYVAL OPT AS INTEGER, BYVAL Shad AS INTEGER) DECLARE SUB Button(Text$,Press%,Row%,Col%,HotKey%,ButtonAttr%,Attr%) DECLARE FUNCTION GETSCREEN() AS STRING DECLARE SUB PUTSCREEN(BYVAL X AS STRING) DECLARE FUNCTION STRIP(BYVAL X AS STRING, BYVAL OPT AS STRING, BYVAL CHAR AS STRING) AS STRING DECLARE SUB SATTR(BYVAL XN AS INTEGER) DECLARE SUB MCLICKED(Rgt%,Lft%,Row%,Col%) DECLARE SUB MOUSEOFF() DECLARE SUB MOUSEON() DECLARE FUNCTION ISMOUSELBR() DECLARE SUB LGEDIT(EL AS STRING , BYVAL TPE AS STRING, BYVAL ROW AS INTEGER, BYVAL COL AS INTEGER, BYVAL ELTH AS INTEGER,BYVAL ATTR AS INTEGER, RKEY$,BYVAL WS AS INTEGER) DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER) '/*--- Start of Function --------------------------------------------- FUNCTION QBOX(QUESTIONTEXT$(),CA$,DMOUSE%,BUTTONATTR%,ATTR%,TXTCOLOR%,SHADOW%,BORDER%,ALLOW$) PUBLIC AS STRING IF ALLOW$ = "" THEN ALLOW$ = CHR$(27) '/* SATTR Attr% HotKey% = TxtColor% IF DMOUSE% THEN MOUSEOFF '/* --- Determine Question Type --- CA$ = STRIP(CA$,"B"," ") CA$ = UCASE$(CA$) IF CA$ = "Y" OR CA$ = "N" THEN QuestionType% = 1 IF CA$ = "T" OR CA$ = "F" THEN QuestionType% = 2 IF CA$ = "B" THEN QuestionType% = 3 IF CA$ = "C" THEN QuestionType% = 4 IF CA$ = "D" THEN QuestionType% = 5 IF CA$ = "E" THEN QuestionType% = 6 IF LEFT$(CA$,1) = "Z" THEN QuestionType% = 7 ELTH = VAL(MID$(CA$,2)) END IF MinWidth% = 40 '/* --- Determine Length of Question Lines --- i% = 0 j% = 0 Maxlength% = 0 DO INCR i% INCR j% :'/* first find out how many IF LEN (QuestionText$(i%)) = 0 THEN DECR i% ELSE IF LEN(QuestionText$(i%)) > Maxlength% THEN Maxlength% = LEN(QuestionText$(i%)) END IF LOOP WHILE i% = j% Count% = i% + 3 :'/*add three rows for the buttons INCR Maxlength% 'add a space IF Maxlength% < MinWidth% THEN Maxlength% = MinWidth% '/* --- Calculate Box Dimensions ---*/ LeftColumn% = 40 - ((Maxlength% + 2) / 2) RightColumn% = LeftColumn% + (Maxlength% + 2) TopRow% = (25 - Count%) \ 2 BottomRow% = TopRow% + (Count% + 1) IF QuestionType% = 7 THEN BottomRow% = BottomRow% + 2 '/* --- Save Screen ---*/ SCREENQ1$ = GETSCREEN '/* --- Draw Box ---/* BBOX TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,1,1 Row% = TopRow% + 1 Col% = LeftColumn% + 1 '/* --- Display Question Text ---*/ FOR a% = 1 TO Count% - 3 ' LOCATE Row%,Col%,0 ' PRINT SPACE$(1) + QuestionText$(a%) + SPACE$(Maxlength% - LEN(QuestionText$(a%))) SAY Row%,Col%,SPACE$(1) + QuestionText$(a%) + SPACE$(Maxlength% - LEN(QuestionText$(a%))),ATTR% INCR Row% NEXT a% ZROW% = Row% + 1 Col% = LeftColumn% + 3 Row% = BottomRow% - 2 '/* --- Essay Question ---*/ IF QuestionType% = 7 THEN ESSAY$ = STRING$(1000,32) '/* ELTH = 1000 RKEY$ = CHR$(27) NLINES$ = LTRIM$(STR$(BottomRow% - ZROW% +2)) LGEDIT ESSAY$,"NOREFRESH ENTERNL WIN"+NLINES$,ZROW%-2,LeftColumn%+3,ELTH,Attr%,"",Maxlength%-2 Ky$ = ESSAY$ GOTO QBOXEXIT END IF '/* --- Display Buttons ---*/ SELECT CASE QuestionType% 'only print the buttons we need CASE 1 'Yes/No Button " @YES ",0,Row%,Col%,HotKey%,ButtonAttr%,Attr% Button " @NO ",0,Row%,Col% + 9,HotKey%,ButtonAttr%,Attr% CASE 2 'True/False Button " @TRUE ",0,Row%,Col%,HotKey%,ButtonAttr%,Attr% Button " @FALSE ",0,Row%,Col% + 10,HotKey%,ButtonAttr%,Attr% CASE 3 'A/B/C/D Button " @A ",0,Row%,Col%,HotKey%,ButtonAttr%,Attr% Button " @B ",0,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% CASE 4 'A/B/C Button " @A ",0,Row%,Col%,HotKey%,ButtonAttr%,Attr% Button " @B ",0,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% Button " @C ",0,Row%,Col% + 14,HotKey%,ButtonAttr%,Attr% CASE 5 'A/B/C/D Button " @A ",0,Row%,Col%,HotKey%,ButtonAttr%,Attr% Button " @B ",0,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% Button " @C ",0,Row%,Col% + 14,HotKey%,ButtonAttr%,Attr% Button " @D ",0,Row%,Col% + 21,HotKey%,ButtonAttr%,Attr% CASE 6 'A/B/C/D/E Button " @A ",0,Row%,Col%,HotKey%,ButtonAttr%,Attr% Button " @B ",0,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% Button " @C ",0,Row%,Col% + 14,HotKey%,ButtonAttr%,Attr% Button " @D ",0,Row%,Col% + 21,HotKey%,ButtonAttr%,Attr% Button " @E ",0,Row%,Col% + 28,HotKey%,ButtonAttr%,Attr% END SELECT '/* --- Master Loop ---*/ DO '/* --- Loop Until Key Pressed ---*/ WHILE NOT INSTAT '/* --- Mouse Present? ---*/ IF DMOUSE% THEN MOUSEON MCLICKED Rgt%,Lft%,MRow%,MCol% IF ISMOUSELBR THEN SELECT CASE MRow% CASE Row% SELECT CASE QuestionType% CASE 1 'Yes/No SELECT CASE MCol% CASE Col% TO Col% + 4 Ky$ = "Y": GOTO KeyBoard CASE Col% + 9 TO Col% + 12 Ky$ = "N": GOTO KeyBoard END SELECT CASE 2 'True/False SELECT CASE MCol% CASE Col% TO Col% + 5 Ky$ = "T": GOTO KeyBoard CASE Col% + 10 TO Col% + 16 Ky$ = "F": GOTO KeyBoard END SELECT CASE 3 'A/B SELECT CASE MCol% CASE Col% TO Col% + 2 Ky$ = "A": GOTO KeyBoard CASE Col% + 7 TO Col% + 9 Ky$ = "B": GOTO KeyBoard END SELECT CASE 4 'A/B/C SELECT CASE MCol% CASE Col% TO Col% + 2 Ky$ = "A": GOTO KeyBoard CASE Col% + 7 TO Col% + 9 Ky$ = "B": GOTO KeyBoard CASE Col% + 14 TO Col% + 16 Ky$ = "C": GOTO KeyBoard END SELECT CASE 5 'A/B/C/D SELECT CASE MCol% CASE Col% TO Col% + 2 Ky$ = "A": GOTO KeyBoard CASE Col% + 7 TO Col% + 9 Ky$ = "B": GOTO KeyBoard CASE Col% + 14 TO Col% + 16 Ky$ = "C": GOTO KeyBoard CASE Col% + 21 TO Col% + 23 Ky$ = "D": GOTO KeyBoard END SELECT CASE 6 'A/B/C/D/E SELECT CASE MCol% CASE Col% TO Col% + 2 Ky$ = "A": GOTO KeyBoard CASE Col% + 7 TO Col% + 9 Ky$ = "B": GOTO KeyBoard CASE Col% + 14 TO Col% + 16 Ky$ = "C": GOTO KeyBoard CASE Col% + 21 TO Col% + 23 Ky$ = "D": GOTO KeyBoard CASE Col% + 28 TO Col% + 30 Ky$ = "E": GOTO KeyBoard END SELECT END SELECT END SELECT END IF END IF WEND '/* --- Get Keystroke ---*/ Ky$ = INKEY$ IF INSTR(1,ALLOW$,Ky$) > 0 THEN QBOXEXIT KeyBoard: '/* --- Show Button Press ---*/ IF DMOUSE% THEN MOUSEOFF QuestionAnswered% = 0 SELECT CASE QuestionType% CASE 1 'Yes/No SELECT CASE Ky$ CASE "N","n" Button " @NO ",1,Row%,Col% + 9,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "Y","y" Button " @YES ",1,Row%,Col%,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 END SELECT CASE 2 'True/False SELECT CASE Ky$ CASE "F","f" Button " @FALSE ",1,Row%,Col% + 10,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "T","t" Button " @TRUE ",1,Row%,Col%,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 END SELECT CASE 3 'A/B SELECT CASE Ky$ CASE "A","a" Button " @A ",1,Row%,Col%,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "B","b" Button " @B ",1,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 END SELECT CASE 4 'A/B/C SELECT CASE Ky$ CASE "A","a" Button " @A ",1,Row%,Col%,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "B","b" Button " @B ",1,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "C","c" Button " @C ",1,Row%,Col% + 14,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 END SELECT CASE 5 'A/B/C/D SELECT CASE Ky$ CASE "A","a" Button " @A ",1,Row%,Col%,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "B","b" Button " @B ",1,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "C","c" Button " @C ",1,Row%,Col% + 14,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "D","d" Button " @D ",1,Row%,Col% + 21,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 END SELECT CASE 6 'A/B/C/D/E SELECT CASE Ky$ CASE "A","a" Button " @A ",1,Row%,Col%,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "B","b" Button " @B ",1,Row%,Col% + 7,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "C","c" Button " @C ",1,Row%,Col% + 14,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "D","d" Button " @D ",1,Row%,Col% + 21,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 CASE "E","e" Button " @E ",1,Row%,Col% + 28,HotKey%,ButtonAttr%,Attr% QuestionAnswered% = 1 END SELECT END SELECT LOOP UNTIL QuestionAnswered% = 1 '/* IF UCASE$(Ky$) = UCASE$(CorrectAnswer$) THEN '/* Question% = 1 '/* ELSE '/* Question% = 0 '/* END IF '/*--- Wait for Button Press ------------------------------------------ DELAY .5 '/*--- Exit Function -------------------------------------------------- QBOXEXIT: PUTSCREEN SCREENQ1$ FUNCTION = UCASE$(Ky$) END FUNCTION '/*----------------------------------------------------------------- '$INCLUDE "C:\CODE\MLIB\MLIB.INC" 'DIM Q$(30,15) 'DIM TempMessage$(15) ' MSG$ = "C:\CODE\BBS\SURVEYS\144.SRV" '/* --- Get Survey Questions ---*/ ' SFB = FREEFILE ' OPEN"I",SFB,MSG$ ' QCNT = 0 ' QTCNT = 0 ' LINE INPUT#SFB, T$ :'/*Toss First Line ' DO WHILE NOT EOF(SFB) ' LINE INPUT#SFB,T$ ' /* --- Beginning of Question Text? ---*/ ' IF WORDINDEX(T$,1) = 1 THEN ''/* Q$(QCNT,0) = STR$(QTCNT) :'/*Set Number Last Questio Lines ' QCNT = QCNT + 1 :'/*Incr Question Counter ' Q$(0,0) = STR$(QCNT) ' QTCNT = 1 ' Q$(QCNT,QTCNT) = T$ :'/*Save 1st Line of Question ' END IF ''/* --- Further Question Text? ---*/ ' IF WORDINDEX(T$,1) > 2 THEN ' QTCNT = QTCNT + 1 :'/*Incr Line Counter ' Q$(QCNT,QTCNT) = T$ :'/*Save Question Line ' END IF ''/* --- End of Question? ---*/ ' IF WORDINDEX(T$,1) = 2 THEN ''/* Q$(QCNT,0) = T$ ' QTCNT = QTCNT + 1 :'/*Incr Line Counter ' Q$(QCNT,QTCNT) = T$ ' Q$(QCNT,0) = STR$(QTCNT) ' END IF ' LOOP ' CLOSE#SFB ''/* --- View it ---/* '' PRINT Q$(0,0) '' FOR QCNT = 1 TO VAL(Q$(0,0)) '' FOR QTCNT = 1 TO VAL(Q$(QCNT,0)) '' PRINT Q$(QCNT,QTCNT) '' NEXT QTCNT '' Y$ = GETKEY '' NEXT QCNT ''/*--- Display Question Boxes Until Done or ESC ----------------------- ' QCNT = 0 ' QNBR = VAL(Q$(0,0)) ' DO ' QCNT = QCNT + 1 ' FOR CNT = 1 TO 15 ' TempMessage$(CNT) = "" ' NEXT CNT ''/* --- Get Question --- ' QTCNT = VAL(Q$(QCNT,0)) ' FOR CNT = 1 TO QTCNT ' TempMessage$(CNT) = Q$(QCNT,CNT) ' CA$ = Q$(QCNT,CNT) ' NEXT CNT ' LQL = CNT - 1 ' TempMessage$(LQL) = " " ' TempMessage$(0) = STR$(CNT-1) ''/* --- Ask Question --- ' T$ = QBOX(TempMessage$(),CA$,0,31,48,12,1,1,"") ''/* PRINTAT 24,1,T$ ' LOOP UNTIL QCNT = QNBR OR T$ = CHR$(27)