'=========================================================================== ' Subject: PC PAINT PROGRAM Date: Unknown Date (00:00) ' Author: Peter Norton Code: QB, PDS ' Keys: PC,PAINT,PROGRAM Packet: MOUSE.ABC '=========================================================================== TYPE RegType ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER END TYPE DIM InRegs AS RegType, OutRegs AS RegType DIM Storage(31266) AS INTEGER GOSUB Initialize DO GOSUB GetLeftButtonPress IF MenuSelectionMade% THEN GOSUB MenuChoice ELSE IF DrawFlag% THEN GOSUB DrawPixel IF LineFlag% THEN GOSUB DrawLine IF BoxFlag% THEN GOSUB DrawBox IF CircleFlag% THEN GOSUB DrawCircle IF PaintFlag% THEN GOSUB DrawPaint END IF LOOP WHILE 1 END Initialize: SCREEN 8 LOCATE 1, 1 Fore% = 1 Back% = 2 COLOR Fore%, Back% PRINT "Exit Color Bkgrnd Draw Line " + _ "Box Circle Paint Save Load"; InRegs.ax = 0 'Initialize mouse CALL INTERRUPT(&H33, InRegs, OutRegs) InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) DrawFlag% = 0 LineFlag% = 0 BoxFlag% = 0 CircleFlag% = 0 PaintFlag% = 0 RETURN GetLeftButtonPress: DO InRegs.bx = 0 'Wait for left button press InRegs.ax = 5 CALL INTERRUPT(&H33, InRegs, OutRegs) LOOP WHILE OutRegs.bx = 0 Row% = OutRegs.dx \ 8 + 1 IF Row% = 1 THEN MenuSelectionMade% = 1 ELSE MenuSelectionMade% = 0 END IF RETURN MenuChoice: DrawFlag% = 0 LineFlag% = 0 BoxFlag% = 0 CircleFlag% = 0 PaintFlag% = 0 Choice% = OutRegs.cx \ 64 + 1 SELECT CASE Choice% CASE 1 END CASE 2 Fore% = Fore% + 1 IF Fore% > 15 THEN Fore% = 0 COLOR Fore%, Back% InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) LOCATE 1, 9 PRINT "Color "; InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) CASE 3 Back% = Back% + 1 IF Back% > 7 THEN Back% = 0 COLOR Fore%, Back% CASE 4 DrawFlag% = 1 CASE 5 LineFlag% = 1 CASE 6 BoxFlag% = 1 CASE 7 CircleFlag% = 1 CASE 8 PaintFlag% = 1 CASE 9 InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) GET (0, 8)-(639, 199), Storage DEF SEG = VARSEG(Storage(1)) BSAVE "PAINT.DAT", VARPTR(Storage(1)), 62532 DEF SEG InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) CASE 10 InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) DEF SEG = VARSEG(Storage(1)) BLOAD "PAINT.DAT", VARPTR(Storage(1)) DEF SEG PUT (0, 8), Storage, PSET InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) END SELECT RETURN DrawPixel: InRegs.bx = 0 'Get left button releases to clear queue InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) DO InRegs.ax = 3 CALL INTERRUPT(&H33, InRegs, OutRegs) X% = OutRegs.cx Y% = OutRegs.dx InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) PSET (X%, Y%) InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) InRegs.bx = 0 'Left Button Releases InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) LOOP WHILE OutRegs.bx = 0 RETURN DrawLine: X% = OutRegs.cx Y% = OutRegs.dx XOld% = X% YOld% = Y% InRegs.bx = 0 'Get left button releases to clear queue InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) DO InRegs.ax = 3 CALL INTERRUPT(&H33, InRegs, OutRegs) YNew% = OutRegs.dx XNew% = OutRegs.cx InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) LINE (X%, Y%)-(XOld%, YOld%), Back% LINE (X%, Y%)-(XNew%, YNew%), Fore% XOld% = XNew% YOld% = YNew% InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) InRegs.bx = 0 'Left Button Releases InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) LOOP WHILE OutRegs.bx = 0 RETURN DrawBox: X% = OutRegs.cx Y% = OutRegs.dx XOld% = X% YOld% = Y% InRegs.bx = 0 'Get left button releases to clear queue InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) DO InRegs.ax = 3 CALL INTERRUPT(&H33, InRegs, OutRegs) YNew% = OutRegs.dx XNew% = OutRegs.cx InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) LINE (X%, Y%)-(XOld%, YOld%), Back%, B LINE (X%, Y%)-(XNew%, YNew%), Fore%, B XOld% = XNew% YOld% = YNew% InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) InRegs.bx = 0 'Left Button Releases InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) LOOP WHILE OutRegs.bx = 0 RETURN DrawCircle: X% = OutRegs.cx Y% = OutRegs.dx XOld% = X% YOld% = Y% InRegs.bx = 0 'Get left button releases to clear queue InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) DO InRegs.ax = 3 CALL INTERRUPT(&H33, InRegs, OutRegs) YNew% = OutRegs.dx XNew% = OutRegs.cx InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) CIRCLE (X%, Y%), SQR((X% - XOld%) ^ 2 + (Y% - YOld%) ^ 2),_ Back% CIRCLE (X%, Y%), SQR((X% - XNew%) ^ 2 + (Y% - YNew%) ^ 2) XOld% = XNew% YOld% = YNew% InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) InRegs.bx = 0 'Left Button Releases InRegs.ax = 6 CALL INTERRUPT(&H33, InRegs, OutRegs) LOOP WHILE OutRegs.bx = 0 RETURN DrawPaint: X% = OutRegs.cx Y% = OutRegs.dx InRegs.ax = 2 'Hide mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) PAINT (X%, Y%) InRegs.ax = 1 'Show mouse cursor CALL INTERRUPT(&H33, InRegs, OutRegs) RETURN