'===========================================================================
' Subject: VGA PALETTE EDITOR                 Date: 07-19-97 (16:17)       
'  Author: Andrew Below                       Code: QB, PDS                
'  Origin: bel@obninsk.ru                   Packet: EGAVGA.ABC
'===========================================================================
'   Hi!
'
'   Here is a simple palette creation and viewing program written
'in Microsoft QuickBASIC 4.5. It is very easy to use.  In the top
'of the screen there are three boxes. Each box is for setting one
'of main VGA palette colors - Red, Green and Blue. For increasing
'or decreasing any of these colors, just push "+" and "-" buttons
'under the color box.  In the little windows  in each boxes there
'are color values in decimal and hexadecimal format.
'   Under these boxes  there is color attribute number  scrolling
'bar.  You can  change  the attribute  number  for  current color
'by clicking on the "+" and "-" buttons on the scrolling bar. You
'can edit 255 (256 from 1) colors.
'   Under this bar there is one big box. Here you can see the mix
'color created by Red,  Green and Blue values.  In the two little
'windows within this box  there are actual color numbers  used in
'palette statement in decimal and hexadecimal format. This number
'can be calculated by following formula:
'
' red + (256 * green) + (65536 * blue)
'
'   And under this  big box there is little menu string.  "Save"
'item saves  current palette  to EDITPAL.PAL  file.  "Load" item
'loads palette from this file. "Reset" item resets ALL colors in
'current palette.  "Make PalShow program" item makes the PalShow
'QB program that  displays current  palette in  SCREEN 13  mode.
'"RND Generate" item  generates  palette  using  RND  statement.
'Click on "Quit" item to exit this program.
'   That's all, I think. Enjoy!!!
'
'NOTE: I reccomend compile this program before running.
'
'PS: If somebody can add to this program scrolling bars with the
'identificators, like in Windows,  please E-mail me your updated
'version of this program. I'll put you into the credits!
'
'PPS: When  you  increase  or decrease RGB  values  in top three
'boxes,  palette don't updates quickly  -  it updates only after
'you release mouse button. I do so, because I have problems with
'quick palette updates  -  I press the mouse  button,  wait  for
'needed color intensity, release button, BUT color scrolling DO
'NOT STOP. If you can solve this problem, please E-mail me.
'Thanx.
'
'PPPS: If you run this  program under DOS,  you'll must  be wait
'short time until the letters and numbers loads into arrays.  If
'somebody know,  how to  quick  load data from  DATA to  arrays,
'please E-mail me. I'll put you too into the credits! Thanx.
'
'Andrew Below, H.A.S.
'E-mail: bel@obninsk.ru
'
DECLARE SUB MakePalShow ()
DECLARE SUB Load ()
DECLARE SUB PalGenerate ()
DECLARE SUB Save ()
DECLARE SUB ClearOneColor (Flag!)
DECLARE SUB FillBoxes ()
DECLARE SUB UpdateColors (Flag!)
DECLARE SUB PrintValues (Flag!)
DECLARE SUB ClearAllPalette ()
DECLARE SUB Delay (Lenght&)
DECLARE SUB PutFocus (BoxNum!)
DECLARE SUB XPrint (PixX%, PixY%, Decimal$)
DECLARE SUB FillNumArrays ()
DECLARE SUB InitializeMouse ()
DECLARE SUB DrawMainScreen ()
DECLARE SUB WaitForOther (Button!)
DECLARE SUB ShowMouse ()
DECLARE SUB HideMouse ()
DECLARE SUB SetMousePos (x%, y%)
DECLARE SUB SetMouseSpeed (xSpd%, ySpd%)
DECLARE SUB GetMouseStatus (Button!, CurX!, CurY!)
DECLARE SUB SetMouseWindow (x1%, x2%, y1%, y2%)
DECLARE SUB Quit ()
DECLARE FUNCTION Trim$ (Txt$)
DECLARE FUNCTION IsMouse% ()
'$INCLUDE: 'qb.bi'
DIM SHARED Num0(1 TO 25) AS DOUBLE, Num1(1 TO 25) AS DOUBLE
DIM SHARED Num2(1 TO 25) AS DOUBLE, Num3(1 TO 25) AS DOUBLE
DIM SHARED Num4(1 TO 25) AS DOUBLE, Num5(1 TO 25) AS DOUBLE
DIM SHARED Num6(1 TO 25) AS DOUBLE, Num7(1 TO 25) AS DOUBLE
DIM SHARED Num8(1 TO 25) AS DOUBLE, Num9(1 TO 25) AS DOUBLE
DIM SHARED ChrA(1 TO 25) AS DOUBLE, ChrB(1 TO 25) AS DOUBLE
DIM SHARED ChrC(1 TO 25) AS DOUBLE, ChrD(1 TO 25) AS DOUBLE
DIM SHARED ChrE(1 TO 25) AS DOUBLE, ChrF(1 TO 25) AS DOUBLE
DIM SHARED RedVal(0 TO 255) AS INTEGER
DIM SHARED GreenVal(0 TO 255) AS INTEGER
DIM SHARED BlueVal(0 TO 255) AS INTEGER
DIM SHARED InRegs AS RegType, OutRegs AS RegType
DIM SHARED MouseOK AS SINGLE, ActiveBox AS SINGLE
DIM SHARED CurColor AS INTEGER
CONST TempFile = "PALEDIT.TMP"     'Please DO NOT MODIFY
CONST SaveLoadFile = "PALEDIT.PAL" 'Please DO NOT MODIFY
CONST LClr = 10, DClr = 2          'Light and Dark menu colors
CONST ABClr = 15, NBClr = 7        'Active and Non-active box colors
CONST MPClr = 15                   'Minus and Plus chars color
CONST RapidDelay = 4000            'Delay while rapid color change
CONST RClr = 3, GClr = 4, BClr = 5 'Attributes colors. DO NOT MODIFY
CONST MClr = 6                     'Bottom Main attribute
'***********************
'The Program Starts HERE
'***********************
SCREEN 0
CLS
PRINT "Loading chars into arrays..."
PRINT "If you can do it faster, please E-mail me."
FillNumArrays

SCREEN 12
Load

