'=========================================================================== ' Subject: VGA PAINTBRUSH W/MOUSE SUPPORT Date: 07-19-97 (14:43) ' Author: Michael G. Stewart Code: QB, QBasic, PDS ' Origin: mikegs@juno.com Packet: EGAVGA.ABC '=========================================================================== DECLARE FUNCTION LongToString$ (L&) DECLARE SUB painting () DECLARE SUB drawcurrent (types%, col%) DECLARE SUB drawscreen () DECLARE SUB center (row%, text$) DECLARE SUB button (x1%, y1%, x2%, y2%, UpDown%) DECLARE SUB intro () DEFINT A-Z DECLARE SUB getmouse (mode%) DECLARE SUB initmouse () DECLARE SUB mouse (OnOff%) DECLARE SUB readdata () DECLARE FUNCTION Interupt% (Num%, ax%, bx%, cx%, dx%) DIM SHARED xcoord%, ycoord%, click% DIM SHARED ml%(45) CONST lines = 1 CONST boxes = 2 CONST pix = 3 CONST circles = 4 readdata initmouse getmouse mode% drawscreen painting MS.Data: ' DATA 55,8b,ec,56,57 DATA 8b,76,0c,8b,04 DATA 8b,76,0a,8b,1c DATA 8b,76,08,8b,0c DATA 8b,76,06,8b,14 DATA cd,21 DATA 8b,76,0c,89,04 DATA 8b,76,0a,89,1c DATA 8b,76,08,89,0c DATA 8b,76,06,89,14 DATA 5f,5e,5d DATA ca,08,00 DATA # SUB button (x1, y1, x2, y2, UpDown) SELECT CASE UpDown CASE 1 'unpushed LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 8 LINE (x2 + 1, y2 + 1)-(x2 + 1, y1), 8 CASE 2 'pushed LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 8 LINE (x1, y1)-(x1, y2 + 1), 8 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 15 LINE (x2 + 1, y2 + 1)-(x2 + 1, y1), 15 CASE 3 '[] LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 0 LINE (x1 + 2, y1 + 2)-(x2 - 2, y2 - 2), 8, B LINE (x1 + 2, y1 + 2)-(x2 - 2, y1 + 1), 8, BF CASE 4 '_ LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 8 LINE (x2 + 1, y2 + 1)-(x2 + 1, y1), 8 LINE (x1 + 2, y2 - 2)-(x2 - 2, y2 - 1), 8, BF CASE 5 'X LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 8 LINE (x2 + 1, y2 + 1)-(x2 + 1, y1), 8 LINE (x1 + 4, y1 + 3)-(x1 + 7, y1 + 6), 8, BF LINE (x1 + 3, y1 + 2)-(x1 + 4, y1 + 3), 8, BF LINE (x1 + 2, y1 + 1)-(x1 + 3, y1 + 2), 8, BF LINE (x1 + 7, y1 + 2)-(x1 + 8, y1 + 3), 8, BF LINE (x1 + 8, y1 + 1)-(x1 + 9, y1 + 2), 8, BF LINE (x1 + 3, y1 + 6)-(x1 + 4, y1 + 7), 8, BF LINE (x1 + 2, y1 + 7)-(x1 + 2, y1 + 8), 8, BF LINE (x1 + 7, y1 + 6)-(x1 + 8, y1 + 7), 8, BF LINE (x1 + 8, y1 + 7)-(x1 + 9, y1 + 8), 8, BF CASE 6 '\/ a = (x2 - x1) / 2 B = (y2 - y1) / 2 LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 8 LINE (x2 + 1, y2 + 1)-(x2 + 1, y1), 8 LINE (x1 + a, y2 - 2)-(x1 + 2, y1 + 2), 8 LINE (x1 + a, y2 - 2)-(x2 - 2, y1 + 2), 8 LINE (x1 + 2, y1 + 2)-(x2 - 2, y1 + 2), 8 PAINT (x1 + 5, y1 + 5), 8, 8 CASE 50 'X disabled LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 8 LINE (x2 + 1, y2 + 1)-(x2 + 1, y1), 8 LINE (x1 + 4, y1 + 3)-(x1 + 7, y1 + 6), 15, BF LINE (x1 + 3, y1 + 2)-(x1 + 4, y1 + 3), 15, BF LINE (x1 + 2, y1 + 1)-(x1 + 3, y1 + 2), 15, BF LINE (x1 + 7, y1 + 2)-(x1 + 8, y1 + 3), 15, BF LINE (x1 + 8, y1 + 1)-(x1 + 9, y1 + 2), 15, BF LINE (x1 + 3, y1 + 6)-(x1 + 4, y1 + 7), 15, BF LINE (x1 + 2, y1 + 7)-(x1 + 2, y1 + 8), 15, BF LINE (x1 + 7, y1 + 6)-(x1 + 8, y1 + 7), 15, BF LINE (x1 + 8, y1 + 7)-(x1 + 9, y1 + 8), 15, BF CASE 30 '[] Disabled LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 0 LINE (x1 + 2, y1 + 2)-(x2 - 2, y2 - 2), 15, B LINE (x1 + 2, y1 + 2)-(x2 - 2, y1 + 1), 15, BF CASE 40 '_ Disabled LINE (x1, y1)-(x2, y2), 7, BF LINE (x1, y1)-(x2 - 1, y1), 15 LINE (x1, y1)-(x1, y2 + 1), 15 LINE (x1, y2 + 1)-(x2 + 1, y2 + 1), 8 LINE (x2 + 1, y2 + 1)-(x2 + 1, y1), 8 LINE (x1 + 2, y2 - 2)-(x2 - 2, y2 - 1), 15, BF END SELECT END SUB SUB center (row%, text$) LOCATE row%, 46 - LEN(text$) / 2 PRINT text$; END SUB SUB drawcurrent (types%, col%) LINE (5, 5)-(45, 45), 7, B LINE (5, 55)-(45, 95), 7, B LINE (55, 5)-(95, 95), 7, B LINE (55, 5)-(95, 45), 7, B IF types% = lines THEN LINE (5, 5)-(45, 45), 0, B IF types% = boxes THEN LINE (5, 55)-(45, 95), 0, B IF types% = pix THEN LINE (55, 55)-(95, 95), 0, B IF types% = circles THEN LINE (55, 5)-(95, 45), 0, B LINE (65, 107)-(102, 145), 7, BF LINE (65, 107)-(102, 145), 0, B PAINT (66, 108), col%, 0 END SUB SUB drawscreen SCREEN 12: CLS button 1, 1, 50, 50, 1 button 1, 52, 50, 100, 1 button 52, 1, 100, 50, 1 button 52, 52, 100, 100, 1 button 102, 1, 639, 100, 1 button 112, 11, 629, 90, 2 LINE (113, 12)-(628, 89), 0, BF col% = 0 FOR a% = 117 TO 639 STEP 35 button a%, 102, a% + 33, 150, 1 LINE (a% + 5, 107)-(a% + 28, 145), col%, BF LINE (a% + 5, 107)-(a% + 28, 145), 0, B col% = col% + 1 NEXT a% button 1, 152, 638, 478, 1 button 8, 158, 632, 472, 2 button 60, 102, 107, 150, 1 LINE (10, 160)-(630, 470), 15, BF LINE (10, 10)-(40, 40), 0 LINE (10, 62)-(40, 90), 0, BF LINE (75, 75)-(76, 76), 0, B CIRCLE (75, 25), 15, 0 COLOR 14 LOCATE 8: PRINT "Current" LOCATE 9: PRINT "Color >" center 2, "QPAINT by MIKE STEWART" center 4, "Click With Right Mouse Button To Clear" center 5, "Press Any Key To Exit" END SUB SUB getmouse (mode%) R% = Interupt%(&H33, 3, bx%, cx%, dx%) click% = bx% IF mode% THEN xcoord% = cx% / 16 + 1 ycoord% = dx% / 16 + 1 ELSE xcoord% = cx% ycoord% = dx% END IF END SUB SUB initmouse 'Calls mouse interrupts... R% = Interupt%(&H33, 0, bx%, cx%, dx%) END SUB FUNCTION Interupt% (Num%, ax%, bx%, cx%, dx%) IF ml%(0) = 0 THEN 'Error, no MS.Data statment... BEEP BEEP END END IF DEF SEG = VARSEG(ml%(0)) POKE VARPTR(ml%(0)) + 26, Num% CALL ABSOLUTE(ax%, bx%, cx%, dx%, VARPTR(ml%(0))) Interupt% = ax% END FUNCTION SUB mouse (OnOff%) IF OnOff% = 0 THEN OnOff% = 2 ELSE OnOff% = 1 R% = Interupt%(&H33, OnOff%, bx%, cx%, dx%) END SUB SUB painting mouse 1 types% = pix col% = 0 drawcurrent types%, col% DO WHILE INKEY$ = "" getmouse 0 IF click% = 2 THEN mouse 0: LINE (10, 160)-(630, 470), 15, BF: mouse 1 IF click% = 1 THEN IF xcoord% >= 1 AND xcoord% <= 50 THEN IF ycoord% < 50 THEN types% = lines IF ycoord% >= 50 AND ycoord% < 100 THEN types% = boxes drawcurrent types%, col% ELSEIF xcoord% >= 50 AND xcoord% <= 100 THEN IF ycoord% < 50 THEN types% = circles IF ycoord% >= 50 AND ycoord% < 100 THEN types% = pix drawcurrent types%, col% END IF IF ycoord% > 101 AND ycoord% < 151 THEN IF xcoord% > 117 AND xcoord% < 142 THEN col% = 0 IF xcoord% > 144 AND xcoord% < 179 THEN col% = 1 IF xcoord% > 181 AND xcoord% < 206 THEN col% = 2 IF xcoord% > 208 AND xcoord% < 243 THEN col% = 3 IF xcoord% > 245 AND xcoord% < 280 THEN col% = 4 IF xcoord% > 282 AND xcoord% < 307 THEN col% = 5 IF xcoord% > 309 AND xcoord% < 344 THEN col% = 6 IF xcoord% > 346 AND xcoord% < 382 THEN col% = 7 IF xcoord% > 384 AND xcoord% < 418 THEN col% = 8 IF xcoord% > 420 AND xcoord% < 455 THEN col% = 9 IF xcoord% > 457 AND xcoord% < 492 THEN col% = 10 IF xcoord% > 494 AND xcoord% < 529 THEN col% = 11 IF xcoord% > 531 AND xcoord% < 566 THEN col% = 12 IF xcoord% > 568 AND xcoord% < 602 THEN col% = 13 IF xcoord% > 604 AND xcoord% < 639 THEN col% = 14 drawcurrent types%, col% END IF IF xcoord% > 10 AND xcoord% < 630 AND ycoord% > 160 AND ycoord% < 470 THEN x1% = xcoord%: y1% = ycoord% IF types% = pix THEN PSET (x1% - 1, y1% - 1), col% IF types% <> pix THEN DO getmouse 0 IF click% <> 1 THEN EXIT DO LOOP END IF x2% = xcoord%: y2% = ycoord% IF types% = lines THEN LINE (x1%, y1%)-(x2%, y2%), col% IF types% = boxes THEN LINE (x1%, y1%)-(x2%, y2%), col%, BF IF types% = circles THEN x% = ABS(x2% - x1%) y% = ABS(y2% - y1%) CIRCLE (x1% + (x% / 2), y1% + (y% / 2)), x% / 2, col% END IF END IF END IF LOOP END SUB SUB readdata 'Reads machine language thingy MS.Data... RESTORE MS.Data DEF SEG = VARSEG(ml%(0)) FOR I% = 0 TO 99 READ Octet$ IF Octet$ = "#" THEN EXIT FOR POKE VARPTR(ml%(0)) + I%, VAL("&H" + Octet$) NEXT I% END SUB