$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 DEFINT A-Z 'Required for all numeric functions, forces PB to not 'include floating point in UNIT (makes it smaller) '/*--------------------------------------------------------------------- DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER) DECLARE SUB TBOX(BYVAL ROW,BYVAL COL,BYVAL ROWS,BYVAL COLS,BYVAL ATTR,BYVAL OPT,BYVAL SHAD) DECLARE FUNCTION REATTR(ULR%,ULC%,LRR%,LRC%,ATTR%) AS STRING DECLARE SUB SAYG(ROW,COL,ATTR,OPT) '/*--------------------------------------------------------------------- $CODE SEG "MLIB1" '/*--------------------------------------------------------------------- ' BWINDOW Title$,ROW,COL,BROW,RCOL,ATTR,SHADOW,OPT ' Prints a box with a title. ' TITLE$ = Title centered on top line of box. Null "" no title ' ROW = Top row used ' COL = Top left column start ' BROW = Bottom row ' RCOL = Right column ' ATTR = Color of Box ' SHADOW = Place shadow on text under box ' 0 = no shadow ' 1 = shadow ' OPT = Type of box used. See TBOX for types. ' EXAMPLE: BWINDOW "E-Mail",10,10,20,70,31,1,2 ' '/*--------------------------------------------------------------------- SUB BWINDOW(Title$,Toprow%,Leftcolumn%,Bottomrow%,Rightcolumn%,Attr%,Shadow%,Border%) PUBLIC OPT$ = "TITLE'"+Title$+"'" IF Shadow% > 0 THEN OPT$ = OPT$ + " SHADOW " TWINDOW Toprow%,Leftcolumn%,Bottomrow%-Toprow%+1,Rightcolumn%-Leftcolumn%+1,Attr%,OPT$,Border% END SUB SUB TWINDOW(ROW,COL,NROW,NCOL,ATTR,OPT$,BTYPE) PUBLIC TATTR = ATTR IF BTYPE = 0 THEN BTYPE = 15 ' NROW = NROW + 2 ' NCOL = NCOL + 2 IF INSTR(1,OPT$,"TMIN") > 0 THEN NROW = 1 END IF '/*--- Title? ---*/ FTITLE = INSTR(1,UCASE$(OPT$),"TITLE") IF FTITLE > 0 THEN TITLE$ = MID$(OPT$,FTITLE+6,INSTR(FTITLE+6,OPT$,"'")-(FTITLE+6)) END IF OPT$ = UCASE$(OPT$) '/*--- Title Placement Instruction? ---*/ IF INSTR(1,OPT$,"TP") > 0 THEN TBOXF = VAL(MID$(OPT$,INSTR(1,OPT$,"TP")+2,1)) ELSE TBOXF = 0 '/*--- Shadow? ---* IF INSTR(1,OPT$,"SHADOW") > 0 THEN SHADOW = 1 ELSE SHADOW = 0 '/*--- Graphic? --*/ TBOXGF = 0 GOFFSET = 0 IF INSTR(1,OPT$,"G?") > 0 THEN TBOXGF = 1 IF INSTR(1,OPT$,"G#") > 0 THEN TBOXGF = 2 IF INSTR(1,OPT$,"G!") > 0 THEN TBOXGF = 3 IF TBOXGF > 0 THEN IF NROW < 6 THEN NROW = 6 GOFFSET = 8 '/* --- Graphic ATTR? ---*/ IF INSTR(1,OPT$,"GATTR") > 0 THEN GATTR = VAL(MID$(OPT$,INSTR(1,OPT$,"GATTR")+5,3)) ELSE GATTR = ATTR END IF '/*--- Title Color ---*/ IF INSTR(1,OPT$,"TATTR") > 0 THEN TATTR = VAL(MID$(OPT$,INSTR(1,OPT$,"TATTR")+5,3)) ELSE TATTR = ATTR '/*--- Title Present? ---*/ IF LEN(TITLE$) THEN '/* --- Title Handling Marker? ---*/ ' TBOXF = INSTR(1,"_^~%-=",LEFT$(Title$,1)) ' IF TBOXF > 0 THEN Title$ = MID$(Title$,2) ' Tlc = ASC(MID$("ÚÉÕÖ+*Û°±²ÛÜÍÄ ",BTYPE,1)) :'/*Left Upper Corner ' Trc = ASC(MID$("¿»¸·+*Û°±²ÛÜÍÄ ",BTYPE,1)) :'/*Right Upper Corner ' 123456789012345 TBS = ASC(MID$("ÄÍÍÄ-*ß°±²ÛÜÍÄ ",BTYPE,1)) :'/*HORIZONTAL LINE JBL = ASC(MID$("ÃÌÆÇ+*ß°±²ÛÜÍÄ ",BTYPE,1)) :'/*HORIZONTAL LINE JBR = ASC(MID$("´¹µ¶+*ß°±²ÛÜÍÄ ",BTYPE,1)) :'/*HORIZONTAL LINE LBS = ASC(MID$("´µµ´-*Û°±²Ýݵ´ ",BTYPE,1)) :'/*LEFT TITLE BAR RBS = ASC(MID$("ÃÆÆÃ-*Û°±²ÞÞÆà ",BTYPE,1)) :'/*RIGHT TITLE BAR '/* --- Add Psuedo Brackets ---*/ IF TBOXF = 3 THEN TITLE$ = CHR$(LBS)+TITLE$+CHR$(RBS) END IF IF LEN(TITLE$) => NCOL THEN NCOL = LEN(TITLE$) + 2 END IF '/*--- Multi-line Box? ---*/ IF NROW > 1 THEN IF TBOXF = 1 THEN NROW = NROW + 2 TBOX ROW,COL,NROW,NCOL,ATTR,BTYPE,SHADOW END IF '/*--- Display Graphic ---*/ IF TBOXGF > 0 THEN IF LEN(TITLE$) AND TBOXF = 1 THEN OSET = 2 ELSE OSET = 0 SAYG ROW+1+OSET,COL+1,GATTR,TBOXGF END IF '/*--- Title Present? ---*/ IF LEN(TITLE$) THEN '/* --- One Line Box ---*/ IF NROW = 1 THEN SAY ROW,COL,STRING$(NCOL," "),ATTR TBOXF = 6 END IF '/* --- Raw Box Title ---*/ IF TBOXF = 0 THEN SAY ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2),TITLE$,ATTR IF ATTR > 0 THEN T$ = REATTR(ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2),ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2)+LEN(TITLE$)-1,TATTR) END IF '/* --- Box Title IN Box ---*/ IF TBOXF = 1 THEN SAY ROW+1,(COL+(NCOL\2))-(LEN(TITLE$)\2),TITLE$,ATTR SAY ROW+2,COL,CHR$(Jbl)+STRING$(NCOL-2,Tbs)+CHR$(Jbr),ATTR IF TATTR > 0 THEN T$ = REATTR(ROW+1,COL+1,ROW+1,COL+NCOL-2,TATTR) END IF '/* --- Title Above Box ---*/ IF TBOXF = 2 THEN SAY ROW-1,(COL+(NCOL\2))-(LEN(TITLE$)\2),TITLE$,ATTR IF TATTR > 0 THEN T$ = REATTR(ROW-1,(COL+(NCOL\2))-(LEN(TITLE$)\2),ROW-1,(COL+(NCOL\2))-(LEN(TITLE$)\2)+LEN(TITLE$)-1,TATTR) END IF '/* --- Psuedo Box Title ---*/ IF TBOXF = 3 THEN SAY ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2),TITLE$,ATTR IF TATTR > 0 THEN T$ = REATTR(ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2)+1,ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2)+LEN(TITLE$)-2,TATTR) END IF '/* --- Title Above Box All ---*/ IF TBOXF = 4 THEN SAY ROW-1,(COL+(NCOL\2))-(LEN(TITLE$)\2),TITLE$,ATTR IF TATTR > 0 THEN T$ = REATTR(ROW-1,COL,ROW-1,COL+NCOL-1,TATTR) END IF '/* --- Title On Box All Transparent ---*/ IF TBOXF = 5 THEN SAY ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2),TITLE$,ATTR IF ATTR > 0 THEN T$ = REATTR(ROW,COL,ROW,COL+NCOL-1,TATTR) END IF '/* --- Title On Box All ---*/ IF TBOXF = 6 THEN SAY ROW,COL,STRING$(NCOL," "),TATTR SAY ROW,(COL+(NCOL\2))-(LEN(TITLE$)\2),TITLE$,TATTR END IF END IF END SUB '/*------------------------------------------------------------------ ' $INCLUDE "C:\CODE\MLIB\MLIB.INC" ' 123456789012345678901234567 ' XWINDOW 10,10,3,35,31," TP3 G? GATTR0 TATTR078 TITLE'title here of course'",1 ' DO WHILE NOT INSTAT:WEND