Start:
DrawMainScreen
FillBoxes
InitializeMouse
PutFocus 1
1 GetMouseStatus B, x, y
SELECT CASE y
 CASE 3 TO 189
  IF B <> 0 THEN
      SELECT CASE x
       CASE 3 TO 202
         IF B = 1 THEN
           WaitForOther B
           GOSUB FirstActive
          ELSEIF B = 2 THEN
           WaitForOther B
           ClearOneColor 1
           PrintValues 5
           UpdateColors 1
           UpdateColors 4
         END IF
       CASE 220 TO 420
         IF B = 1 THEN
           WaitForOther B
           GOSUB SecondActive
          ELSEIF B = 2 THEN
           WaitForOther B
           ClearOneColor 2
           PrintValues 5
           UpdateColors 2
           UpdateColors 4
         END IF
       CASE 438 TO 638
         IF B = 1 THEN
           WaitForOther B
           GOSUB ThirdActive
          ELSEIF B = 2 THEN
           WaitForOther B
           ClearOneColor 3
           PrintValues 5
           UpdateColors 3
           UpdateColors 4
         END IF
      END SELECT
  END IF
 CASE 272 TO 288
  IF B = 2 THEN
      SELECT CASE x
       CASE 65 TO 576
         ClearOneColor 4
         PrintValues 5
         UpdateColors 5
      END SELECT
  END IF
 CASE 289 TO 459
  IF B = 2 THEN
      SELECT CASE x
       CASE 3 TO 638
         ClearOneColor 4
         PrintValues 5
         UpdateColors 5
      END SELECT
  END IF
 CASE 192 TO 206
  IF B <> 0 THEN
      SELECT CASE x
       CASE 25 TO 44
         IF B = 1 THEN GOSUB DecRedRapid
         IF B = 2 THEN GOSUB DecRedSlow
       CASE 161 TO 180
         IF B = 1 THEN GOSUB IncRedRapid
         IF B = 2 THEN GOSUB IncRedSlow
       CASE 242 TO 261
         IF B = 1 THEN GOSUB DecGreenRapid
         IF B = 2 THEN GOSUB DecGreenSlow
       CASE 379 TO 398
         IF B = 1 THEN GOSUB IncGreenRapid
         IF B = 2 THEN GOSUB IncGreenSlow
       CASE 460 TO 479
         IF B = 1 THEN GOSUB DecBlueRapid
         IF B = 2 THEN GOSUB DecBlueSlow
       CASE 597 TO 617
         IF B = 1 THEN GOSUB IncBlueRapid
         IF B = 2 THEN GOSUB IncBlueSlow
      END SELECT
  END IF
 CASE 241 TO 255
  IF B <> 0 THEN
      SELECT CASE x
       CASE 169 TO 586
         IF B = 1 THEN WaitForOther B: GOSUB ClrBoxActive
       CASE 147 TO 166
         IF B = 1 THEN GOSUB DecColorRapid
         IF B = 2 THEN GOSUB DecColorSlow
       CASE 589 TO 608
         IF B = 1 THEN GOSUB IncColorRapid
         IF B = 2 THEN GOSUB IncColorSlow
      END SELECT
  END IF
 CASE 462 TO 478
  IF B = 1 THEN
      SELECT CASE x
       CASE 3 TO 46
         WaitForOther B
         CALL Save
       CASE 49 TO 94
         WaitForOther B
         CALL Load
       CASE 97 TO 150
         WaitForOther B
         ClearAllPalette
       CASE 153 TO 326
         WaitForOther B
         CALL MakePalShow
       CASE 329 TO 438
         WaitForOther B
         CALL PalGenerate
       CASE 441 TO 486
         WaitForOther B
         CALL Quit
      END SELECT
  END IF
END SELECT

SELECT CASE UCASE$(INKEY$)
 CASE "R": GOSUB FirstActive
 CASE "G": GOSUB SecondActive
 CASE "B": GOSUB ThirdActive
 CASE "C": GOSUB ClrBoxActive
 CASE "E": CALL ClearAllPalette
 CASE "Q": CALL Quit
 CASE "S": CALL Save
 CASE "L": CALL Load
 CASE "N": CALL PalGenerate
 CASE "M": CALL MakePalShow
 CASE CHR$(0) + "K"
   SELECT CASE ActiveBox
    CASE 1: GOSUB DecRedSlow
    CASE 2: GOSUB DecGreenSlow
    CASE 3: GOSUB DecBlueSlow
    CASE 4: GOSUB DecColorSlow
   END SELECT
 CASE CHR$(0) + "M"
   SELECT CASE ActiveBox
    CASE 1: GOSUB IncRedSlow
    CASE 2: GOSUB IncGreenSlow
    CASE 3: GOSUB IncBlueSlow
    CASE 4: GOSUB IncColorSlow
   END SELECT
END SELECT

GOTO 1


FirstActive:    'Choosed Red window
PutFocus 1
RETURN

SecondActive:   'Choosed Green window
PutFocus 2
RETURN

ThirdActive:    'Choosed Blue window
PutFocus 3
RETURN

ClrBoxActive:   'Choosed Color change window
PutFocus 4
RETURN

DecRedRapid:                                  'Quick decrease Red value
IF RedVal(CurColor) = 0 THEN RETURN
HideMouse
DO
 IF RedVal(CurColor) = 0 THEN EXIT DO
 GetMouseStatus B, x, y
 RedVal(CurColor) = RedVal(CurColor) - 1
 PrintValues 1
 GetMouseStatus B, x, y
 Delay RapidDelay
LOOP WHILE B <> 0
UpdateColors 1
UpdateColors 4
ShowMouse
RETURN

DecRedSlow:                                   'Slow decrease Red value
IF RedVal(CurColor) = 0 THEN RETURN
DO
 IF RedVal(CurColor) = 0 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
RedVal(CurColor) = RedVal(CurColor) - 1
HideMouse
PrintValues 1
UpdateColors 1
UpdateColors 4
ShowMouse
RETURN

IncRedRapid:                                  'Quick increase Red value
IF RedVal(CurColor) = 63 THEN RETURN
HideMouse
DO
 IF RedVal(CurColor) = 63 THEN EXIT DO
 GetMouseStatus B, x, y
 RedVal(CurColor) = RedVal(CurColor) + 1
 PrintValues 1
 Delay RapidDelay
