Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / MSMOUSE1.ZIP / BAS.ZIP / PENCIL.BAS < prev next >

Wrap

BASIC Source File | 1988-12-19 | 18.9 KB | 671 lines

'****************************************************** '* PENCIL.BAS * '* * '* Translation to QuickBASIC 4.5 of the PENCIL.C * '* program. See the PENCIL.C listing for a more * '* detailed description. * '* * '* Original author: Greg Lee * '* Translated by: J. C. Craig * '* * '* Load QBMOUSE.QLB into memory with QuickBASIC... * '* QB /L QBMOUSE.QLB * '****************************************************** DEFINT A-Z DECLARE SUB MouseReset () DECLARE SUB MouseWindow (minX%, minY%, maxX%, maxY%) DECLARE SUB DrawScreen () DECLARE SUB DrawCursor (cursormask%) DECLARE SUB RightButton (press%, release%, now%) DECLARE SUB CallMenu () DECLARE SUB MouseCursor (switch%) DECLARE SUB PopUpMenu (menuselect%, attribute%) DECLARE SUB MousePosition (x%, y%) DECLARE SUB LeftButton (press%, release%, now%) DECLARE SUB Pencil () DECLARE SUB Eraser () DECLARE SUB Mouse (m1%, m2%, m3%, m4%) CONST PencilMenu = 0 ' pencil menu selected CONST EraserMenu = 1 ' eraser menu selected CONST Quit = 2 ' quit selected CONST InverseColor = 0 ' inverse color of menu CONST NormalColor = 1 ' normal color of menu CONST PencilCursor = 0 ' use pencil cursor CONST EraserCursor = 1 ' use eraser cursor CONST mMouseCursor = 2 ' use mouse cursor CONST hide = 0 ' hide mouse cursor CONST show = 1 ' show mouse cursor DIM cursor(32), saveScreen(5700) COMMON SHARED xmax, ymax, cursor(), saveScreen() COMMON SHARED white, black ' Which video mode given on command line? SELECT CASE COMMAND$ ' Hercules 720 x 348 ? CASE "H" DEF SEG = &H40 POKE &H49, 6 ' Sets HGC page 0 DEF SEG MouseReset SCREEN 3, , 0, 0 ' Switch to Hercules Graphics mode xmax = 720 ymax = 348 ' CGA 320 x 200 ? CASE "5" SCREEN 1 xmax = 320 ymax = 200 white = 3 MouseReset ' CGA 640 x 200 ? CASE "6" SCREEN 2 xmax = 640 ymax = 200 white = 1 MouseReset ' EGA 640 x 350 ? CASE "16" SCREEN 9 xmax = 640 ymax = 350 white = 15 MouseReset ' VGA 640 x 480 ? CASE "18" SCREEN 11 xmax = 640 ymax = 480 white = 1 MouseReset ' Video mode not recognized ? CASE ELSE PRINT PRINT " USAGE: pencil <video mode selection>" PRINT PRINT " Adapter Video mode selection" PRINT " ----------- --------------------" PRINT " CGA 320x200 5" PRINT " CGA 640x200 6" PRINT " EGA 640x350 16" PRINT " VGA 640x480 18" PRINT " Herc 720x348 h" PRINT " For example: pencil 6" SYSTEM END SELECT ' Draw first screen LINE (0, 0)-(xmax - 1, ymax - 1), , B LINE (2, 2)-(xmax - 3, ymax - 3), , B LINE (3, 3)-(xmax - 4, ymax - 4), black, BF ' Startup - draw borders and mouse, wait for right button release DO ' Draw mouse cursor DrawCursor mMouseCursor ' Watch for right button release DO RightButton press, release, now LOOP UNTIL release ' Do menu items CallMenu LOOP '----------------------------------------- ' Display menu and act on user selections '----------------------------------------- SUB CallMenu STATIC ' Set flag to cause update of menu items refresh = 1 ' Main loop, wait for and act on user selections DO ' Need to refresh the display of the menu items? IF refresh THEN refresh = 0 endCallMenu = 0 lastmenuselector = -1 ' Hide the mouse cursor MouseCursor hide ' Save copy of menu area of screen GET (1, 1)-(xmax - 1, ymax \ 10), saveScreen ' Draw menu borders LINE (0, 0)-(xmax \ 3, ymax \ 10), , B LINE ((xmax \ 3) + 1, 0)-((xmax \ 3) * 2, ymax \ 10), , B LINE ((xmax \ 3) * 2 + 1, 0)-(xmax - 1, ymax \ 10), , B ' Draw the three menu items PopUpMenu PencilMenu, NormalColor PopUpMenu EraserMenu, NormalColor PopUpMenu Quit, NormalColor END IF ' Get current mouse position MousePosition x, y ' Adjust horizontal value for virtual screen vs. physical IF xmax = 320 THEN menuselector = (x \ 2) \ (xmax \ 3) ELSE menuselector = x \ (xmax \ 3) END IF ' Update menu items if mouse has moved to new selection IF menuselector <> lastmenuselector THEN PopUpMenu lastmenuselector, NormalColor PopUpMenu menuselector, InverseColor lastmenuselector = menuselector END IF ' Get status of left mouse button LeftButton press, release, now ' Menu item selected if left button released IF release THEN ' Restore screen behind menu PUT (1, 1), saveScreen, PSET ' Which item was selected? SELECT CASE menuselector ' "Pencil" selected? CASE PencilMenu Pencil refresh = 1 ' "Eraser" selected? CASE EraserMenu Eraser refresh = 1 ' Must be "QUIT" was selected CASE ELSE CLS MouseReset SCREEN 0 WIDTH 80 END END SELECT END IF ' Get status of right mouse button RightButton press, release, now ' Exit the menu if the right button was released IF release THEN ' Restore the screen behind menu PUT (1, 1), saveScreen, PSET ' Signal to exit CallMenu processing loop endCallMenu = 1 END IF LOOP UNTIL endCallMenu END SUB '------------------------------------------ ' Sets one of three graphics mode cursors '------------------------------------------ SUB DrawCursor (cursormask) STATIC ' set screen mask (same for all three cursors) cursor(0) = &HFFFF cursor(1) = &HFFFF cursor(2) = &HFFFF cursor(3) = &HFFFF cursor(4) = &HFFFF cursor(5) = &HFFFF cursor(6) = &HFFFF cursor(7) = &HFFFF cursor(8) = &HFFFF cursor(9) = &HFFFF cursor(10) = &HFFFF cursor(11) = &HFFFF cursor(12) = &HFFFF cursor(13) = &HFFFF cursor(14) = &HFFFF cursor(15) = &HFFFF ' Set one of the three cursor masks SELECT CASE cursormask CASE PencilCursor cursor(16) = &H0 cursor(17) = &H0 cursor(18) = &H0 cursor(19) = &H20 cursor(20) = &H50 cursor(21) = &H88 cursor(22) = &H150 cursor(23) = &H220 cursor(24) = &H440 cursor(25) = &H880 cursor(26) = &H1100 cursor(27) = &H2200 cursor(28) = &H4400 cursor(29) = &H8800 cursor(30) = &HD000 cursor(31) = &HE000 CASE EraserCursor cursor(16) = &HFFC0 cursor(17) = &H8040 cursor(18) = &H8040 cursor(19) = &H8040 cursor(20) = &H8040 cursor(21) = &H8040 cursor(22) = &H8040 cursor(23) = &H8040 cursor(24) = &H8040 cursor(25) = &H8040 cursor(26) = &HFFC0 cursor(27) = &H0 cursor(28) = &H0 cursor(29) = &H0 cursor(30) = &H0 cursor(31) = &H0 CASE mMouseCursor ' Draw a two-button mouse cursor(16) = &H660 cursor(17) = &HE70 cursor(18) = &HE70 cursor(19) = &HE70 cursor(20) = &HE70 cursor(21) = &H0 cursor(22) = &HFF0 cursor(23) = &HFF0 cursor(24) = &HFF0 cursor(25) = &HFF0 cursor(26) = &HFF0 cursor(27) = &H7E0 cursor(28) = &H0 cursor(29) = &H0 cursor(30) = &H0 cursor(31) = &H0 CASE ELSE END SELECT ' Set Graphics Cursor Block m1 = 9 'Mouse Function 9 m2 = 0 'Hot spot X IF cursormask = PencilCursor THEN m3 = 16 'Hot spot Y ELSE m3 = 0 END IF m4 = VARPTR(cursor(0)) 'Address of cursor data Mouse m1, m2, m3, m4 ' Show the cursor MouseCursor show END SUB '-------------------------------------------------- ' Create rectangular eraser to delete pencil marks '-------------------------------------------------- SUB Eraser ' Limit eraser (mouse) motion to inside of screen border IF xmax = 320 THEN MouseWindow 6, 3, xmax * 2 - 26, ymax - 14 ELSE MouseWindow 3, 3, xmax - 13, ymax - 14 END IF ' Set cursor to the eraser DrawCursor EraserCursor ' Work with eraser until right button released DO ' Get status of left mouse button LeftButton press, release, now ' Is left button now pressed? IF now THEN ' Delete the old eraser image IF xold THEN LINE (x, y)-(x + 9, y + 10), black, BF END IF ' If button was just now pressed hide the cursor IF press THEN MouseCursor hide END IF ' Get the current mouse position MousePosition x, y ' Adjust horizontal X for virtual vs. physical screen IF xmax = 320 THEN x = x \ 2 END IF ' Draw outline of eraser LINE (x, y)-(x + 9, y + 10), white, B ' Erase the center part of the eraser rectangle LINE (x + 1, y + 1)-(x + 8, y + 9), black, BF ' Record current eraser position xold = x yold = y ' Left mouse button is not now pressed... ELSE ' Erase any old eraser image IF xold THEN LINE (x, y)-(x + 9, y + 10), black, BF END IF ' Show the mouse cursor MouseCursor show ' Get status of the right mouse button RightButton press, rightRelease, now ' If right button then reset mouse motion limits IF rightRelease THEN IF xmax = 320 THEN MouseWindow 0, 0, xmax * 2 - 2, ymax - 1 ELSE MouseWindow 0, 0, xmax - 1, ymax - 1 END IF END IF ' Clear out the eraser image location xold = 0 yold = 0 END IF LOOP UNTIL rightRelease END SUB '------------------------------------- ' Get status of the left mouse button '------------------------------------- SUB LeftButton (press, release, now) STATIC m1 = 5 'Get Button Press Information m2 = 0 'For the left button Mouse m1, m2, m3, m4 press = m2 'Presses returned in M2 m1 = 6 'Get Button Release Information m2 = 0 'For the left button Mouse m1, m2, m3, m4 release = m2 'Releases returned in M2 now = m1 AND 1 'Bit 0 = left button pressed END SUB '------------------------------- ' Show or hide the mouse cursor '------------------------------- SUB MouseCursor (switch) STATIC ' If switch is non-zero then show the cursor, else hide it IF switch THEN m1 = 1 ELSE m1 = 2 END IF Mouse m1, m2, m3, m4 END SUB '------------------------------------------------------------- ' Get the current mouse position (virtual screen coordinates) '------------------------------------------------------------- SUB MousePosition (x, y) STATIC m1 = 3 'Get Button Status and Mouse Position Mouse m1, m2, x, y END SUB '------------------------ ' Mouse Reset and Status '------------------------ SUB MouseReset STATIC m1 = 0 'Mouse Function 0 Mouse m1, m2, m3, m4 ' Was mouse found? IF m1 = 0 THEN PRINT "Mouse not found" SYSTEM END IF END SUB '---------------------------------------------------------- ' Set mouse motion limits using virtual screen coordinates '---------------------------------------------------------- SUB MouseWindow (minX, minY, maxX, maxY) STATIC 'Set Minimum and Maximum Horizontal Cursor Position m1 = 7 Mouse m1, m2, minX, maxX 'Set Minimum and Maximum Vertical Cursor Position m1 = 8 Mouse m1, m2, minY, maxY END SUB '---------------------------------------------------------------- ' Creates pencil mouse cursor, draws lines while left button is ' pressed, and returns to the menu when right button is released '---------------------------------------------------------------- SUB Pencil ' Limit mouse motion, adjusted for virtual screen IF xmax = 320 THEN MouseWindow 4, 2, xmax * 2 - 6, ymax - 3 ELSE MouseWindow 3, 3, xmax - 4, ymax - 4 END IF ' Set the Pencil cursor DrawCursor PencilCursor ' Processing loop, until right button is released DO ' Get status of left mouse button LeftButton press, release, now ' Is left mouse button now pressed? IF now THEN ' Get current mouse position MousePosition x, y ' Adjust for virtual vs. physical screen IF xmax = 320 THEN x = x \ 2 END IF ' Continue drawing line if started IF xold THEN LINE (xold, yold)-(x, y) ' If just starting a line then hide the pencil ELSE MouseCursor hide END IF ' Record current line endpoint xold = x yold = y ' Left mouse button is not now pressed ELSE ' Clear out line endpoint xold = 0 ' Show the pencil MouseCursor show ' Get status of right mouse button RightButton press, release, now ' If right button released reset mouse limits IF release THEN IF xmax = 320 THEN MouseWindow 0, 0, xmax * 2 - 2, ymax - 1 ELSE MouseWindow 0, 0, xmax - 1, ymax - 1 END IF END IF END IF LOOP UNTIL release END SUB '-------------------------------------------- ' Draw one of the three menu selection boxes '-------------------------------------------- SUB PopUpMenu (menuselect, attribute) STATIC ' One selection only will be highlighted IF attribute = InverseColor THEN fillcolor = white ELSE fillcolor = black END IF ' Which item is being drawn? SELECT CASE menuselect CASE PencilMenu ' Determine box corners x1 = 1 y1 = 1 x2 = xmax \ 3 - 1 y2 = ymax \ 10 - 1 ' Draw solid rectangle LINE (x1, y1)-(x2, y2), fillcolor, BF ' Locate label, adjusted for virtual vs. physical screen IF xmax = 320 THEN LOCATE 2, 5 ELSE LOCATE 2, 11 END IF ' Label the menu item PRINT "Pencil"; CASE EraserMenu ' Determine box corners x1 = xmax \ 3 + 1 y1 = 1 x2 = (xmax \ 3) * 2 - 1 y2 = ymax \ 10 - 1 ' Draw solid rectangle LINE (x1, y1)-(x2, y2), fillcolor, BF ' Locate label, adjusted for virtual vs. physical screen IF xmax = 320 THEN LOCATE 2, 18 ELSE LOCATE 2, 37 END IF ' Label the menu item PRINT "Eraser"; CASE ELSE ' Determine box corners x1 = (xmax \ 3) * 2 + 1 y1 = 1 x2 = xmax - 2 y2 = ymax \ 10 - 1 ' Draw solid rectangle LINE (x1, y1)-(x2, y2), fillcolor, BF ' Locate label, adjusted for virtual vs. physical screen IF xmax = 320 THEN LOCATE 2, 32 ELSE LOCATE 2, 65 END IF ' Label the menu item PRINT "QUIT"; END SELECT END SUB '-------------------------------------- ' Get status of the right mouse button '-------------------------------------- SUB RightButton (press, release, now) STATIC m1 = 5 'Get Button Press Information m2 = 1 'For the right button Mouse m1, m2, m3, m4 press = m2 'Presses returned in M2 m1 = 6 'Get Button Release Information m2 = 1 'For the right button Mouse m1, m2, m3, m4 release = m2 'Releases returned in M2 now = m1 AND 2 'Bit 1 = right button pressed END SUB