' Malprogramm 2

DECLARE SUB ZeichneFarbe (f%, ein%)
DECLARE SUB AktualisiereRGB (t%)

' Wegen Maus sowie Palette auslesen und Multitasking-Schonung n”tig
' $INCLUDE: 'qb.bi'

DIM SHARED aktFarbe%, rgb%(2)
DIM dosIntEin AS RegTypeX, dosIntAus AS RegTypeX

SCREEN 13
' Benutzeroberfl„che zeichnen

LINE (239, 0)-(239, 199), 15
LINE (240, 80)-(319, 80), 15
LOCATE 12, 32
PRINT "Farbe:";
FOR i% = 0 TO 2
	LOCATE 13 + 2 * i%, 32
	PRINT MID$("RGB", i% + 1, 1); ": 0";
NEXT i%

FOR i% = 0 TO 255
	ZeichneFarbe i%, 0
NEXT i%
ZeichneFarbe 1, -1

' Maus initialisieren
dosIntEin.ax = 0
CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
IF dosIntAus.ax <> &HFFFF THEN
	PRINT "Keine Maus installiert!"
	END
END IF

' Mauszeiger aktivieren
dosIntEin.ax = 1
CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
Drinbleib% = -1
Zugmodus% = 0
WHILE Drinbleib%
	' Knopf herunterdrcken
	dosIntEin.ax = 5
	dosIntEin.bx = 0
	CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
	IF dosIntAus.bx > 0 THEN
		x1% = dosIntAus.cx \ 2
		y1% = dosIntAus.dx
		' Bereiche abfragen
		IF x1% < 239 THEN
			' Malfl„che
			Zugmodus% = 1
		ELSE
			' RGB-Palette
			FOR i% = 0 TO 2
				IF x1% >= 256 AND x1% < 320 AND y1% >= 105 + 16 * i% AND y1% <= 109 + 16 * i% THEN
					Zugmodus% = 2 + i%
				END IF
			NEXT i%
		END IF
	END IF

	' Zugmodus (=Dinge, die w„hrend einer Mausbewegung aktualisiert werden
	' mssen)
	IF Zugmodus% > 0 THEN
		dosIntEin.ax = 3
		CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
		x% = dosIntAus.cx \ 2
		y% = dosIntAus.dx
		SELECT CASE Zugmodus%
		CASE 1
			IF x% > 238 THEN
				x% = 238
			END IF
		CASE 2 TO 4
			IF x% < 256 THEN
				x% = 256
			ELSEIF x% > 319 THEN
				x% = 319
			END IF
		CASE ELSE
			' Sollte nie vorkommen!
			ERROR 5
		END SELECT
		IF x% <> x1% OR y% <> y1% THEN
			' Mauszeiger ausblenden
			dosIntEin.ax = 2
			CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
			SELECT CASE Zugmodus%
			CASE 1
				' Zeichnen/Malen
				LINE (x1%, y1%)-(x%, y%), aktFarbe%
			CASE 2 TO 4
				rgb%(Zugmodus% - 2) = x% - 256
				AktualisiereRGB Zugmodus% - 2
			CASE ELSE
				' Sollte nie vorkommen!
				ERROR 5
			END SELECT
			' Mauszeiger wieder einblenden
			dosIntEin.ax = 1
			CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
			x1% = x%
			y1% = y%
		END IF
	END IF
	' Maustaste loslassen
	dosIntEin.ax = 6
	dosIntEin.bx = 0
	CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
	IF dosIntAus.bx > 0 THEN
		x% = dosIntAus.cx \ 2
		y% = dosIntAus.dx
		dosIntEin.ax = 2
		CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
		SELECT CASE Zugmodus%
		CASE 0
			' Keine Zugmodus-Funktion aktiviert
			IF x% >= 240 AND y% < 80 THEN
				' Farbe w„hlen
				ZeichneFarbe aktFarbe%, 0
				ZeichneFarbe 16 * (y% \ 5) + (x% - 240) \ 5, -1
			END IF
		CASE 1
			' Strich beenden
			LINE (x1%, y1%)-(x%, y%), aktFarbe%
		CASE 2 TO 4
			' RGB-Farbauswahl abschliessen
			IF x% < 256 THEN
				x% = 256
			ELSEIF x% > 319 THEN
				x% = 319
			END IF
			rgb%(Zugmodus% - 2) = x% - 256
			AktualisiereRGB Zugmodus% - 2
		CASE ELSE
			' Sollte nie vorkommen!
			ERROR 5
		END SELECT
		dosIntEin.ax = 1
		CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)
		Zugmodus% = 0
	END IF
	' Tastatur auswerten
	t$ = INKEY$
	SELECT CASE t$
	CASE CHR$(27)
		Drinbleib% = 0
	END SELECT
	' Multitasking-freundliches CPU-Zurckgeben: Damit wird der Zeitschlitz
	' zurckgegeben, so dass die CPU nicht bei 100% oben bleibt
	dosIntEin.ax = &H1680
	CALL INTERRUPTX(&H2F, dosIntEin, dosIntAus)
WEND

dosIntEin.ax = 2
CALL INTERRUPTX(&H33, dosIntEin, dosIntAus)

SUB AktualisiereRGB (t%)
	COLOR 15
	LOCATE 13 + 2 * t%, 34
	PRINT USING "##"; rgb%(t%);
	IF rgb%(t%) > 0 THEN
		LINE (256, 105 + 16 * t%)-(255 + rgb%(t%), 109 + 16 * t%), 14, BF
	END IF
	IF rgb%(t%) < 63 THEN
		LINE (256 + rgb%(t%), 105 + 16 * t%)-(318, 109 + 16 * t%), 1, BF
	END IF
	PALETTE aktFarbe%, CLNG(rgb%(0) + 256 * rgb%(1)) + 65536 * CLNG(rgb%(2))
END SUB

SUB ZeichneFarbe (f%, ein%)
	DIM dosIntEin AS RegTypeX, dosIntAus AS RegTypeX
	x% = 240 + 5 * (f% MOD 16)
	y% = 5 * (f% \ 16)
	LINE (x%, y%)-(x% + 4, y% + 4), f%, BF
	IF ein% THEN
		LINE (x%, y%)-(x% + 4, y% + 4), 15, B
		PSET (x%, y% + 2), 0
		PSET (x% + 4, y% + 2), 0
		PSET (x% + 2, y%), 0
		PSET (x% + 2, y% + 4), 0
		aktFarbe% = f%
		' RGB-Werte auslesen: Da QB keine PALETTE()-Funktion hat, mssen
		' wir direkt aufs VGA-BIOS zurckgreifen!
		dosIntEin.ax = &H1015
		dosIntEin.bx = f%
		CALL INTERRUPTX(&H10, dosIntEin, dosIntAus)
		rgb%(0) = dosIntAus.dx \ 256 AND 63
		rgb%(1) = dosIntAus.cx \ 256 AND 63
		rgb%(2) = dosIntAus.cx AND 63
		FOR i% = 0 TO 2
			AktualisiereRGB i%
		NEXT i%
		LINE (296, 83)-(319, 101), f%, BF
	END IF
END SUB