LOOP WHILE B <> 0
UpdateColors 1
UpdateColors 4
ShowMouse
RETURN

IncRedSlow:                                   'Slow increase Red value
IF RedVal(CurColor) = 63 THEN RETURN
DO
 IF RedVal(CurColor) = 63 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
RedVal(CurColor) = RedVal(CurColor) + 1
HideMouse
PrintValues 1
UpdateColors 1
UpdateColors 4
ShowMouse
RETURN

DecGreenRapid:                                'Quick decrease Green value
IF GreenVal(CurColor) = 0 THEN RETURN
HideMouse
DO
 IF GreenVal(CurColor) = 0 THEN EXIT DO
 GetMouseStatus B, x, y
 GreenVal(CurColor) = GreenVal(CurColor) - 1
 PrintValues 2
 Delay RapidDelay
LOOP WHILE B <> 0
UpdateColors 2
UpdateColors 4
ShowMouse
RETURN

DecGreenSlow:                                 'Slow decrease Green value
IF GreenVal(CurColor) = 0 THEN RETURN
DO
 IF GreenVal(CurColor) = 0 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
GreenVal(CurColor) = GreenVal(CurColor) - 1
HideMouse
PrintValues 2
UpdateColors 2
UpdateColors 4
ShowMouse
RETURN

IncGreenRapid:                                'Quick increase Green value
IF GreenVal(CurColor) = 63 THEN RETURN
HideMouse
DO
 IF GreenVal(CurColor) = 63 THEN EXIT DO
 GetMouseStatus B, x, y
 GreenVal(CurColor) = GreenVal(CurColor) + 1
 PrintValues 2
 Delay RapidDelay
LOOP WHILE B <> 0
UpdateColors 2
UpdateColors 4
ShowMouse
RETURN

IncGreenSlow:                                 'Slow increase Green value
IF GreenVal(CurColor) = 63 THEN RETURN
DO
 IF GreenVal(CurColor) = 63 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
GreenVal(CurColor) = GreenVal(CurColor) + 1
HideMouse
PrintValues 2
UpdateColors 2
UpdateColors 4
ShowMouse
RETURN

DecBlueRapid:                                 'Quick decrease Blue value
IF BlueVal(CurColor) = 0 THEN RETURN
HideMouse
DO
 IF BlueVal(CurColor) = 0 THEN EXIT DO
 GetMouseStatus B, x, y
 BlueVal(CurColor) = BlueVal(CurColor) - 1
 PrintValues 3
 Delay RapidDelay
LOOP WHILE B <> 0
UpdateColors 3
UpdateColors 4
ShowMouse
RETURN

DecBlueSlow:                                  'Slow decrease Blue value
IF BlueVal(CurColor) = 0 THEN RETURN
DO
 IF BlueVal(CurColor) = 0 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
BlueVal(CurColor) = BlueVal(CurColor) - 1
HideMouse
PrintValues 3
UpdateColors 3
UpdateColors 4
ShowMouse
RETURN

IncBlueRapid:                                 'Quick increase Blue value
IF BlueVal(CurColor) = 63 THEN RETURN
HideMouse
DO
 IF BlueVal(CurColor) = 63 THEN EXIT DO
 GetMouseStatus B, x, y
 BlueVal(CurColor) = BlueVal(CurColor) + 1
 PrintValues 3
 Delay RapidDelay
LOOP WHILE B <> 0
UpdateColors 3
UpdateColors 4
ShowMouse
RETURN

IncBlueSlow:                                  'Slow increase Blue value
IF BlueVal(CurColor) = 63 THEN RETURN
DO
 IF BlueVal(CurColor) = 63 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
BlueVal(CurColor) = BlueVal(CurColor) + 1
HideMouse
PrintValues 3
UpdateColors 3
UpdateColors 4
ShowMouse
RETURN

DecColorRapid:                                'Quick decrease Color #
IF CurColor = 0 THEN RETURN
HideMouse
DO
 IF CurColor = 0 THEN EXIT DO
 GetMouseStatus B, x, y
 CurColor = CurColor - 1
 Clr$ = Trim$(STR$(CurColor))
  IF LEN(Clr$) < 3 THEN Clr$ = STRING$((3 - LEN(Clr$)), "0") + Clr$
 HxClr$ = Trim$(HEX$(CurColor))
  IF LEN(HxClr$) < 3 THEN HxClr$ = STRING$((3 - LEN(HxClr$)), "0") + HxClr$
 XPrint 118, 242, Clr$: XPrint 612, 242, HxClr$
 Delay RapidDelay
LOOP WHILE B <> 0
PrintValues 1
PrintValues 2
PrintValues 3
UpdateColors 5
ShowMouse
RETURN

DecColorSlow:                                 'Slow decrease Color #
IF CurColor = 0 THEN RETURN
DO
 IF CurColor = 0 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
CurColor = CurColor - 1
Clr$ = Trim$(STR$(CurColor))
IF LEN(Clr$) < 3 THEN Clr$ = STRING$((3 - LEN(Clr$)), "0") + Clr$
HxClr$ = Trim$(HEX$(CurColor))
IF LEN(HxClr$) < 3 THEN HxClr$ = STRING$((3 - LEN(HxClr$)), "0") + HxClr$
HideMouse
XPrint 118, 242, Clr$: XPrint 612, 242, HxClr$
PrintValues 1
PrintValues 2
PrintValues 3
UpdateColors 5
ShowMouse
RETURN

IncColorRapid:                                'Quick increase Color #
IF CurColor = 255 THEN RETURN
HideMouse
DO
 IF CurColor = 255 THEN EXIT DO
 GetMouseStatus B, x, y
 CurColor = CurColor + 1
 Clr$ = Trim$(STR$(CurColor))
  IF LEN(Clr$) < 3 THEN Clr$ = STRING$((3 - LEN(Clr$)), "0") + Clr$
 HxClr$ = Trim$(HEX$(CurColor))
  IF LEN(HxClr$) < 3 THEN HxClr$ = STRING$((3 - LEN(HxClr$)), "0") + HxClr$
 XPrint 118, 242, Clr$: XPrint 612, 242, HxClr$
 Delay RapidDelay
LOOP WHILE B <> 0
PrintValues 1
PrintValues 2
PrintValues 3
UpdateColors 5
ShowMouse
RETURN

IncColorSlow:                                 'Slow increase Color #
IF CurColor = 255 THEN RETURN
DO
 IF CurColor = 255 THEN EXIT DO
 GetMouseStatus B, x, y
LOOP WHILE B <> 0
CurColor = CurColor + 1
Clr$ = Trim$(STR$(CurColor))
IF LEN(Clr$) < 3 THEN Clr$ = STRING$((3 - LEN(Clr$)), "0") + Clr$
HxClr$ = Trim$(HEX$(CurColor))
IF LEN(HxClr$) < 3 THEN HxClr$ = STRING$((3 - LEN(HxClr$)), "0") + HxClr$
HideMouse
XPrint 118, 242, Clr$: XPrint 612, 242, HxClr$
PrintValues 1
PrintValues 2
PrintValues 3
UpdateColors 5
ShowMouse
RETURN

NotExist:
OPEN SaveLoadFile FOR OUTPUT AS #1
FOR i = 1 TO 768
 PRINT #1, CHR$(0);
NEXT i
CLOSE
ClearAllPalette
PrintValues 5
UpdateColors 5
GOTO Start

'Arrays data for chars. Each two strings is one char.
'They should be content from 107 bytes. Please DO NOT MODIFY.
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,3E,0,3E,0,3E,0,3E,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,67,0,67,0,67,0,67,0,6B,0,6B,0,6B,0,6B,0,73,0,73,0,73,0,73,0,63,0,63,0,63,0,63,0,63
DATA 0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,3E,0,3E,0,3E,0,3E,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,C,0,C,0,C,0,C,0,1C,0,1C,0,1C,0,1C,0,3C,0,3C,0,3C,0,3C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0,C,0
DATA C,0,C,0,C,0,3F,0,3F,0,3F,0,3F,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,3E,0,3E,0,3E,0,3E,0,63,0,63,0,63,0,63,0,3,0,3,0,3,0,3,0,6,0,6,0,6,0,6,0,C,0,C,0,C,0,C,0,18,0,18,0,18,0,18,0,30,0,30,0,30,0,30,0,60,0,60,0
DATA 60,0,60,0,63,0,63,0,63,0,63,0,7F,0,7F,0,7F,0,7F,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,3E,0,3E,0,3E,0,3E,0,63,0,63,0,63,0,63,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,1E,0,1E,0,1E,0,1E,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,63,0,63,0
DATA 63,0,63,0,3E,0,3E,0,3E,0,3E,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,6,0,6,0,6,0,6,0,E,0,E,0,E,0,E,0,1E,0,1E,0,1E,0,1E,0,36,0,36,0,36,0,36,0,66,0,66,0,66,0,66,0,7F,0,7F,0,7F,0,7F,0,6,0,6,0,6,0,6,0,6,0,6,0,6,0,6,0,6
DATA 0,6,0,6,0,6,0,F,0,F,0,F,0,F,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,7F,0,7F,0,7F,0,7F,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,7E,0,7E,0,7E,0,7E,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0
DATA 63,0,63,0,63,0,63,0,3E,0,3E,0,3E,0,3E,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,1C,0,1C,0,1C,0,1C,0,30,0,30,0,30,0,30,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,7E,0,7E,0,7E,0,7E,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63
DATA 0,63,0,63,0,63,0,63,0,63,0,63,0,3E,0,3E,0,3E,0,3E,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,7F,0,7F,0,7F,0,7F,0,63,0,63,0,63,0,63,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,6,0,6,0,6,0,6,0,C,0,C,0,C,0,C,0,18,0,18,0,18,0,18,0,18,0,18,0,18,0,18,0,18
DATA 0,18,0,18,0,18,0,18,0,18,0,18,0,18,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,3E,0,3E,0,3E,0,3E,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,3E,0,3E,0,3E,0,3E,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63
DATA 0,63,0,63,0,63,0,63,0,63,0,63,0,3E,0,3E,0,3E,0,3E,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,3E,0,3E,0,3E,0,3E,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,3F,0,3F,0,3F,0,3F,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3,0,3
DATA 0,6,0,6,0,6,0,6,0,3C,0,3C,0,3C,0,3C,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,8,0,8,0,8,0,8,0,1C,0,1C,0,1C,0,1C,0,36,0,36,0,36,0,36,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,7F,0,7F,0,7F,0,7F,0,63,0,63,0,63,0,63,0,63,0,63,0
DATA 63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,63,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,7E,0,7E,0,7E,0,7E,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,3E,0,3E,0,3E,0,3E,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33
DATA 0,33,0,33,0,33,0,33,0,33,0,33,0,7E,0,7E,0,7E,0,7E,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,1E,0,1E,0,1E,0,1E,0,33,0,33,0,33,0,33,0,61,0,61,0,61,0,61,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,60,0,61,0,61
DATA 0,61,0,61,0,33,0,33,0,33,0,33,0,1E,0,1E,0,1E,0,1E,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,7C,0,7C,0,7C,0,7C,0,36,0,36,0,36,0,36,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0,33,0
DATA 33,0,33,0,33,0,36,0,36,0,36,0,36,0,7C,0,7C,0,7C,0,7C,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,7F,0,7F,0,7F,0,7F,0,33,0,33,0,33,0,33,0,31,0,31,0,31,0,31,0,34,0,34,0,34,0,34,0,3C,0,3C,0,3C,0,3C,0,34,0,34,0,34,0,34,0,30,0,30,0,30,0,30,0,31,0
DATA 31,0,31,0,31,0,33,0,33,0,33,0,33,0,7F,0,7F,0,7F,0,7F,0,0,0,0,0,0,0,0,0
DATA FD,28,9B,0,0,64,0,9,0,C,0,0,0,0,0,0,0,0,0,7F,0,7F,0,7F,0,7F,0,33,0,33,0,33,0,33,0,31,0,31,0,31,0,31,0,34,0,34,0,34,0,34,0,3C,0,3C,0,3C,0,3C,0,34,0,34,0,34,0,34,0,30,0,30,0,30,0,30,0,30,0
DATA 30,0,30,0,30,0,30,0,30,0,30,0,30,0,78,0,78,0,78,0,78,0,0,0,0,0,0,0,0,0

SUB ClearAllPalette
SOUND 880, 1
SOUND 440, 1
SOUND 880, 1
FOR i = 0 TO 255
 RedVal(i) = 0
 BlueVal(i) = 0
 GreenVal(i) = 0
NEXT i
CurColor = 0
PrintValues 5
UpdateColors 5
END SUB

SUB ClearOneColor (Flag)
SELECT CASE Flag
 CASE 1: RedVal(CurColor) = 0
 CASE 2: GreenVal(CurColor) = 0
 CASE 3: BlueVal(CurColor) = 0
 CASE 4: RedVal(CurColor) = 0: GreenVal(CurColor) = 0: BlueVal(CurColor) = 0
END SELECT
END SUB

SUB Delay (Lenght&)
FOR t = 1 TO Lenght&
NEXT t
END SUB

SUB DrawMainScreen
'
'Draw three top boxes
LINE (1, 1)-(203, 207), NBClr, B
LINE (218, 1)-(421, 207), NBClr, B
LINE (436, 1)-(639, 207), NBClr, B
'
'Fill each of top boxes
LINE (1, 190)-(203, 207), NBClr, B          'First box
LINE (23, 190)-(23, 207), NBClr
LINE (181, 190)-(181, 207), NBClr
PAINT (25, 192), 8, NBClr
LINE (45, 190)-(45, 207), NBClr
LINE (159, 190)-(159, 207), NBClr
LINE (218, 190)-(421, 207), NBClr, B        'Second box
LINE (240, 190)-(240, 207), NBClr
LINE (399, 190)-(399, 207), NBClr
PAINT (242, 192), 8, NBClr
LINE (262, 190)-(262, 207), NBClr
LINE (377, 190)-(377, 207), NBClr
LINE (436, 190)-(639, 207), NBClr, B        'Third box
LINE (458, 190)-(458, 207), NBClr
LINE (617, 190)-(617, 207), NBClr
PAINT (460, 192), 8, NBClr
LINE (480, 190)-(480, 207), NBClr
LINE (595, 190)-(595, 207), NBClr
'
'Draw "-"...
LINE (30, 198)-(38, 199), MPClr, B
LINE (247, 198)-(255, 199), MPClr, B
LINE (465, 198)-(473, 199), MPClr, B
'And "+" chars
LINE (167, 198)-(174, 199), MPClr, B: LINE (170, 195)-(171, 202), MPClr, B
LINE (385, 198)-(392, 199), MPClr, B: LINE (388, 195)-(389, 202), MPClr, B
LINE (603, 198)-(610, 199), MPClr, B: LINE (606, 195)-(607, 202), MPClr, B

'
'Draw color change bar and fill it
LINE (115, 239)-(639, 256), NBClr, B
LINE (145, 240)-(145, 255), NBClr
LINE (609, 240)-(609, 255), NBClr
PAINT (147, 241), 8, NBClr
LINE (167, 240)-(167, 255), NBClr
LINE (587, 240)-(587, 255), NBClr
LINE (152, 247)-(160, 248), MPClr, B
LINE (595, 247)-(602, 248), MPClr, B
LINE (598, 244)-(599, 251), MPClr, B
'
'Draw one big bottom box and two windows in it
LINE (1, 270)-(639, 460), NBClr, B
LINE (1, 287)-(63, 270), NBClr, B
LINE (577, 287)-(639, 270), NBClr, B
'
'Print bottom menu
COLOR DClr: LOCATE 30, 1
PRINT " Save "; " Load "; " Reset "; " Make PalShow Program "; " RND Generate "; " Quit ";
COLOR 10: PRINT " -=PalEdit, v1.0=-";
COLOR 2
LOCATE 14, 12: PRINT "Red"
LOCATE 14, 38: PRINT "Green"
LOCATE 14, 66: PRINT "Blue"
LOCATE 16, 1: PRINT "Current color:"
COLOR LClr
LOCATE 14, 12: PRINT "R"
LOCATE 14, 38: PRINT "G"
LOCATE 14, 66: PRINT "B"
LOCATE 16, 1: PRINT "C"
LOCATE 30, 2: PRINT "S";
LOCATE 30, 8: PRINT "L";
LOCATE 30, 15: PRINT "e";
LOCATE 30, 21: PRINT "M";
LOCATE 30, 44: PRINT "N";
LOCATE 30, 57: PRINT "Q";
LINE (1, 479)-(640, 479), NBClr
'
'Draw menu separators
LINE (1, 460)-(1, 480), NBClr
LINE (47, 460)-(47, 480), NBClr
LINE (95, 460)-(95, 480), NBClr
LINE (151, 460)-(151, 480), NBClr
LINE (327, 460)-(327, 480), NBClr
LINE (439, 460)-(439, 480), NBClr
LINE (487, 460)-(487, 480), NBClr
LINE (639, 460)-(639, 480), NBClr

END SUB

'Fill top three boxes and one bottom
SUB FillBoxes
PAINT (4, 4), RClr, NBClr
PAINT (221, 4), GClr, NBClr
PAINT (439, 4), BClr, NBClr
PAINT (4, 300), MClr, NBClr
END SUB

'Fill arrays for chars 0-9 and A-F (used in XPrint)
SUB FillNumArrays
FOR n = 0 TO 15
 OPEN TempFile$ FOR OUTPUT AS #1
  FOR i = 1 TO 107
   READ Byte$
   Byte$ = CHR$(VAL("&H" + Byte$))
   PRINT #1, Byte$;
  NEXT i
 CLOSE
  SELECT CASE n
   CASE 0: DEF SEG = VARSEG(Num0(1)): BLOAD TempFile$, VARPTR(Num0(1))
   CASE 1: DEF SEG = VARSEG(Num1(1)): BLOAD TempFile$, VARPTR(Num1(1))
   CASE 2: DEF SEG = VARSEG(Num2(1)): BLOAD TempFile$, VARPTR(Num2(1))
   CASE 3: DEF SEG = VARSEG(Num3(1)): BLOAD TempFile$, VARPTR(Num3(1))
   CASE 4: DEF SEG = VARSEG(Num4(1)): BLOAD TempFile$, VARPTR(Num4(1))
   CASE 5: DEF SEG = VARSEG(Num5(1)): BLOAD TempFile$, VARPTR(Num5(1))
   CASE 6: DEF SEG = VARSEG(Num6(1)): BLOAD TempFile$, VARPTR(Num6(1))
   CASE 7: DEF SEG = VARSEG(Num7(1)): BLOAD TempFile$, VARPTR(Num7(1))
   CASE 8: DEF SEG = VARSEG(Num8(1)): BLOAD TempFile$, VARPTR(Num8(1))
   CASE 9: DEF SEG = VARSEG(Num9(1)): BLOAD TempFile$, VARPTR(Num9(1))
   CASE 10: DEF SEG = VARSEG(ChrA(1)): BLOAD TempFile$, VARPTR(ChrA(1))
   CASE 11: DEF SEG = VARSEG(ChrB(1)): BLOAD TempFile$, VARPTR(ChrB(1))
   CASE 12: DEF SEG = VARSEG(ChrC(1)): BLOAD TempFile$, VARPTR(ChrC(1))
   CASE 13: DEF SEG = VARSEG(ChrD(1)): BLOAD TempFile$, VARPTR(ChrD(1))
   CASE 14: DEF SEG = VARSEG(ChrE(1)): BLOAD TempFile$, VARPTR(ChrE(1))
   CASE 15: DEF SEG = VARSEG(ChrF(1)): BLOAD TempFile$, VARPTR(ChrF(1))
  END SELECT
  DEF SEG
 KILL TempFile$
NEXT n
END SUB

'Returns the mouse coordinates and pressed button number
'(1-Left, 2-Right, 3-Both)
SUB GetMouseStatus (Button, CurX, CurY)
IF MouseOK = 1 THEN
 InRegs.ax = 3
 CALL INTERRUPT(&H33, InRegs, OutRegs)
 Button = OutRegs.bx
 CurX = OutRegs.cx
 CurY = OutRegs.dx
 CurX = CurX + 1
 CurY = CurY + 1
END IF
END SUB

'Remove the mouse cursor from the screen
SUB HideMouse
IF MouseOK = 1 THEN
 InRegs.ax = 2
 CALL INTERRUPT(&H33, InRegs, OutRegs)
END IF
END SUB

'Initialize mouse functions
SUB InitializeMouse
MouseOK = IsMouse%                    'Get mouse driver flag
CALL SetMouseWindow(1, 640, 1, 480)   'Set mouse border as screen limits
CALL SetMouseSpeed(20, 20)            'Set mouse speed
CALL SetMousePos(320, 240)            'Set start mouse positions
CALL ShowMouse                        'Show mouse cursor
END SUB

'Check the mouse driver (1-Present, 0-Absent)
FUNCTION IsMouse%
InRegs.ax = 0
CALL INTERRUPT(&H33, InRegs, OutRegs)
IF OutRegs.ax = -1 THEN
 IsMouse% = 1
ELSE
 IsMouse% = 0
END IF
END FUNCTION

'Load palette from file, if one exist
SUB Load
FOR i = 500 TO 750 STEP 10: SOUND i, .1: NEXT i
FOR i = 650 TO 880 STEP 5: SOUND i, .1: NEXT i
ON ERROR GOTO NotExist
OPEN SaveLoadFile FOR INPUT AS #1: CLOSE
DIM RGB AS STRING * 3
OPEN SaveLoadFile FOR RANDOM AS #1 LEN = 3
FOR i = 0 TO 255
 GET #1, i + 1, RGB$
 RedVal(i) = ASC(MID$(RGB$, 1, 1))
 GreenVal(i) = ASC(MID$(RGB$, 2, 1))
 BlueVal(i) = ASC(MID$(RGB$, 3, 1))
NEXT i
CLOSE
PrintValues 5
UpdateColors 5
END SUB

'Create the PALSHOW.BAS program
SUB MakePalShow
DIM RGB AS STRING * 3
SOUND 600, 1: SOUND 440, 1
FOR i = 440 TO 880 STEP 10: SOUND i, .1: NEXT i
SOUND 440, 1
OPEN "PALSHOW.PAL" FOR RANDOM AS #1 LEN = 3
FOR i = 0 TO 255
 RGB = CHR$(RedVal(i)) + CHR$(GreenVal(i)) + CHR$(BlueVal(i))
 PUT #1, i + 1, RGB$
NEXT i
CLOSE
OPEN "PALSHOW.BAS" FOR OUTPUT AS #1
PRINT #1, "'Palette Show - Part of PalEdit, written by Andrew Below."
PRINT #1, "'This program load palette that has been saved in EditPalette"
PRINT #1, "'module, in array and shows it in SCREEN 13 mode."
PRINT #1, "'Created " + DATE$ + " at " + TIME$
PRINT #1, "'" + STRING$(40, "Ä")
PRINT #1, "DIM RGB AS STRING * 3, Clr(0 TO 255) AS LONG"
PRINT #1, "OPEN " + CHR$(34) + "PALSHOW.PAL" + CHR$(34) + " FOR RANDOM AS #1 LEN = 3"
PRINT #1, "FOR I = 0 TO 255"
PRINT #1, " GET #1, I + 1, RGB$"
PRINT #1, " Clr(I) = ASC(MID$(RGB$, 1, 1)) + ASC(MID$(RGB$, 2, 1)) * 256 + ASC(MID$(RGB$, 3, 1)) * 65536"
PRINT #1, "NEXT I"
PRINT #1, "SCREEN 13"
PRINT #1, "PALETTE USING Clr(0)"
PRINT #1, "FOR I = 0 TO 255"
PRINT #1, " COLOR I"
PRINT #1, " PRINT CHR$(219);"
PRINT #1, " LINE (I + 1, 100)-(I + 1, 320)"
PRINT #1, "NEXT I"
PRINT #1, "DO: LOOP WHILE INKEY$ = " + CHR$(34) + CHR$(34)
PRINT #1, "SCREEN 0"
PRINT #1, "COLOR 7, 0"
PRINT #1, "CLS"
PRINT #1, "WIDTH 80, 25"
PRINT #1, "SYSTEM"
CLOSE
OPEN "PALSHOW.BAT" FOR OUTPUT AS #1
PRINT #1, "@QB /RUN PALSHOW.BAS"
CLOSE
END SUB

'Generate RND Palette
SUB PalGenerate
FOR i = 1 TO 10
 RANDOMIZE TIMER
 Freq = INT(RND * 500) + 100
 SOUND Freq, .2
NEXT i
FOR i = 0 TO 255
 RANDOMIZE TIMER
 RedVal(i) = INT(RND * 63) + 1
 RANDOMIZE TIMER
 GreenVal(i) = INT(RND * 63) + 1
 RANDOMIZE TIMER
 BlueVal(i) = INT(RND * 63) + 1
NEXT i
PrintValues 5
UpdateColors 5
END SUB

SUB PrintValues (Flag)
SELECT CASE Flag
 CASE 1: GOSUB PrintRed
 CASE 2: GOSUB PrintGreen
 CASE 3: GOSUB PrintBlue
 CASE 4: GOSUB PrintColor
 CASE 5: GOSUB PrintRed: GOSUB PrintGreen: GOSUB PrintBlue: GOSUB PrintColor
END SELECT

Main$ = Trim$(STR$(RedVal(CurColor) + (GreenVal(CurColor) * 256) + (BlueVal(CurColor) * 65536)))
IF LEN(Main$) < 7 THEN Main$ = STRING$((7 - LEN(Main$)), "0") + Main$
HxMain$ = Trim$(HEX$(VAL(Main$)))
IF LEN(HxMain$) < 7 THEN HxMain$ = STRING$((7 - LEN(HxMain$)), "0") + HxMain$
XPrint 4, 273, Main$
XPrint 580, 273, HxMain$

EXIT SUB

PrintRed:
Red$ = Trim$(STR$(RedVal(CurColor)))
IF LEN(Red$) < 2 THEN Red$ = "0" + Red$
HxRed$ = Trim$(HEX$(RedVal(CurColor)))
IF LEN(HxRed$) < 2 THEN HxRed$ = "0" + HxRed$
XPrint 4, 193, Red$: XPrint 184, 193, HxRed$
RETURN

PrintGreen:
Green$ = Trim$(STR$(GreenVal(CurColor)))
IF LEN(Green$) < 2 THEN Green$ = "0" + Green$
HxGreen$ = Trim$(HEX$(GreenVal(CurColor)))
IF LEN(HxGreen$) < 2 THEN HxGreen$ = "0" + HxGreen$
XPrint 221, 193, Green$: XPrint 402, 193, HxGreen$
RETURN

PrintBlue:
Blue$ = Trim$(STR$(BlueVal(CurColor)))
IF LEN(Blue$) < 2 THEN Blue$ = "0" + Blue$
HxBlue$ = Trim$(HEX$(BlueVal(CurColor)))
IF LEN(HxBlue$) < 2 THEN HxBlue$ = "0" + HxBlue$
XPrint 439, 193, Blue$: XPrint 620, 193, HxBlue$
RETURN

PrintColor:
Clr$ = Trim$(STR$(CurColor))
IF LEN(Clr$) < 3 THEN Clr$ = STRING$((3 - LEN(Clr$)), "0") + Clr$
HxClr$ = Trim$(HEX$(CurColor))
IF LEN(HxClr$) < 3 THEN HxClr$ = STRING$((3 - LEN(HxClr$)), "0") + HxClr$
XPrint 118, 242, Clr$: XPrint 612, 242, HxClr$
RETURN

END SUB

SUB PutFocus (BoxNum)
IF BoxNum = ActiveBox THEN EXIT SUB       'Check for current active box
HideMouse
SOUND 140, .1
SELECT CASE ActiveBox                     'Hide previous active box
 CASE 1
   LINE (1, 1)-(203, 207), NBClr, B
   LINE (1, 190)-(203, 207), NBClr, B
   LINE (23, 190)-(23, 207), NBClr
   LINE (181, 190)-(181, 207), NBClr
   LINE (45, 190)-(45, 207), NBClr
   LINE (159, 190)-(159, 207), NBClr
 CASE 2
   LINE (218, 1)-(421, 207), NBClr, B
   LINE (218, 190)-(421, 207), NBClr, B
   LINE (240, 190)-(240, 207), NBClr
   LINE (399, 190)-(399, 207), NBClr
   LINE (262, 190)-(262, 207), NBClr
   LINE (377, 190)-(377, 207), NBClr
 CASE 3
   LINE (436, 1)-(639, 207), NBClr, B
   LINE (436, 190)-(639, 207), NBClr, B
   LINE (458, 190)-(458, 207), NBClr
   LINE (480, 190)-(480, 207), NBClr
   LINE (595, 190)-(595, 207), NBClr
 CASE 4
   LINE (115, 239)-(639, 256), NBClr, B
   LINE (145, 240)-(145, 255), NBClr
   LINE (609, 240)-(609, 255), NBClr
   LINE (617, 190)-(617, 207), NBClr
   LINE (167, 240)-(167, 255), NBClr
   LINE (587, 240)-(587, 255), NBClr
END SELECT
SELECT CASE BoxNum                        'Highlite new active box
 CASE 1
   LINE (1, 1)-(203, 207), ABClr, B
   LINE (1, 190)-(203, 207), ABClr, B
   LINE (23, 190)-(23, 207), ABClr
   LINE (181, 190)-(181, 207), ABClr
   LINE (45, 190)-(45, 207), ABClr
   LINE (159, 190)-(159, 207), ABClr
 CASE 2
   LINE (218, 1)-(421, 207), ABClr, B
   LINE (218, 190)-(421, 207), ABClr, B
   LINE (240, 190)-(240, 207), ABClr
   LINE (399, 190)-(399, 207), ABClr
   LINE (262, 190)-(262, 207), ABClr
   LINE (377, 190)-(377, 207), ABClr
 CASE 3
   LINE (436, 1)-(639, 207), ABClr, B
   LINE (436, 190)-(639, 207), ABClr, B
   LINE (458, 190)-(458, 207), ABClr
   LINE (617, 190)-(617, 207), ABClr
   LINE (480, 190)-(480, 207), ABClr
   LINE (595, 190)-(595, 207), ABClr
 CASE 4
   LINE (115, 239)-(639, 256), ABClr, B
   LINE (145, 240)-(145, 255), ABClr
   LINE (609, 240)-(609, 255), ABClr
   LINE (167, 240)-(167, 255), ABClr
   LINE (587, 240)-(587, 255), ABClr
END SELECT
ActiveBox = BoxNum
ShowMouse
END SUB

'Quit sequence
SUB Quit
FOR i = 440 TO 100 STEP -10: SOUND i, .1: NEXT i
SCREEN 0
COLOR 7, 0
CLS
PRINT "PalEdit, Version 1.0 by Andrew Below. Last updated July 19, 1997."
PRINT
PRINT "E-mail: bel@obninsk.ru, onxman@geocities.com"
PRINT "   WWW: http://www.geocities.com/SiliconValley/Vista/4318"
PRINT
PRINT "Please send all your suggestions and wishes"
PRINT "about this program to my E-mail address."
SYSTEM
END SUB

'Save palette to file
SUB Save
DIM RGB AS STRING * 3
FOR i = 880 TO 650 STEP -10: SOUND i, .1: NEXT i
FOR i = 750 TO 500 STEP -5: SOUND i, .1: NEXT i
OPEN SaveLoadFile FOR RANDOM AS #1 LEN = 3
FOR i = 0 TO 255
 RGB = CHR$(RedVal(i)) + CHR$(GreenVal(i)) + CHR$(BlueVal(i))
 PUT #1, i + 1, RGB$
NEXT i
CLOSE
END SUB

'Set the mouse coordinates
SUB SetMousePos (x%, y%)
IF MouseOK = 1 THEN
 x% = x% - 1
 y% = y% - 1
 InRegs.ax = 4
 InRegs.cx = x%
 InRegs.dx = y%
 CALL INTERRUPT(&H33, InRegs, OutRegs)
END IF
END SUB

'Set the mouse horizontal and vertical speed
SUB SetMouseSpeed (xSpd%, ySpd%)
IF MouseOK = 1 THEN
 InRegs.ax = 15
 InRegs.cx = xSpd%
 InRegs.dx = ySpd%
 CALL INTERRUPT(&H33, InRegs, OutRegs)
END IF
END SUB

'Set the mouse active window
SUB SetMouseWindow (x1%, x2%, y1%, y2%)
IF MouseOK = 1 THEN
 x1% = x1% - 1
 x2% = x2% - 1
 y1% = y1% - 1
 y2% = y2% - 1
 InRegs.ax = 7
 InRegs.dx = x1%
 InRegs.cx = x2%
 CALL INTERRUPT(&H33, InRegs, OutRegs)
 InRegs.ax = 8
 InRegs.dx = y1%
 InRegs.cx = y2%
 CALL INTERRUPT(&H33, InRegs, OutRegs)
END IF
END SUB

'Shows the mouse cursor on the screen
SUB ShowMouse
IF MouseOK = 1 THEN
 InRegs.ax = 1
 CALL INTERRUPT(&H33, InRegs, OutRegs)
END IF
END SUB

FUNCTION Trim$ (Txt$)
Trim$ = LTRIM$(RTRIM$(Txt$))
END FUNCTION

SUB UpdateColors (Flag)
SELECT CASE Flag
 CASE 1: GOSUB UpdateRed
 CASE 2: GOSUB UpdateGreen
 CASE 3: GOSUB UpdateBlue
 CASE 4: GOSUB UpdateMain
 CASE 5: GOSUB UpdateRed: GOSUB UpdateGreen: GOSUB UpdateBlue: GOSUB UpdateMain
END SELECT
EXIT SUB

UpdateRed:
RedClr = RedVal(CurColor)
PALETTE RClr, RedClr
RETURN

UpdateGreen:
GreenClr = GreenVal(CurColor) * 256
PALETTE GClr, GreenClr
RETURN

UpdateBlue:
BlueClr = BlueVal(CurColor) * 65536
PALETTE BClr, BlueClr
RETURN

UpdateMain:
MainClr = RedVal(CurColor) + (256 * GreenVal(CurColor)) + (65536 * BlueVal(CurColor))
PALETTE MClr, MainClr
RETURN

END SUB

'Wait until mouse button will different that in "Button" parameter
SUB WaitForOther (Button)
DO
 GetMouseStatus B, x, y
LOOP WHILE B = Button
END SUB

'Print string content 0-9/A-F chars at any place on the graphic screen
SUB XPrint (PixX%, PixY%, Decimal$)
Dec$ = LTRIM$(RTRIM$(Decimal$))
CurX = PixX%: CurY = PixY%
FOR i = 1 TO LEN(Dec$)
 Char$ = Trim$(MID$(Dec$, i, 1))
 SELECT CASE Char$
  CASE "0": PUT (CurX, CurY), Num0, PSET
  CASE "1": PUT (CurX, CurY), Num1, PSET
  CASE "2": PUT (CurX, CurY), Num2, PSET
  CASE "3": PUT (CurX, CurY), Num3, PSET
  CASE "4": PUT (CurX, CurY), Num4, PSET
  CASE "5": PUT (CurX, CurY), Num5, PSET
  CASE "6": PUT (CurX, CurY), Num6, PSET
  CASE "7": PUT (CurX, CurY), Num7, PSET
  CASE "8": PUT (CurX, CurY), Num8, PSET
  CASE "9": PUT (CurX, CurY), Num9, PSET
  CASE "A": PUT (CurX, CurY), ChrA, PSET
  CASE "B": PUT (CurX, CurY), ChrB, PSET
  CASE "C": PUT (CurX, CurY), ChrC, PSET
  CASE "D": PUT (CurX, CurY), ChrD, PSET
  CASE "E": PUT (CurX, CurY), ChrE, PSET
  CASE "F": PUT (CurX, CurY), ChrF, PSET
 END SELECT
 CurX = CurX + 8
NEXT i
END SUB