flood fill ? - Printable Version

Code: (Select All)

Option _Explicit



_Title "Shapes drawing demo - fill test by bplus, steve, petr, madscijr"



' KEYCODES FOR _BUTTON (EXCEPT WHERE STATED)

Const KeyCode_Escape = 2

Const KeyCode_F1 = 60

Const KeyCode_F2 = 61

Const KeyCode_F3 = 62

Const KeyCode_F4 = 63

Const KeyCode_F5 = 64

Const KeyCode_F6 = 65

Const KeyCode_F7 = 66

Const KeyCode_F8 = 67

Const KeyCode_F9 = 68

Const KeyCode_F10 = 17408 '_KEYDOWN CODE, NOT _BUTTON CODE

Const KeyCode_F11 = 88

Const KeyCode_F12 = 89

Const KeyCode_PrintScreen = -44 '_KEYHIT CODE, NOT _BUTTON CODE

Const KeyCode_ScrollLock = 71

Const KeyCode_PauseBreak = 31053 '_KEYHIT CODE, NOT _BUTTON CODE

Const KeyCode_Tilde = 42

Const KeyCode_1 = 3

Const KeyCode_2 = 4

Const KeyCode_3 = 5

Const KeyCode_4 = 6

Const KeyCode_5 = 7

Const KeyCode_6 = 8

Const KeyCode_7 = 9

Const KeyCode_8 = 10

Const KeyCode_9 = 11

Const KeyCode_0 = 12

Const KeyCode_Minus = 13

Const KeyCode_Equal = 14

Const KeyCode_BkSp = 15

Const KeyCode_Ins = 339

Const KeyCode_Home = 328

Const KeyCode_PgUp = 330

Const KeyCode_Del = 340

Const KeyCode_End = 336

Const KeyCode_PgDn = 338

Const KeyCode_NumLock = 326

Const KeyCode_KeypadSlash = 310

Const KeyCode_KeypadMultiply = 56

Const KeyCode_KeypadMinus = 75

Const KeyCode_Keypad7Home = 72

Const KeyCode_Keypad8Up = 73

Const KeyCode_Keypad9PgUp = 74

Const KeyCode_KeypadPlus = 79

Const KeyCode_Keypad4Left = 76

Const KeyCode_Keypad5 = 77

Const KeyCode_Keypad6Right = 78

Const KeyCode_Keypad1End = 80

Const KeyCode_Keypad2Down = 81

Const KeyCode_Keypad3PgDn = 82

Const KeyCode_KeypadEnter = 285

Const KeyCode_Keypad0Ins = 83

Const KeyCode_KeypadPeriodDel = 84

Const KeyCode_Tab = 16

Const KeyCode_Q = 17

Const KeyCode_W = 18

Const KeyCode_E = 19

Const KeyCode_R = 20

Const KeyCode_T = 21

Const KeyCode_Y = 22

Const KeyCode_U = 23

Const KeyCode_I = 24

Const KeyCode_O = 25

Const KeyCode_P = 26

Const KeyCode_BracketLeft = 27

Const KeyCode_BracketRight = 28

Const KeyCode_Backslash = 44

Const KeyCode_CapsLock = 59

Const KeyCode_A = 31

Const KeyCode_S = 32

Const KeyCode_D = 33

Const KeyCode_F = 34

Const KeyCode_G = 35

Const KeyCode_H = 36

Const KeyCode_J = 37

Const KeyCode_K = 38

Const KeyCode_L = 39

Const KeyCode_Semicolon = 40

Const KeyCode_Apostrophe = 41

Const KeyCode_Enter = 29

Const KeyCode_ShiftLeft = 43

Const KeyCode_Z = 45

Const KeyCode_X = 46

Const KeyCode_C = 47

Const KeyCode_V = 48

Const KeyCode_B = 49

Const KeyCode_N = 50

Const KeyCode_M = 51

Const KeyCode_Comma = 52

Const KeyCode_Period = 53

Const KeyCode_Slash = 54

Const KeyCode_ShiftRight = 55

Const KeyCode_Up = 329

Const KeyCode_Left = 332

Const KeyCode_Down = 337

Const KeyCode_Right = 334

Const KeyCode_CtrlLeft = 30

Const KeyCode_WinLeft = 348

Const KeyCode_AltLeft = -30764 ' _KEYHIT CODE NOT _BUTTON CODE

Const KeyCode_Spacebar = 58

Const KeyCode_AltRight = -30765 ' _KEYHIT CODE NOT _BUTTON CODE

Const KeyCode_WinRight = 349

Const KeyCode_Menu = 350

Const KeyCode_CtrlRight = 286



MainMenu

System



' /////////////////////////////////////////////////////////////////////////////



Sub MainMenu

    Dim in$

    Do

        Print "1. BPlus paint3"

        Print "2. Steve Fill"

        Print "3. Petr Paint2"

        Print "4. FillTest (Compare all 3 fills.)"

        Print "5. DrawTest (test of different shape + drawing routines)"

        Input "1-5 or Q to quit"; in$

        in$ = UCase$(Left$(_Trim$(in$), 1))

        Select Case in$

            Case "1": FillBPlus

            Case "2": FillSteve

            Case "3": FillPetr

            Case "4": FillTest

            Case "5": DrawTest

        End Select

        _KeyClear

        Screen 0

        If in$ = "Q" Then Exit Do

    Loop

End Sub ' MainMenu



' /////////////////////////////////////////////////////////////////////////////

' TEST FILL METHODS



Sub FillTest

    Dim x, y, r, nr As Integer ' circles

    Dim mb1, mb2, mb3 As Integer ' mouse buttons

    Dim mx, my As Long ' mouse

    Dim k&: k& = 0 ' key

    ReDim arrColor(0 To 0) As _Unsigned Long ' array of colors

    Dim index, oldIndex As Integer ' pointer to the current color

    Dim c~&



    ' INIT SCREEN

    _Title "FillTest"

    Screen _NewImage(1024, 768, 32): _Delay .25: _ScreenMove 0, 0



    ' GET COLORS

    AddTestColors arrColor(): index = LBound(arrColor) + 1: oldIndex = index



    ' TEST FILL

    Do

        ' DRAW CIRCLES

        Cls , _RGB32(0, 0, 0)

        r = 50: x = 50: y = 50

        Do

            Do

                Circle (x, y), r, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, 128 + Rnd * 128)

                x = x + (r * 2)



                If x + r > _Width Then Exit Do

            Loop



            nr = r + 50 ' new row circles bigger by 50px

            y = y + r + nr ' get next y pos

            r = nr ' save radius

            x = r ' start at left



            If y + r > _Height Then Exit Do

        Loop



        ' INSTRUCTIONS

        Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

        Locate 1, 1: Print "      CLICK TO FILL       ";

        Locate 2, 1: Print "--------------------------";

        Color _RGB32(0, 255, 255), _RGB32(0, 0, 0)

        Locate 3, 1: Print "  LEFT-CLICK: BPlus paint3 (press Esc to cancel)";

        Locate 4, 1: Print "MIDDLE-CLICK: Petr Paint2 ";

        Locate 5, 1: Print " RIGHT-CLICK: Steve Fill  ";

        Color _RGB32(255, 255, 0), _RGB32(0, 0, 0)

        Locate 7, 1: Print "--------------------------";

        Locate 8, 1: Print "0 - 9 = plot a point      ";

        Locate 9, 1: Print "Space = next fill color   ";

        Locate 10, 1: Print "Enter = redraw            ";

        Locate 11, 1: Print "Esc   = exit              ";

        Locate 12, 1: Print "--------------------------";



        ' TEST FILL

        Do Until k& = 13 Or k& = 27

            ' SHOW LOCATION + COLOR

            Color _RGB32(160, 160, 160), _RGB32(0, 0, 0)

            Locate 13, 1: Print "fill at        : " + _ToStr$(x) + "," + _ToStr$(y)

            Locate 14, 1: Print "fill color (" + Left$(_ToStr$(index) + "  ", 2) + "): "



            If index > LBound(arrColor) Then c~& = arrColor(index)







            Color c~&, c~&

            Locate 14, 18: Print "     ";

            Color _RGB32(160, 160, 160), _RGB32(0, 0, 0)

            Locate 14, 24: print "(" + _

                "r=" + right$("   " + _ToStr$(_RED32(c~&)), 3) + ", " + _

                "g=" + right$("   " + _ToStr$(_GREEN32(c~&)), 3) + ", " + _

                "b=" + right$("   " + _ToStr$(_BLUE32(c~&)), 3) + ", " + _

                "a=" + right$("   " + _ToStr$(_ALPHA32(c~&)), 3) + ")";



            k& = _KeyHit

            ' 0-9 = 48  49  50  51  52  53  54  55  56  57

            If k& = 32 Then

                ' Spacebar

                index = index + 1

                If index > UBound(arrColor) Then

                    index = LBound(arrColor)

                End If

            ElseIf k& = 49 Then

                'DrawCircle 0, mx, my, 1, 1,  c~&,  c~&

                Line (mx, my)-(mx, my), c~&

            ElseIf k& = 50 Then

                DrawCircle 0, mx, my, 1, 1, c~&, c~&

            ElseIf k& = 51 Then

                DrawCircle 0, mx, my, 2, 1, c~&, c~&

            ElseIf k& = 52 Then

                DrawCircle 0, mx, my, 4, 1, c~&, c~&

            ElseIf k& = 53 Then

                DrawCircle 0, mx, my, 8, 1, c~&, c~&

            ElseIf k& = 54 Then

                DrawCircle 0, mx, my, 16, 1, c~&, c~&

            ElseIf k& = 55 Then

                DrawCircle 0, mx, my, 32, 1, c~&, c~&

            ElseIf k& = 56 Then

                DrawCircle 0, mx, my, 64, 1, c~&, c~&

            ElseIf k& = 57 Then

                DrawCircle 0, mx, my, 128, 1, c~&, c~&

            ElseIf k& = 48 Then

                DrawCircle 0, mx, my, 256, 1, c~&, c~&

                'DrawCircle imgDraw&, iX, iY, iRadius, iThickness, fgColor, bgColor

            End If



            While _MouseInput

                index = index - _MouseWheel

                If index < LBound(arrColor) Then

                    index = UBound(arrColor)

                ElseIf index > UBound(arrColor) Then

                    index = LBound(arrColor)

                End If

            Wend



            ' Did color change?

            If index <> oldIndex Then

                ' get color from array or if index = lbound use random color

                If index = LBound(arrColor) Then

                    c~& = _RGBA32( _

                        RandomNumber%(0, 255), _

                        RandomNumber%(0, 255), _

                        RandomNumber%(0, 255), _

                        RandomNumber%(0, 255) )

                Else

                    c~& = arrColor(index)

                End If

                oldIndex = index

            End If



            mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2): mb3 = _MouseButton(3)



            ' BPlus

            If mb1 Then paint3 mx, my, c~&



            ' Steve

            If mb2 Then Fill mx, my, c~&



            ' Petr

            If mb3 Then Paint2 mx, my, c~&



            _Limit 200

        Loop



        If k& = 27 Then Exit Do

        k& = 0

    Loop



End Sub ' FillTest



' ################################################################################################################################################################

' # BEGIN BPlus's fill code

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////



' https://qb64phoenix.com/forum/showthread...4#pid33694

' From: bplus, Mini-Mod

' 4/23/2025 8:53 PM

' I have a different kind of paint, Paint3 that fills the color

' it lands on to do the painting, any other color stops the

' paint like a border



Sub FillBPlus

    _Title "PAINT3 test" 'b+ 2020-06-26

    Screen _NewImage(800, 600, 32)

    _Delay .25

    _ScreenMove 0, 0



    Dim i, mb, mx, my

    For i = 1 To 50

        Line (Rnd * 800, Rnd * 600)-(Rnd * 800, Rnd * 600), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, 128 + Rnd * 128)

        Circle (Rnd * 800, Rnd * 600), Rnd * 50 + 10, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, 128 + Rnd * 128)

    Next



    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Click an area of the screen to fill";

    Locate 2, 1: Print "Press Esc to exit";



    Do

        While _MouseInput: Wend

        mx = _MouseX: my = _MouseY: mb = _MouseButton(1)

        If mb Then paint3 mx, my, &HFFFFFFFF

        _Limit 200

    Loop Until _KeyDown(27)

End Sub ' FillBPlus



' /////////////////////////////////////////////////////////////////////////////

' madscijr added check for Esc key to cancel



Sub paint3 (x0, y0, MyFill As _Unsigned Long) ' needs GetMax, GetMin functions

    Dim fillColor As _Unsigned Long, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y



    fillColor = Point(x0, y0)

    'PRINT fillColor

    W = _Width - 1: H = _Height - 1



    Dim temp(W, H)

    temp(x0, y0) = 1: parentF = 1

    PSet (x0, y0), MyFill



    Dim k&: k& = 0 ' madscijr



    While parentF = 1

        parentF = 0: tick = tick + 1

        ystart = GetMax(y0 - tick, 0): ystop = GetMin(y0 + tick, H)

        y = ystart

        While y <= ystop

            xstart = GetMax(x0 - tick, 0): xstop = GetMin(x0 + tick, W)

            x = xstart

            While x <= xstop

                If Point(x, y) = fillColor And temp(x, y) = 0 Then

                    If temp(GetMax(0, x - 1), y) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(GetMin(x + 1, W), y) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(x, GetMax(y - 1, 0)) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(x, GetMin(y + 1, H)) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    End If

                End If

                x = x + 1



                k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

            Wend

            If k& = 27 Then Exit While ' madscijr



            y = y + 1



            k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

        Wend

        If k& = 27 Then Exit While ' madscijr



        k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

    Wend

End Sub ' paint3



' /////////////////////////////////////////////////////////////////////////////



Function GetMin (n1, n2)

    If n1 > n2 Then GetMin = n2 Else GetMin = n1

End Function



' /////////////////////////////////////////////////////////////////////////////



Function GetMax (n1, n2)

    If n1 < n2 Then GetMax = n2 Else GetMax = n1

End Function



' ################################################################################################################################################################

' # END BPlus's fill code

' ################################################################################################################################################################



' ################################################################################################################################################################

' # BEGIN Steve's fill code

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////



' https://qb64phoenix.com/forum/showthread...6#pid33696



' SMcNeill, Super Moderator

' 4/23/2025 8:55 PM

' How about something as simple as this quick demo that I wrote:

' Notice that it only fills transparent (_RGBA(0,0,0,0)) pixels

' and colors them the fill color.



' SMcNeill, Super Moderator

' 4/23/2025 9:56 PM

' For all 0 alpha colors (as I just went back and noticed in your original post),

' simply check for POINT(i, y+1) < &H01000000~&

' That'll cover all the 0 alpha color ranges.  Wink



Sub FillSteve

    $Color:32

    Screen _NewImage(1280, 720, 32)

    _ScreenMove 0, 0



    Circle (640, 360), 350, Red

    Circle (800, 500), 100, Blue

    Paint (800, 500), Blue, Blue



    Locate 1, 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Print "Press any key to fill"

    Sleep ' so we can see that the blue circle is inside the red one.



    Fill 640, 360, Red 'fill all transparent pixels red



    Locate 1, 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Print "Press any key to exit"

    Sleep

End Sub ' FillSteve



' /////////////////////////////////////////////////////////////////////////////



Sub Fill (x, y, Kolor As _Unsigned Long)

    Dim As _Unsigned Long OC, BC

    OC = Point(x, y) 'original color

    If _Alpha32(Kolor) <> 255 Or _Alpha32(OC) <> 255 Then 'we're going to blend

        PSet (x, y), Kolor

        BC = Point(x, y) 'blended color

    End If

    Filler x, y, Kolor, OC, BC

End Sub



Sub Filler (x, y, Kolor As _Unsigned Long, OC As _Unsigned Long, BC As _Unsigned Long)

    Dim l, r, i



    If Kolor = OC Or Kolor = BC Then Exit Sub

    l = x: r = x 'find left/right to fill

    Do Until l = 0

        If Point(l - 1, y) = BC Then Exit Do

        If Point(l - 1, y) = OC Then l = l - 1 Else Exit Do

    Loop 'find the left boundry

    Do Until r = _Width - 1

        If Point(r + 1, y) = BC Then Exit Do

        If Point(r + 1, y) = OC Then r = r + 1 Else Exit Do

    Loop 'find the right boundry

    Line (l, y)-(r, y), Kolor, BF

    For i = l To r

        If Point(i, y + 1) = BC Then _Continue

        If Point(i, y + 1) = OC Then Filler i, y + 1, Kolor, OC, BC

    Next

    For i = l To r

        If Point(i, y - 1) = BC Then _Continue

        If Point(i, y - 1) = OC Or Point(l - 1, y) = BC Then Filler i, y - 1, Kolor, OC, BC

    Next

End Sub ' Fill



' ################################################################################################################################################################

' # END Steve's fill code

' ################################################################################################################################################################



' ################################################################################################################################################################

' # BEGIN Petr's fill code

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' reply #8

' https://qb64phoenix.com/forum/showthread...3#pid33703



' Petr, Mini-Mod

' 4/24/2025 9:42 AM

'

' https://qb64phoenix.com/forum/showthread.php?tid=1507

' TESTED ALSO WITH ALPHA:



Sub FillPetr

    Dim c

    Dim X

    Dim Y

    Dim Lwidth

    Dim Lheight

    Dim K&



    Screen _NewImage(1024, 768, 32)

    $Color:32

    _ScreenMove 0, 0



    Do

        Cls , Red

        For c = 1 To 40

            Circle (Rnd * 980, Rnd * 740), Rnd * 100 + 10, _RGBA32(25 * Rnd, 75 * Rnd, 127 * Rnd, 100 + 155 * Rnd)

            X = Rnd * 1024

            Y = Rnd * 768

            Lwidth = Rnd * 100

            Lheight = Rnd * 100

            Line (X, Y)-(X + Lwidth, Y + Lheight), _RGBA32(55 * Rnd, 145 * Rnd, 255 * Rnd, Rnd * 255), BF

        Next c



        Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

        Locate 1, 1: Print "Click an area of the screen to fill";

        Locate 2, 1: Print "Press Enter to redraw screen";

        Locate 3, 1: Print "Press Esc to exit";



        _Delay .1

        _MouseMove 512, 384





        Do Until K& = 13 Or K& = 27

            K& = _KeyHit

            While _MouseInput: Wend

            If _MouseButton(1) Then Paint2 _MouseX, _MouseY, DarkBlue

        Loop

        If K& = 27 Then Exit Do



        K& = 0

    Loop

End Sub ' FillPetr



' /////////////////////////////////////////////////////////////////////////////



Sub Paint2 (x, y, c~&)

    Dim W

    Dim H

    Dim Virtual As Long

    Dim position&

    Dim Clr2~&

    Dim D&

    Dim CLR~&



    W = _Width: H = _Height

    Virtual = _NewImage(W, H, 32)



    Dim m As _MEM, n As _MEM, Bck As _Unsigned Long



    m = _MemImage(_Source)

    n = _MemImage(Virtual)



    'create mask (2 color image)

    position& = (y * W + x) * 4



    _MemGet m, m.OFFSET + position&, Bck



    Clr2~& = _RGB32(_Red32(Bck) - 1, _Green32(Bck) - 1, _Blue32(Bck) - 1, _Alpha32(Bck) - 1)



    D& = 0



    Do Until D& = n.SIZE

        CLR~& = _MemGet(m, m.OFFSET + D&, _Unsigned Long)

        If CLR~& = Bck~& Then _MemPut n, n.OFFSET + D&, CLR~& Else _MemPut n, n.OFFSET + D&, Clr2~&

        D& = D& + 4

    Loop



    D& = _Dest



    _Dest Virtual

    Paint (x, y), c~&, Clr2~&

    _Dest D&

    _ClearColor Clr2~&, Virtual

    _PutImage , Virtual, D&



    _MemFree m

    _MemFree n

    _FreeImage Virtual

End Sub ' Paint2

' ################################################################################################################################################################

' # END Petr's fill code

' ################################################################################################################################################################





' ################################################################################################################################################################

' BEGIN SHAPES TEST

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////



Sub DrawTest

    Dim iLastKeyCode%: iLastKeyCode% = 0 ' for reading keys with _BUTTON

    Dim bFinished As Integer: bFinished = _FALSE

    Dim k$, LastKey$: LastKey$ = ""

    ReDim arrColor(0 To 0) As _Unsigned Long

    ReDim arrGray(0 To 0) As _Unsigned Long

    ReDim arrNotColor(0 To 1) As _Unsigned Long

    Dim index As Integer

    Dim xmin, ymin As Integer

    Dim xmax, ymax As Integer

    Dim iX, iY, iSize, iSizeW, iSizeH, iRadius, iThickness, iWeight, iStyle, x1, y1, x2, y2, x3, y3 As Integer

    Dim x!, y!, radius!, thickness!

    Dim fgColor, bgColor As _Unsigned Long

    Dim ScreenColor As _Unsigned Long

    Dim iLoop As Integer

    Dim delim$: delim$ = Chr$(9)

    ReDim arrHelp(-1) As String

    Dim in$

    Dim ColNum, RowNum, NextCol, bStartOdd, MsgRow As Integer

    Dim MaxCols, MaxRows, MaxLen, ColCount As Integer

    Dim iCharCode As Integer

    Dim imgHelp&

    Dim imgDraw&



    ' MOUSE VARS

    Dim PointerSize As Integer

    Dim MouseColor~&

    Dim mx, my As Integer ' mouse pointer

    Dim iWheel As Integer ' mouse wheel

    Dim bButton1 As Integer

    Dim bButton2 As Integer

    Dim bButton3 As Integer

    Dim bOldButton1 As Integer

    Dim bOldButton2 As Integer

    Dim bOldButton3 As Integer

    Dim bClickButton1 As Integer

    Dim bClickButton2 As Integer

    Dim bClickButton3 As Integer

    Dim imgMouse&



    ' INTIALIZE

    Randomize Timer

    xmin = 0: ymin = 0: xmax = 800: ymax = 600 'xmax = _DesktopWidth - 1: ymax = _DesktopHeight - 1

    ScreenColor = cBlack

    AddSpectrumColors arrColor()

    AddGrayscaleColors arrGray()

    arrNotColor(0) = ScreenColor: arrNotColor(1) = ScreenColor

    PointerSize = 10: MouseColor~& = cWhite

    iCharCode = 64



    ' INIT MOUSE STATE

    bOldButton1 = _FALSE

    bOldButton2 = _FALSE

    bOldButton3 = _FALSE

    bClickButton1 = _FALSE

    bClickButton2 = _FALSE

    bClickButton3 = _FALSE



    ' INIT HELP

    in$ = ""

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "1 = BOX OUTLINE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "2 = SOLID BOX"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "3 = RECTANGLE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "4 = CIRCLE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "5 = CIRCLE OUTLINE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "6 = RECTANGLE OUTLINE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "7 = SOLID RECTANGLE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "8 = SQUARE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "9 = OUTLINE BOX"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "0 = STYLED OUTLINE BOX"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "A = TRIANGLE FILL"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "C = THICK CIRCLE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "L = THICK LINE"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "T = TEXT"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "F = STEVE FILL"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "B = BPLUS FILL"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "P = PETR  FILL"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "HOME = CLEAR SCREEN"

    in$ = in$ + _IIf(Len(in$) > 0, delim$, "") + "ESC = QUIT"

    split in$, delim$, arrHelp()



    ' PAD WITH SPACES SO ALL ARE EQUAL LENGTH

    MaxLen = 0

    For index = LBound(arrHelp) To UBound(arrHelp)

        If Len(arrHelp(index)) > MaxLen Then MaxLen = Len(arrHelp(index))

    Next index

    For index = LBound(arrHelp) To UBound(arrHelp)

        If Len(arrHelp(index)) < MaxLen Then arrHelp(index) = Left$(arrHelp(index) + String$(MaxLen, " "), MaxLen)

    Next index



    ' INIT SCREEN

    Screen _NewImage(xmax, ymax, 32)

    _Display

    _ScreenMove 0, 0

    _Dest 0: Cls , ScreenColor

    MaxCols = (xmax / _FontWidth)

    MaxRows = (ymax / _FontHeight)



    ' INIT LAYERS

    InitImage imgDraw&, xmax, ymax, cEmpty

    InitImage imgHelp&, xmax, ymax, cEmpty

    InitImage imgMouse&, xmax, ymax, cEmpty

    _Dest imgDraw&: Cls , cEmpty



    ' SHOW MENU CHOICES AT TOP

    _Dest imgHelp&: Cls , cEmpty

    RowNum = 1: ColNum = 1: ColCount = 0

    For index = LBound(arrHelp) To UBound(arrHelp)

        If RowNum > MaxRows Then Exit For

        ColCount = ColCount + 1



        ' ALTERNATE COLORS

        If IsOdd%(RowNum) Then

            If IsOdd(ColCount) Then

                Color cWhite, cDarkGray ' cDarkGray cGray cSilver cWhite

            Else

                Color cBlack, cSilver

            End If

        Else

            If IsOdd(ColCount) Then

                Color cBlack, cSilver

            Else

                Color cBlack, cDarkGray ' cDarkGray cGray cSilver cWhite

            End If

        End If



        Locate RowNum, ColNum

        Print " " + arrHelp(index) + " ";



        If index < UBound(arrHelp) Then

            ColNum = ColNum + Len(arrHelp(index)) + 2

            NextCol = ColNum + Len(arrHelp(index + 1)) + 2

            If NextCol > MaxCols Then

                ColNum = 1: RowNum = RowNum + 1: ColCount = 0

            End If

        End If

    Next index

    RowNum = RowNum + 1: MsgRow = RowNum

    RowNum = RowNum + 1: ymin = RowNum * _FontHeight



    ' MAIN LOOP

    Do

        ' GET MOUSE COORDINATES

        While _MouseInput: Wend

        mx = _MouseX

        my = _MouseY

        If mx < xmin Then

            mx = xmin

        ElseIf mx > xmax Then

            mx = xmax

        End If

        If my < ymin Then

            my = ymin

        ElseIf my > ymax Then

            my = ymax

        End If



        ' DRAW CROSSHAIR FOR MOUSE

        _Dest imgMouse&: Cls , cEmpty

        Line (mx - (PointerSize / 2), my)-(mx + (PointerSize / 2), my), MouseColor~&

        Line (mx, my - (PointerSize / 2))-(mx, my + (PointerSize / 2)), MouseColor~&



        '' GET MOUSE WHEEL INPUT

        'While _MouseInput

        '    iR = iR + _MouseWheel * 5

        '    If iR < iMinR Then

        '        iR = iMinR

        '    ElseIf iR > iMaxR Then

        '        iR = iMaxR

        '    End If

        'Wend



        ' READ BUTTONS

        bButton1 = _MouseButton(1)

        bButton2 = _MouseButton(2)

        bButton3 = _MouseButton(3)

        ToggleButtonState bButton1, bOldButton1, bClickButton1

        ToggleButtonState bButton2, bOldButton2, bClickButton2

        ToggleButtonState bButton3, bOldButton3, bClickButton3



        '' BUTTONS CHANGE COLOR

        'If bClickButton1 = _TRUE Then

        '    iC = iC + 1: If iC > iMaxColor Then iC = iMinColor

        'ElseIf bClickButton2 = _TRUE Then

        '    iC = iC - 1: If iC < iMinColor Then iC = iMaxColor

        'ElseIf bClickButton3 = _TRUE Then

        '    iC = iMinColor

        'End If



        ' DO ANY DRAWING ON DRAW LAYER

        _Dest imgDraw&



        ' PROCESS KEYBOARD INPUT

        While _DeviceInput(1): Wend ' clear and update the keyboard buffer



        If _Button(KeyCode_Escape) Then

            ' ESC = QUIT

            iLastKeyCode% = KeyCode_Escape

            bFinished = _TRUE



        ElseIf _Button(KeyCode_1) Then

            If iLastKeyCode% <> KeyCode_1 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_1: LastKey$ = ""



                ' 1 = BOX OUTLINE

                iSize = RandomNumber%(100, 200)

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawBoxOutline iX, iY, iSize, fgColor



                in$ = left$( _

                    "DrawBoxOutline " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSize=" + _ToStr$(iSize) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_2) Then

            If iLastKeyCode% <> KeyCode_2 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_2: LastKey$ = ""



                ' 2 = SOLID BOX

                iSize = RandomNumber%(100, 200)

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawBoxSolid iX, iY, iSize, fgColor



                in$ = left$( _

                    "DrawBoxSolid " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSize=" + _ToStr$(iSize) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_3) Then

            If iLastKeyCode% <> KeyCode_3 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_3: LastKey$ = ""



                ' 3 = RECTANGLE

                iSizeW = RandomNumber%(100, 200)

                iSizeH = RandomNumber%(50, 100)

                'iX = RandomNumber%(xmin, xmax - iSizeW)

                'iY = RandomNumber%(ymin, ymax - iSizeH)

                iX = mx: iY = my



                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                arrNotColor(1) = fgColor

                bgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawRect imgDraw&, iX, iY, iSizeW, iSizeH, fgColor, bgColor



                in$ = left$( _

                    "DrawRect " + _

                    "imgDraw&, " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSizeW=" + _ToStr$(iSizeW) + ", " + _

                    "iSizeH=" + _ToStr$(iSizeH) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + ", " + _

                    "bgColor=" + _ToStr$(bgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_4) Then

            If iLastKeyCode% <> KeyCode_4 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_4: LastKey$ = ""



                ' 4 = CIRCLE

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                iRadius = RandomNumber%(75, 125)

                iThickness = RandomNumber%(10, 20)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                arrNotColor(1) = fgColor

                bgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawCircle imgDraw&, iX, iY, iRadius, iThickness, fgColor, bgColor



                in$ = left$( _

                    "DrawCircle " + _

                    "imgDraw&, " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iRadius=" + _ToStr$(iRadius) + ", " + _

                    "iThickness=" + _ToStr$(iThickness) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + ", " + _

                    "bgColor=" + _ToStr$(bgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_5) Then



            If iLastKeyCode% <> KeyCode_5 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_5: LastKey$ = ""



                ' 5 = CIRCLE OUTLINE

                iRadius = RandomNumber%(125, 175)

                'iX = RandomNumber%(xmin, xmax - iRadius)

                'iY = RandomNumber%(ymin, ymax - iRadius)

                iX = mx: iY = my

                iThickness = RandomNumber%(25, 100)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawCircleOutline imgDraw&, iX, iY, iRadius, iThickness, fgColor



                in$ = left$( _

                    "**FAILS?** DrawCircleOutline " + _

                    "imgDraw&, " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iRadius=" + _ToStr$(iRadius) + ", " + _

                    "iThickness=" + _ToStr$(iThickness) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cRed: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_6) Then

            If iLastKeyCode% <> KeyCode_6 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_6: LastKey$ = ""



                ' 6 = RECTANGLE OUTLINE

                'iX = RandomNumber%(xmin, xmax - iSizeW)

                'iY = RandomNumber%(ymin, ymax - iSizeH)

                iX = mx: iY = my

                iSizeW = RandomNumber%(100, 200)

                iSizeH = RandomNumber%(50, 100)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawRectOutline iX, iY, iSizeW, iSizeH, fgColor



                in$ = left$( _

                    "DrawRectOutline " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSizeW=" + _ToStr$(iSizeW) + ", " + _

                    "iSizeH=" + _ToStr$(iSizeH) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_7) Then

            If iLastKeyCode% <> KeyCode_7 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_7: LastKey$ = ""



                ' 7 = SOLID RECTANGLE

                'iX = RandomNumber%(xmin, xmax - iSizeW)

                'iY = RandomNumber%(ymin, ymax - iSizeH)

                iX = mx: iY = my

                iSizeW = RandomNumber%(100, 200)

                iSizeH = RandomNumber%(50, 100)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawRectSolid iX, iY, iSizeW, iSizeH, fgColor



                in$ = left$( _

                    "DrawRectSolid " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSizeW=" + _ToStr$(iSizeW) + ", " + _

                    "iSizeH=" + _ToStr$(iSizeH) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_8) Then

            If iLastKeyCode% <> KeyCode_8 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_8: LastKey$ = ""



                ' 8 = SQUARE

                iSize = RandomNumber%(100, 150)

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                arrNotColor(1) = fgColor

                bgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawSquare imgDraw&, iX, iY, iSize, fgColor, bgColor



                in$ = left$( _

                    "**FAILS?** DrawSquare " + _

                    "imgDraw&, " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSize=" + _ToStr$(iSize) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + ", " + _

                    "bgColor=" + _ToStr$(bgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cRed: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_9) Then

            If iLastKeyCode% <> KeyCode_9 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_9: LastKey$ = ""



                ' 9 = OUTLINE BOX

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                iSize = RandomNumber%(100, 150)

                index = RandomNumber%(LBound(arrColor), UBound(arrColor)): fgColor = arrColor(index)

                iWeight = RandomNumber%(6, 12)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawOutlineBox iX, iY, iSize, fgColor, iWeight



                in$ = left$( _

                    "DrawOutlineBox " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSize=" + _ToStr$(iSize) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + ", " + _

                    "iWeight=" + _ToStr$(iWeight) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_0) Then

            If iLastKeyCode% <> KeyCode_0 Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_0: LastKey$ = ""



                ' 0 = STYLED OUTLINE BOX

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                iSize = RandomNumber%(90, 130)

                index = RandomNumber%(LBound(arrGray), UBound(arrGray)): fgColor = arrGray(index)

                iStyle = RandomNumber%(0, 255)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                DrawStyledOutlineBox iX, iY, iSize, fgColor, iStyle



                in$ = left$( _

                    "DrawStyledOutlineBox " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iSize=" + _ToStr$(iSize) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + ", " + _

                    "iStyle=" + _ToStr$(iStyle) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_A) Then

            If iLastKeyCode% <> KeyCode_A Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_A: LastKey$ = ""



                ' A = TRIANGLE FILL

                x1 = mx + RandomNumber%(-150, 150)

                y1 = my + RandomNumber%(-150, 150)

                x2 = mx + RandomNumber%(-150, 150)

                y2 = my + RandomNumber%(-150, 150)

                x3 = mx + RandomNumber%(-150, 150)

                y3 = my + RandomNumber%(-150, 150)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                TriangleFill x1, y1, x2, y2, x3, y3, fgColor



                in$ = left$( _

                    "TriangleFill " + _

                    "x1=" + _ToStr$(x1) + ", " + _

                    "y1=" + _ToStr$(y1) + ", " + _

                    "x2=" + _ToStr$(x2) + ", " + _

                    "y2=" + _ToStr$(y2) + ", " + _

                    "x3=" + _ToStr$(x3) + ", " + _

                    "y3=" + _ToStr$(y3) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_C) Then

            If iLastKeyCode% <> KeyCode_C Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_C: LastKey$ = ""



                ' C = THICK CIRCLE

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                iRadius = RandomNumber%(50, 100)

                iThickness = RandomNumber%(15, 30)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                ThickCircle iX, iY, iRadius, iThickness, fgColor



                in$ = left$( _

                    "ThickCircle " + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "iRadius=" + _ToStr$(iRadius) + ", " + _

                    "iThickness=" + _ToStr$(iThickness) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_L) Then

            If iLastKeyCode% <> KeyCode_L Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_L: LastKey$ = ""



                ' L = THICK LINE

                x1 = mx + RandomNumber%(-100, 100)

                y1 = my + RandomNumber%(-100, 100)

                x2 = mx + RandomNumber%(-100, 100)

                y2 = my + RandomNumber%(-100, 100)

                iThickness = RandomNumber%(1, 5)

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                ThickLine x1, y1, x2, y2, iThickness, fgColor



                in$ = left$( _

                    "ThickLine " + _

                    "x1=" + _ToStr$(x1) + ", " + _

                    "y1=" + _ToStr$(y1) + ", " + _

                    "x2=" + _ToStr$(x2) + ", " + _

                    "y2=" + _ToStr$(y2) + ", " + _

                    "iThickness=" + _ToStr$(iThickness) + ", " + _

                    "fgColor=" + _ToStr$(fgColor) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_T) Then

            If iLastKeyCode% <> KeyCode_T Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_T: LastKey$ = ""



                ' T = TEXT

                'iX = RandomNumber%(xmin, xmax - iSize)

                'iY = RandomNumber%(ymin, ymax - iSize)

                iX = mx: iY = my

                iCharCode = iCharCode + 1: If iCharCode > 90 Then iCharCode = 65

                iSize = RandomNumber%(1, 8)

                in$ = String$(iSize, Chr$(iCharCode))

                arrNotColor(1) = ScreenColor

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                arrNotColor(1) = fgColor

                bgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                Color fgColor, bgColor

                _PrintString (iX, iY), in$



                in$ = left$( _

                    "Color " + _

                    "fgColor=" + _ToStr$(fgColor) + ", " + _

                    "bgColor=" + _ToStr$(bgColor) + " : " + _

                    "_PrintString " + _

                    "(" + _

                    "iX=" + _ToStr$(iX) + ", " + _

                    "iY=" + _ToStr$(iY) + ", " + _

                    "), " + _

                    "in$=" + chr$(34) + in$ + chr$(34) + _

                    string$(MaxCols-1, " "), MaxCols-1)

                Color cWhite, cBlue: Locate MsgRow, 1: Print in$;



            End If



        ElseIf _Button(KeyCode_F) Then

            If iLastKeyCode% <> KeyCode_F Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_F: LastKey$ = ""



                ' F = STEVE FILL

                _Source imgDraw&

                arrNotColor(1) = Point(mx, my)

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                _Dest imgDraw&



                ' DOESN'T FILL EMPTY:

                Fill mx, my, fgColor ' Steve

            End If



        ElseIf _Button(KeyCode_B) Then

            If iLastKeyCode% <> KeyCode_B Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_B: LastKey$ = ""



                ' B = BPLUS FILL

                _Source imgDraw&

                arrNotColor(1) = Point(mx, my)

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                _Dest imgDraw&



                ' WORKS BUT SLOW:

                paint3 mx, my, fgColor ' BPLUS



            End If



        ElseIf _Button(KeyCode_P) Then

            If iLastKeyCode% <> KeyCode_P Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_P: LastKey$ = ""



                ' P = PETR FILL

                _Source imgDraw&

                arrNotColor(1) = Point(mx, my)

                fgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())



                _Dest imgDraw&



                ' DOESN'T FILL EMPTY:

                Paint2 mx, my, fgColor ' Petr



                ''OLD PAINT METHOD, NOT REALLY PAINTBUCKET:

                'iX = mx

                'iY = my

                'arrNotColor(1) = fgColor ' use previous shape's color as border color

                'bgColor = GetRandomColorExcept~&(arrColor(), arrNotColor())

                'Paint (iX, iY), bgColor, fgColor ' PAINT [STEP] (column%, row%), fillColor[, borderColor%]

            End If



        ElseIf _Button(KeyCode_Home) Or _Button(KeyCode_Keypad7Home) Then

            If iLastKeyCode% <> KeyCode_Home Then

                ' Remember last key pressed to prevent holding it down

                iLastKeyCode% = KeyCode_Home: LastKey$ = ""



                ' HOME = CLS

                _Dest imgDraw&: Cls , cEmpty

            End If



        Else

            ' Clear last keycode pressed (since it wasn't any of those)

            iLastKeyCode% = 0



            ' -----------------------------------------------------------------------------

            ' SEE IF ANY OTHER KEYS WERE PRESSED USING InKey$

            ' -----------------------------------------------------------------------------

            k$ = InKey$

            If Len(k$) Then

                ' Remember last InKey$ pressed

                LastKey$ = k$

            Else

                ' Clear last key pressed

                LastKey$ = ""

            End If

        End If

        _KeyClear ' CLEAR KEYBOARD BUFFER



        ' DRAW LAYERS

        _Dest 0: Cls , ScreenColor

        _PutImage , imgDraw&, 0

        _PutImage , imgHelp&, 0

        _PutImage , imgMouse&, 0



        If bFinished = _TRUE Then Exit Do

        _Display

    Loop Until _KeyDown(27)



    ' RELEASE OBJECTS FROM MEMORY

    Screen 0

    FreeImage imgDraw&

    FreeImage imgHelp&

    FreeImage imgMouse&



    ' RESTORE DISPLAY

    _AutoDisplay

End Sub ' DrawTest



' ################################################################################################################################################################

' END SHAPES TEST

' ################################################################################################################################################################





' ################################################################################################################################################################

' BEGIN SHAPE DRAWING ROUTINES #SHAPE #DRAW

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' DRAW A 2-D BOX (OUTLINE)

' https://www.qb64.org/wiki/LINE



'DrawBoxOutline iX, iY, iSize, fgColor

Sub DrawBoxOutline (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + (iSize - 1), iY + (iSize - 1)), fgColor, B ' Draw box outline

End Sub ' DrawBoxOutline



' /////////////////////////////////////////////////////////////////////////////

' DRAW A 2-D BOX (SOLID)

' https://www.qb64.org/wiki/LINE



' Renamed DrawBox/DrawBoxLine to DrawSolidBox



'DrawBoxSolid iX, iY, iSize, fgColor

Sub DrawBoxSolid (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + (iSize - 1), iY + (iSize - 1)), fgColor, BF ' Draw a solid box

End Sub ' DrawBoxSolid



' /////////////////////////////////////////////////////////////////////////////

' bplus: The Gold Standard is even better than THE QB64 CIRCLE sub in this respect!

' https://forum.qb64.org/index.php?topic=1044.135



' from Steve Gold standard

' Renamed fcirc to DrawCircleSolid



' Not as fast as DrawCircleTopLeft but pretty fast.



' Example:

' Screen _NewImage(800, 600, 32)

' _ScreenMove 250, 60

' For r = 250 To 0 Step -60

'     DrawCircleSolid 400, 300, r, _RGBA(255, 255, 255, 100)

' Next r



'DrawCircle 0, iX, iY, iRadius, iThickness, fgColor, bgColor

Sub DrawCircle (img&, iX As Integer, iY As Integer, iRadius As Integer, iThickness As Integer, fgColor As _Unsigned Long, bgColor As _Unsigned Long)

    Dim iLoop As Integer

    Dim iNextRadius As Integer

    Dim iRadiusError As Integer

    Dim iNextX As Integer

    Dim iNextY As Integer

    If (img& <= 0) And (iThickness > 0) And (fgColor <> cEmpty) Then

        ' Select target image

        _Dest img& ': Cls , cEmpty



        ' Draw circle fill

        If bgColor <> cEmpty Then

            iNextRadius = Abs(iRadius)

            iRadiusError = -iNextRadius

            iNextX = iNextRadius

            iNextY = 0

            If iNextRadius = 0 Then

                PSet (iX, iY), bgColor

            Else

                ' Draw the middle span here so we don't draw it twice in the main loop,

                ' which would be a problem with blending turned on.

                Line (iX - iNextX, iY)-(iX + iNextX, iY), bgColor, BF

                While iNextX > iNextY

                    iRadiusError = iRadiusError + iNextY * 2 + 1

                    If iRadiusError >= 0 Then

                        If iNextX <> iNextY + 1 Then

                            Line (iX - iNextY, iY - iNextX)-(iX + iNextY, iY - iNextX), bgColor, BF

                            Line (iX - iNextY, iY + iNextX)-(iX + iNextY, iY + iNextX), bgColor, BF

                        End If

                        iNextX = iNextX - 1

                        iRadiusError = iRadiusError - iNextX * 2

                    End If

                    iNextY = iNextY + 1

                    Line (iX - iNextX, iY - iNextY)-(iX + iNextX, iY - iNextY), bgColor, BF

                    Line (iX - iNextX, iY + iNextY)-(iX + iNextX, iY + iNextY), bgColor, BF

                Wend

            End If

        End If



        ' Draw circle outline

        If fgColor <> cEmpty Then

            If iRadius = 0 Then

                PSet (iX, iY), fgColor

            Else

                iNextRadius = iRadius

                For iLoop = 1 To iThickness



                    ' DRAW CIRCLE

                    ' CIRCLE (x, y), radius, color

                    'CIRCLE [[[STEP]]](column, row), radius%, [drawColor%][, startRadian!, stopRadian!] [, aspect!]

                    Circle (iX, iY), iNextRadius, fgColor



                    'Line (iLoop * 8, iHeight * 16)-(iLoop * 8 + 8, _Height), cGray, BF

                    'Circle (iX, iY), 4, cRed



                    iNextRadius = iNextRadius - 1

                    If iNextRadius = 0 Then

                        PSet (iX, iY), fgColor

                        Exit For

                    End If

                Next iLoop

            End If

        End If



    End If

End Sub ' DrawCircle



' /////////////////////////////////////////////////////////////////////////////



'DrawCircleOutline 0, iX, iY, iRadius, iThickness, fgColor

Sub DrawCircleOutline (img&, iX As Integer, iY As Integer, iRadius As Integer, iThickness As Integer, fgColor As _Unsigned Long)



    Dim iNextRadius As Integer

    Dim iLoop As Integer

    If (img& <= 0) And (iThickness > 0) And (fgColor <> cEmpty) Then

        ' Select target image

        _Dest img& ': Cls , cEmpty



        ' Initialize

        iNextRadius = iRadius



        ' Draw circle

        If iRadius = 0 Then

            PSet (iX, iY), fgColor

        Else

            For iLoop = 1 To iThickness



                ' DRAW CIRCLE

                ' CIRCLE (x, y), radius, color

                'CIRCLE [[[STEP]]](column, row), radius%, [drawColor%][, startRadian!, stopRadian!] [, aspect!]

                Circle (iX, iY), iNextRadius, fgColor



                'Line (iLoop * 8, iHeight * 16)-(iLoop * 8 + 8, _Height), cGray, BF

                'Circle (iX, iY), 4, cRed



                iNextRadius = iNextRadius - 1

                If iNextRadius = 0 Then

                    PSet (iX, iY), fgColor

                    Exit For

                End If

            Next iLoop

        End If

    End If

End Sub ' DrawCircleOutline



' /////////////////////////////////////////////////////////////////////////////

' DRAW A 2-D BOX (OUTLINE) WITH A SOLID LINE



'DrawOutlineBox iX%, iY%, iSize2%, iColor~&, iWeight2%

Sub DrawOutlineBox (iX%, iY%, iSize2%, iColor~&, iWeight2%)

    Dim iFromX%

    Dim iFromY%

    Dim iToX%

    Dim iToY%

    Dim iSize%

    Dim iWeight%



    iSize% = iSize2% - 1

    iWeight% = iWeight2% - 1

    If iWeight% = 0 Then

        ' TOP LINE

        iFromX% = iX%

        iFromY% = iY%

        iToX% = iX% + iSize%

        iToY% = iY%

        Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF



        ' BOTTOM LINE

        iFromX% = iX%

        iFromY% = iY% + iSize%

        iToX% = iX% + iSize%

        iToY% = iY% + iSize%

        Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF



        ' LEFT LINE

        iFromX% = iX%

        iFromY% = iY%

        iToX% = iX%

        iToY% = iY% + iSize%

        Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF



        ' RIGHT LINE

        iFromX% = iX% + iSize%

        iFromY% = iY%

        iToX% = iX% + iSize%

        iToY% = iY% + iSize%

        Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF

    ElseIf iWeight% > 0 Then

        ' TOP LINE

        For iFromY% = iY% To (iY% + iWeight%)

            iFromX% = iX%

            'iFromY% = iY%

            iToX% = iX% + iSize%

            iToY% = iFromY%

            Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF

        Next iFromY%



        ' BOTTOM LINE

        For iFromY% = ((iY% + iSize%) - iWeight%) To (iY% + iSize%)

            iFromX% = iX%

            'iFromY% = iY% + iSize%

            iToX% = iX% + iSize%

            iToY% = iFromY%

            Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF

        Next iFromY%



        ' LEFT LINE

        For iFromX% = iX% To (iX% + iWeight%)

            'iFromX% = iX%

            iFromY% = iY%

            iToX% = iFromX%

            iToY% = iY% + iSize%

            Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF

        Next iFromX%



        ' RIGHT LINE

        For iFromX% = ((iX% + iSize%) - iWeight%) To (iX% + iSize%)

            'iFromX% = iX% + iSize%

            iFromY% = iY%

            iToX% = iFromX%

            iToY% = iY% + iSize%

            Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF

        Next iFromX%

    End If

End Sub ' DrawOutlineBox



' /////////////////////////////////////////////////////////////////////////////

' DRAW A 2-D RECTANGLE



'DrawRect 0, iX, iY, iSizeW, iSizeH, fgColor, bgColor

Sub DrawRect (img&, iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long, bgColor As _Unsigned Long)

    'If img& < -1 Then

    If img& <= 0 Then

        ' Select target image

        _Dest img& ': Cls , cEmpty



        ' Draw fill (bgColor)

        If bgColor <> cEmpty Then

            Line (iX, iY)-(iX + (iSizeW - 1), iY + (iSizeH - 1)), bgColor, BF ' Draw a solid rectangle

        End If



        ' Draw outline (fgColor)

        If fgColor <> cEmpty Then

            Line (iX, iY)-(iX + (iSizeW - 1), iY + (iSizeH - 1)), fgColor, B ' Draw rectangle outline

        End If

    End If

End Sub ' DrawRect



' /////////////////////////////////////////////////////////////////////////////

' DRAW A 2-D RECTANGLE (OUTLINE)



'DrawRectOutline iX, iY, iSizeW, iSizeH, fgColor

Sub DrawRectOutline (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + (iSizeW - 1), iY + (iSizeH - 1)), fgColor, B ' Draw rectangle outline

End Sub ' DrawRectOutline



' /////////////////////////////////////////////////////////////////////////////

' DRAW A 2-D RECTANGLE (SOLID)



'DrawRectSolid iX, iY, iSizeW, iSizeH, fgColor

Sub DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + (iSizeW - 1), iY + (iSizeH - 1)), fgColor, BF ' Draw a solid rectangle

End Sub ' DrawRectSolid



' /////////////////////////////////////////////////////////////////////////////



'DrawSquare 0, x1, y1, size, fgcolor, bgcolor

Sub DrawSquare (img&, x1%, y1%, size%, fgcolor~&, bgcolor~&)

    Dim x2%, y2%

    If img& < -1 Then

        _Dest img& ': Cls , cEmpty



        x2% = (x1% + size%) - 1

        y2% = (y1% + size%) - 1



        Line (x1%, y1%)-(x2%, y1%), fgcolor~&, , 65535

        Line (x2%, y1%)-(x2%, y2%), fgcolor~&, , 65535

        Line (x2%, y2%)-(x1%, y2%), fgcolor~&, , 65535

        Line (x1%, y2%)-(x1%, y1%), fgcolor~&, , 65535



        If bgcolor~& <> cEmpty Then

            'PAINT [STEP] (column%, row%), fillColor[, borderColor%]

            Paint (x1% + 1, y1% + 1), bgcolor~&, fgcolor~&

        End If

    End If

End Sub ' Draw Square



' /////////////////////////////////////////////////////////////////////////////

' DRAW A 2-D BOX (OUTLINE)

' https://www.qb64.org/wiki/LINE



' The style parameter 0-255 doesn't seem to have a solid line?

' For that, use DrawOutlineBox.



' LINE [STEP] [(column1, row1)]-[STEP] (column2, row2), color[, [{B|BF}], style%]

' B creates a box outline with each side parallel to the program screen sides. BF creates a filled box.

' The style% signed INTEGER value sets a dotted pattern to draw the line or rectangle outline.



'DrawStyledOutlineBox iX%, iY%, iSize%, iColor~&, iStyle%

Sub DrawStyledOutlineBox (iX%, iY%, iSize%, iColor~&, iStyle%)

    Line (iX%, iY%)-(iX% + (iSize% - 1), iY% + (iSize% - 1)), iColor~&, B , iStyle%

End Sub ' DrawStyledOutlineBox



' /////////////////////////////////////////////////////////////////////////////

' Frees image if it exists

' and makes sure it isn't the current screen and _DEST



'FreeImage img

Sub FreeImage (ThisImage&)

    If ThisImage& < -1 Or ThisImage& > 0 Then

        If _ScreenImage = ThisImage& Then Screen 0

        If _Dest = ThisImage& Then _Dest 0

        _FreeImage ThisImage&

    End If

End Sub ' FreeImage



' /////////////////////////////////////////////////////////////////////////////

' Initializes an image

' (if it already exists, frees it up and re-instantiates)



'InitImage img, iWidth, iHeight, bgColor

Sub InitImage (ThisImage&, iWidth&, iHeight&, bgColor~&)

    FreeImage ThisImage&

    ThisImage& = _NewImage(iWidth&, iHeight&, 32)

    _Dest ThisImage&: Cls , bgColor~&

End Sub ' InitImage



' /////////////////////////////////////////////////////////////////////////////

' From: SMcNeill, Super Moderator

' Date: 01-02-2024, 08:19 AM

' https://qb64phoenix.com/forum/showthread...+thickness



'ThickCircle x!, y!, radius!, thickness!, colour~&

Sub ThickCircle (x As Single, y As Single, radius As Single, thickness As Single, colour As _Unsigned Long)

    Dim rp As Single, rm As Single, rp2 As Single, rm2 As Single

    Dim sm As Single, rpi2 As Single, rmi2 As Single, sp As Single

    Dim i As Single



    rp = radius + thickness / 2

    rm = radius - thickness / 2

    rp2 = rp ^ 2

    rm2 = rm ^ 2

    For i = -rp To -rm Step .2

        rpi2 = rp2 - i ^ 2

        sp = Sqr(rpi2)

        Line (x + i, y)-(x + i, y + sp), colour, BF

        Line (x + i, y)-(x + i, y - sp), colour, BF

    Next

    For i = -rm To 0 Step .2

        rpi2 = rp2 - i ^ 2

        rmi2 = rm2 - i ^ 2

        sm = Sqr(rmi2)

        sp = Sqr(rpi2)

        Line (x + i, y + sm)-(x + i, y + sp), colour, BF

        Line (x - i, y + sm)-(x - i, y + sp), colour, BF

        Line (x + i, y - sm)-(x + i, y - sp), colour, BF

        Line (x - i, y - sm)-(x - i, y - sp), colour, BF

    Next

    For i = rm To rp Step .2

        rpi2 = rp2 - i ^ 2

        sp = Sqr(rpi2)

        Line (x + i, y)-(x + i, y + sp), colour, BF

        Line (x + i, y)-(x + i, y - sp), colour, BF

    Next

End Sub ' ThickCircle



' /////////////////////////////////////////////////////////////////////////////

' From: SMcNeill, Super Moderator

' Date: 01-02-2024, 08:19 AM

' https://qb64phoenix.com/forum/showthread...+thickness



'ThickLine x1, y1, x2, y2, thk, kolor~&

Sub ThickLine (x1, y1, x2, y2, thk, kolor As _Unsigned Long)

    'draw a line of thickness thk on color klr from x1,y1 to x2,y2

    'orientation of line is set in the middle of line thickness

    Static tempimage As Long, m As _MEM



    Dim cang

    Dim ta

    Dim tb

    Dim tax1

    Dim tay1

    Dim tax4

    Dim tay4

    Dim tax2

    Dim tay2

    Dim tax3

    Dim tay3



    If tempimage = 0 Then tempimage = _NewImage(1, 1, 32): m = _MemImage(tempimage)

    $Checking:Off

    _MemPut m, m.OFFSET, kolor

    $Checking:On

    cang = _Atan2((y2 - y1), (x2 - x1)) 'get the angle from x1,y1 to x2,y2

    ta = cang + _Pi(.5)

    tb = ta + _Pi

    tax1 = x1 + (thk / 2) * Cos(ta): tay1 = y1 + (thk / 2) * Sin(ta)

    tax4 = x1 + (thk / 2) * Cos(tb): tay4 = y1 + (thk / 2) * Sin(tb)

    tax2 = x2 + (thk / 2) * Cos(ta): tay2 = y2 + (thk / 2) * Sin(ta)

    tax3 = x2 + (thk / 2) * Cos(tb): tay3 = y2 + (thk / 2) * Sin(tb)

    _MapTriangle (0, 0)-(0, 0)-(0, 0), tempimage To(tax1, tay1)-(tax2, tay2)-(tax4, tay4)

    _MapTriangle (0, 0)-(0, 0)-(0, 0), tempimage To(tax2, tay2)-(tax3, tay3)-(tax4, tay4)

End Sub ' ThickLine



' /////////////////////////////////////////////////////////////////////////////

' From: SMcNeill, Super Moderator

' Date: 01-02-2024, 08:19 AM

' https://qb64phoenix.com/forum/showthread...+thickness



'TriangleFill x1, y1, x2, y2, x3, y3, fgColor~&

Sub TriangleFill (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)

    $Checking:Off

    Static a&, m As _MEM

    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)

    _MemPut m, m.OFFSET, K

    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)

    $Checking:On

End Sub ' TriangleFill



' ################################################################################################################################################################

' END SHAPE DRAWING ROUTINES @SHAPE @DRAW

' ################################################################################################################################################################











' SOME FLOOD FILL STUFF TO TRY LATER?



'' /////////////////////////////////////////////////////////////////////////////

'' QIX

'' https://qb64phoenix.com/forum/showthread...0#pid10820

'' From: james2464

'' Date 11-28-2022, 10:36 PM

'

'' using paint for flood fills

'Sub claimfillfast (x, y, c~&)

'    c~& = _RGB(30, 30, 30)

'    k = q(1).xx: j = q(1).yy

'

'   ' PAINT [STEP] (column%, row%), fillColor[, borderColor%]

'    Paint (k, j), c~&

'

'    'fill black with blue

'    For j = 41 To 439

'        For k = 121 To 519

'            c(16) = Point(k, j)

'            If c(16) = c(0) Then

'                PSet (k, j), c(4)

'                bluetot = bluetot + 1

'            End If

'        Next k

'    Next j

'

'    'fill gray with black

'    k = q(1).xx: j = q(1).yy

'    Paint (k, j), c(0), c(1)

'End Sub ' claimfillfast

'

'' /////////////////////////////////////////////////////////////////////////////

'' QIX

'' https://qb64phoenix.com/forum/showthread...0#pid10820

'' From: james2464

'' Date 11-28-2022, 10:36 PM

'

'' using paint for flood fills

'Sub claimfillslow (x, y, c~&)

'    'start at qix

'    c~& = _RGB(30, 30, 30)

'    k = q(1).xx: j = q(1).yy

'

'   ' PAINT [STEP] (column%, row%), fillColor[, borderColor%]

'   Paint (k, j), c~&

'

'    'fill black with red

'    For j = 41 To 439

'        For k = 121 To 519

'            c(16) = Point(k, j)

'            If c(16) = c(0) Then

'                PSet (k, j), c(5)

'                redtot = redtot + 1

'            End If

'        Next k

'    Next j

'

'    'fill gray with black

'    k = q(1).xx: j = q(1).yy

'    Paint (k, j), c(0), c(1)

'End Sub ' claimfillslow

















' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN RGB COLOR FUNCTIONS #RGB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++



Function cRed~& ()

    cRed = _RGB32(255, 0, 0)

End Function



Function cOrangeRed~& ()

    cOrangeRed = _RGB32(255, 69, 0)

End Function ' cOrangeRed~&



' added this cuz the others either feel too red or too yellow!

Function cTrueOrange~& ()

    cTrueOrange = _RGB32(255, 100, 0)

End Function ' cTrueOrange~&



Function cDarkOrange~& ()

    cDarkOrange = _RGB32(255, 140, 0)

End Function ' cDarkOrange~&



Function cOrange~& ()

    cOrange = _RGB32(255, 165, 0)

End Function ' cOrange~&



Function cGold~& ()

    cGold = _RGB32(255, 215, 0)

End Function ' cGold~&



Function cYellow~& ()

    cYellow = _RGB32(255, 255, 0)

End Function ' cYellow~&



' LONG-HAIRED FRIENDS OF JESUS OR NOT,

' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)

' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:

Function cChartreuse~& ()

    cChartreuse = _RGB32(127, 255, 0)

End Function ' cChartreuse~&



' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:

Function cOliveDrab1~& ()

    cOliveDrab1 = _RGB32(192, 255, 62)

End Function ' cOliveDrab1~&



Function cLime~& ()

    cLime = _RGB32(0, 255, 0)

End Function ' cLime~&



Function cMediumSpringGreen~& ()

    cMediumSpringGreen = _RGB32(0, 250, 154)

End Function ' cMediumSpringGreen~&



' ADDED THIS FOR THE GAUGE COLOR:

Function cSpringGreen~& ()

    cSpringGreen = _RGB32(0, 255, 160)

End Function ' cSpringGreen~&



Function cCyan~& ()

    cCyan = _RGB32(0, 255, 255)

End Function ' cCyan~&



Function cDeepSkyBlue~& ()

    cDeepSkyBlue = _RGB32(0, 191, 255)

End Function ' cDeepSkyBlue~&



Function cDodgerBlue~& ()

    cDodgerBlue = _RGB32(30, 144, 255)

End Function ' cDodgerBlue~&



Function cSeaBlue~& ()

    cSeaBlue = _RGB32(0, 64, 255)

End Function ' cSeaBlue~&



Function cBlue~& ()

    cBlue = _RGB32(0, 0, 255)

End Function ' cBlue~&



Function cBluePurple~& ()

    cBluePurple = _RGB32(64, 0, 255)

End Function ' cBluePurple~&



Function cDeepPurple~& ()

    cDeepPurple = _RGB32(96, 0, 255)

End Function ' cDeepPurple~&



Function cPurple~& ()

    cPurple = _RGB32(128, 0, 255)

End Function ' cPurple~&



Function cPurpleRed~& ()

    cPurpleRed = _RGB32(128, 0, 192)

End Function ' cPurpleRed~&



Function cDarkRed~& ()

    cDarkRed = _RGB32(160, 0, 64)

End Function ' cDarkRed~&



Function cBrickRed~& ()

    cBrickRed = _RGB32(192, 0, 32)

End Function ' cBrickRed~&



Function cDarkGreen~& ()

    cDarkGreen = _RGB32(0, 100, 0)

End Function ' cDarkGreen~&



Function cGreen~& ()

    cGreen = _RGB32(0, 128, 0)

End Function ' cGreen~&



Function cOliveDrab~& ()

    cOliveDrab = _RGB32(107, 142, 35)

End Function ' cOliveDrab~&



Function cLightPink~& ()

    cLightPink = _RGB32(255, 182, 193)

End Function ' cLightPink~&



Function cHotPink~& ()

    cHotPink = _RGB32(255, 105, 180)

End Function ' cHotPink~&



Function cDeepPink~& ()

    cDeepPink = _RGB32(255, 20, 147)

End Function ' cDeepPink~&



Function cMagenta~& ()

    cMagenta = _RGB32(255, 0, 255)

End Function ' cMagenta~&



Function cBlack~& ()

    cBlack = _RGB32(0, 0, 0)

End Function ' cBlack~&



Function cDimGray~& ()

    cDimGray = _RGB32(105, 105, 105)

End Function ' cDimGray~&



Function cGray~& ()

    cGray = _RGB32(128, 128, 128)

End Function ' cGray~&



Function cDarkGray~& ()

    cDarkGray = _RGB32(169, 169, 169)

End Function ' cDarkGray~&



Function cSilver~& ()

    cSilver = _RGB32(192, 192, 192)

End Function ' cSilver~&



Function cLightGray~& ()

    cLightGray = _RGB32(211, 211, 211)

End Function ' cLightGray~&



Function cGainsboro~& ()

    cGainsboro = _RGB32(220, 220, 220)

End Function ' cGainsboro~&



Function cWhiteSmoke~& ()

    cWhiteSmoke = _RGB32(245, 245, 245)

End Function ' cWhiteSmoke~&



Function cWhite~& ()

    cWhite = _RGB32(255, 255, 255)

    'cWhite = _RGB32(254, 254, 254)

End Function ' cWhite~&



Function cDarkBrown~& ()

    cDarkBrown = _RGB32(128, 64, 0)

End Function ' cDarkBrown~&



Function cLightBrown~& ()

    cLightBrown = _RGB32(196, 96, 0)

End Function ' cLightBrown~&



Function cKhaki~& ()

    cKhaki = _RGB32(240, 230, 140)

End Function ' cKhaki~&



Function cEmpty~& ()

    'cEmpty~& = -1

    cEmpty = _RGB32(0, 0, 0, 0)

End Function ' cEmpty~&



' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END RGB COLOR FUNCTIONS @RGB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++



' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN TEST ALPHA COLORS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Function cDimGrayAlpha~& (alpha&)

    cDimGrayAlpha = _RGB32(105, 105, 105, alpha&)

End Function ' cDimGrayAlpha~&



Function cGrayAlpha~& (alpha&)

    cGrayAlpha = _RGB32(128, 128, 128, alpha&)

End Function ' cGrayAlpha~&



Function cDarkGrayAlpha~& (alpha&)

    cDarkGrayAlpha = _RGB32(169, 169, 169, alpha&)

End Function ' cDarkGrayAlpha~&



Function cSilverAlpha~& (alpha&)

    cSilverAlpha = _RGB32(192, 192, 192, alpha&)

End Function ' cSilverAlpha~&



Function cLightGrayAlpha~& (alpha&)

    cLightGrayAlpha = _RGB32(211, 211, 211, alpha&)

End Function ' cLightGrayAlpha~&



Function cGainsboroAlpha~& (alpha&)

    cGainsboroAlpha = _RGB32(220, 220, 220, alpha&)

End Function ' cGainsboroAlpha~&



Function cWhiteSmokeAlpha~& (alpha&)

    cWhiteSmokeAlpha = _RGB32(245, 245, 245, alpha&)

End Function ' cWhiteSmokeAlpha~&



Function cWhiteAlpha~& (alpha&)

    cWhiteAlpha = _RGB32(255, 255, 255, alpha&)

End Function ' cWhiteAlpha~&

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END TEST ALPHA COLORS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++







' ################################################################################################################################################################

' BEGIN COLOR ARRAY FUNCTIONS #COLR

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' Used by Sub AddColors



Sub AddColor (ColorValue As _Unsigned Long, arrColor() As _Unsigned Long)

    ReDim _Preserve arrColor(0 To UBound(arrColor) + 1) As _Unsigned Long

    arrColor(UBound(arrColor)) = ColorValue

End Sub ' AddColor



' /////////////////////////////////////////////////////////////////////////////

' Used by Sub AddSpectrumColors and Sub AddgrayscaleColors



Sub AddColors (ColorValue As _Unsigned Long, arrColor() As _Unsigned Long, HowMany As Long)

    Dim iLoop As Integer

    For iLoop = 1 To HowMany

        AddColor ColorValue, arrColor()

    Next iLoop

End Sub ' AddColors



' /////////////////////////////////////////////////////////////////////////////

' Adds colors colors to array arrColor().

' the first 8 colors are solid (alpha=255)

' the last  8 colors are transparent (alpha = parameter alpha&)



Sub AddTestColors (arrColor() As _Unsigned Long)

    Dim iNum As Integer

    iNum = 1



    ' SOLID:

    AddColors cRed, arrColor(), iNum

    AddColors cTrueOrange, arrColor(), iNum

    AddColors cYellow, arrColor(), iNum

    AddColors cLime, arrColor(), iNum

    AddColors cCyan, arrColor(), iNum

    AddColors cBlue, arrColor(), iNum

    AddColors cMagenta, arrColor(), iNum

    AddColors cBlack, arrColor(), iNum



    ' TRANSPARENT:

    Dim alpha&: alpha& = 256

    alpha& = alpha& - 30

    AddColors cDimGrayAlpha~&(alpha&), arrColor(), iNum

    alpha& = alpha& - 30

    AddColors cGrayAlpha~&(alpha&), arrColor(), iNum

    alpha& = alpha& - 30

    AddColors cDarkGrayAlpha~&(alpha&), arrColor(), iNum

    alpha& = alpha& - 30

    AddColors cSilverAlpha~&(alpha&), arrColor(), iNum

    alpha& = alpha& - 30

    AddColors cLightGrayAlpha~&(alpha&), arrColor(), iNum

    alpha& = alpha& - 30

    AddColors cGainsboroAlpha~&(alpha&), arrColor(), iNum

    alpha& = alpha& - 30

    AddColors cWhiteSmokeAlpha~&(alpha&), arrColor(), iNum

    alpha& = alpha& - 30

    AddColors cWhiteAlpha~&(alpha&), arrColor(), iNum



    'dim iLoop as integer

    'for iLoop = 1 to 8

    '   alpha& = alpha& - 30

    '   AddColors cWhiteAlpha~&(alpha&), arrColor(), iNum

    'next iLoop



End Sub ' AddTestColors



' /////////////////////////////////////////////////////////////////////////////

' Adds rainbow colors to array arrColor().



Sub AddSpectrumColors (arrColor() As _Unsigned Long)

    Dim iNum As Integer

    iNum = 1

    AddColors cRed, arrColor(), iNum

    AddColors cOrangeRed, arrColor(), iNum

    AddColors cDarkOrange, arrColor(), iNum

    AddColors cOrange, arrColor(), iNum

    AddColors cGold, arrColor(), iNum

    AddColors cYellow, arrColor(), iNum

    AddColors cChartreuse, arrColor(), iNum

    AddColors cOliveDrab1, arrColor(), iNum

    AddColors cLime, arrColor(), iNum

    AddColors cMediumSpringGreen, arrColor(), iNum

    AddColors cSpringGreen, arrColor(), iNum

    AddColors cCyan, arrColor(), iNum

    AddColors cDeepSkyBlue, arrColor(), iNum

    AddColors cDodgerBlue, arrColor(), iNum

    AddColors cSeaBlue, arrColor(), iNum

    AddColors cBlue, arrColor(), iNum

    AddColors cBluePurple, arrColor(), iNum

    AddColors cDeepPurple, arrColor(), iNum

    AddColors cPurple, arrColor(), iNum

    AddColors cPurpleRed, arrColor(), iNum

End Sub ' AddSpectrumColors



' /////////////////////////////////////////////////////////////////////////////

' Adds grayscale colors to array arrColor().



Sub AddGrayscaleColors (arrColor() As _Unsigned Long)

    Dim iNum As Integer

    iNum = 1

    AddColors cDimGray, arrColor(), iNum

    AddColors cGray, arrColor(), iNum

    AddColors cDarkGray, arrColor(), iNum

    AddColors cSilver, arrColor(), iNum

    AddColors cLightGray, arrColor(), iNum

    AddColors cGainsboro, arrColor(), iNum

    AddColors cWhiteSmoke, arrColor(), iNum

    AddColors cWhite, arrColor(), iNum '* 2

    AddColors cWhiteSmoke, arrColor(), iNum

    AddColors cGainsboro, arrColor(), iNum

    AddColors cLightGray, arrColor(), iNum

    AddColors cSilver, arrColor(), iNum

    AddColors cDarkGray, arrColor(), iNum

    AddColors cGray, arrColor(), iNum

End Sub ' AddGrayscaleColors



' /////////////////////////////////////////////////////////////////////////////

' Returns a random color chosen from array of color values arrColor().



'c~& = GetRandomColor~& (arrColor())

Function GetRandomColor~& (arrColor() As _Unsigned Long)

    Dim index As Integer

    index = RandomNumber%(LBound(arrColor), UBound(arrColor))

    GetRandomColor~& = arrColor(index)

End Function ' GetRandomColor~&



' /////////////////////////////////////////////////////////////////////////////

' Returns a random color chosen from array of color values arrColor(),

' but makes sure it isn't a color in array arrNotColor().



'c~& = GetRandomColorExcept~& (arrColor(), arrNotColor())

Function GetRandomColorExcept~& (arrColor() As _Unsigned Long, arrNotColor() As _Unsigned Long)

    Dim index1, index2 As Integer

    Dim c~&

    Dim bFound As Integer

    Dim iCount As Integer: iCount = 0 ' count # of tries

    Dim iMax As Integer: iMax = 1000 ' if we don't find it in 1000 tries, just exit

    Do

        index1 = RandomNumber%(LBound(arrColor), UBound(arrColor))

        c~& = arrColor(index1)

        bFound = _TRUE

        For index2 = LBound(arrNotColor) To UBound(arrNotColor)

            If arrNotColor(index2) = c~& Then bFound = _FALSE: Exit For

        Next index2

        If bFound = _TRUE Then Exit Do

        iCount = iCount + 1: If iCount > iMax Then c~& = _FALSE: Exit Do ' if we haven't found it by now, give up!

    Loop

    GetRandomColorExcept~& = c~&

End Function ' GetRandomColor~&



' ################################################################################################################################################################

' END COLOR ARRAY FUNCTIONS @COLR

' ################################################################################################################################################################



' ################################################################################################################################################################

' BEGIN GENERAL PURPOSE ROUTINES #GEN

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' Returns _TRUE if number n is even

' https://slaystudy.com/qbasic-program-to-...en-or-odd/

' see also: IsOdd%



Function IsEven% (n)

    If n Mod 2 = 0 Then

        IsEven% = _TRUE

    Else

        IsEven% = _FALSE

    End If

End Function ' IsEven%



' /////////////////////////////////////////////////////////////////////////////

' Returns _TRUE if number n is odd

' https://slaystudy.com/qbasic-program-to-...en-or-odd/

' see also: IsEven%



Function IsOdd% (n)

    If n Mod 2 = 1 Then

        IsOdd% = _TRUE

    Else

        IsOdd% = _FALSE

    End If

End Function ' IsOdd%



' /////////////////////////////////////////////////////////////////////////////

' Generate random value between Min and Max inclusive.



' Note: random-number generator should be initialized with

'       InitializeRandom or Randomize Timer



Function RandomNumber% (Min%, Max%)

    Dim NumSpread%

    NumSpread% = (Max% - Min%) + 1

    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%

End Function ' RandomNumber%



' /////////////////////////////////////////////////////////////////////////////

' Splits a string in$ by delimeter delimiter$

' into an array result$().



' Split and join strings

' https://www.qb64.org/forum/index.php?topic=1073.0

'

' FROM luke, QB64 Developer

' Date: February 15, 2019, 04:11:07 AM

'

' Given a string of words separated by spaces (or any other character),

' splits it into an array of the words. I've no doubt many people have

' written a version of this over the years and no doubt there's a million

' ways to do it, but I thought I'd put mine here so we have at least one

' version. There's also a join function that does the opposite

' array -> single string.

'

' Code is hopefully reasonably self explanatory with comments and a little demo.

' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.



' Split in$ into pieces, chopping at every occurrence of delimiter$.

' Multiple consecutive occurrences of delimiter$ are treated as a single instance.

' The chopped pieces are stored in result$().



' delimiter$ must be one character long.

' result$() must have been REDIMmed previously.



' Modified to handle multi-character delimiters



Sub split (in$, delimiter$, result$())

    Dim start As Integer

    Dim finish As Integer

    Dim iDelimLen As Integer

    ReDim result$(-1)



    iDelimLen = Len(delimiter$)



    start = 1

    Do

        While Mid$(in$, start, iDelimLen) = delimiter$

            start = start + iDelimLen

            If start > Len(in$) Then

                Exit Sub

            End If

        Wend

        finish = InStr(start, in$, delimiter$)

        If finish = 0 Then

            finish = Len(in$) + 1

        End If



        ReDim _Preserve result$(0 To UBound(result$) + 1)



        result$(UBound(result$)) = Mid$(in$, start, finish - start)

        start = finish + 1

    Loop While start <= Len(in$)

End Sub ' split



' /////////////////////////////////////////////////////////////////////////////

' For tracking mouse buttons



Sub ToggleButtonState (bButton As Integer, bOldButton As Integer, bClickButton As Integer)

    If bButton = _TRUE Then

        If bOldButton = _FALSE Then

            bClickButton = _TRUE

            bOldButton = _TRUE

        Else

            bClickButton = _FALSE

        End If

    Else

        bOldButton = _FALSE

        bClickButton = _FALSE

    End If

End Sub ' ToggleButtonState



' ################################################################################################################################################################

' END GENERAL PURPOSE ROUTINES @GEN

' ################################################################################################################################################################

Code: (Select All)

' Paint vs Fill speed comparison by Steve, v2 by madscijr

' https://qb64phoenix.com/forum/showthread.php?tid=3631&pid=33725#pid33725



Screen _NewImage(800, 800, 32)

Circle (400, 400), 400, _RGB32(255, 255, 255) 'white circle

TestNum% = 0

TextCols% = (_Width / _FontWidth) - 1



NumTests% = 5



TestNum% = TestNum% + 1

t0# = Timer



For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Paint)                   "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Paint (400, 400), _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), _RGB32(255, 255, 255)

Next i



TestNum% = TestNum% + 1

t1# = Timer



For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Fill EnableBlend%=_FALSE)"

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Fill 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), _FALSE

Next i



TestNum% = TestNum% + 1

t2# = Timer



For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Fill EnableBlend%=_TRUE) "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Fill 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), _TRUE

Next i



TestNum% = TestNum% + 1

t3# = Timer



For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Paint2)                  "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Paint2 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)

Next i



TestNum% = TestNum% + 1

t4# = Timer



' only test 1x, or else we'll be here all day!

For i = 1 To 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Paint3)                  "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 1    "

    paint3 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)

Next i



t5# = Timer



Locate 1, 1: Print Left$("Test complete" + String$(TextCols%, " "), TextCols%)

Locate 2, 1: Print Left$("Results for 100 fills:" + String$(TextCols%, " "), TextCols%)

Color _RGB32(255, 255, 255), _RGB32(0, 0, 255)

Locate 3, 2: Print Using "###.### seconds Paint                   "; t1# - t0#

Locate 4, 2: Print Using "###.### seconds Fill EnableBlend%=_FALSE "; t2# - t1#

Locate 5, 2: Print Using "###.### seconds Fill EnableBlend%=_TRUE  "; t3# - t2#

Locate 6, 2: Print Using "###.### seconds Paint2                  "; t4# - t3#

Locate 7, 2: Print Using "###.### seconds Paint3                  "; (t5# - t4#) * 100



' ################################################################################################################################################################

' # BEGIN BPlus's fill code

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' From: bplus, Mini-Mod

' 4/23/2025 8:53 PM



' I have a different kind of paint, Paint3 that fills the color

' it lands on to do the painting, any other color stops the

' paint like a border



' madscijr added check for Esc key to cancel



Sub paint3 (x0, y0, MyFill As _Unsigned Long) ' needs GetMax, GetMin functions

    Dim fillColor As _Unsigned Long, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y



    fillColor = Point(x0, y0)

    'PRINT fillColor

    W = _Width - 1: H = _Height - 1



    Dim temp(W, H)

    temp(x0, y0) = 1: parentF = 1

    PSet (x0, y0), MyFill



    Dim k&: k& = 0 ' madscijr



    While parentF = 1

        parentF = 0: tick = tick + 1

        ystart = GetMax(y0 - tick, 0): ystop = GetMin(y0 + tick, H)

        y = ystart

        While y <= ystop

            xstart = GetMax(x0 - tick, 0): xstop = GetMin(x0 + tick, W)

            x = xstart

            While x <= xstop

                If Point(x, y) = fillColor And temp(x, y) = 0 Then

                    If temp(GetMax(0, x - 1), y) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(GetMin(x + 1, W), y) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(x, GetMax(y - 1, 0)) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(x, GetMin(y + 1, H)) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    End If

                End If

                x = x + 1



                k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

            Wend

            If k& = 27 Then Exit While ' madscijr



            y = y + 1



            k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

        Wend

        If k& = 27 Then Exit While ' madscijr



        k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

    Wend

End Sub ' paint3



' /////////////////////////////////////////////////////////////////////////////



Function GetMin (n1, n2)

    If n1 > n2 Then GetMin = n2 Else GetMin = n1

End Function



' /////////////////////////////////////////////////////////////////////////////



Function GetMax (n1, n2)

    If n1 < n2 Then GetMax = n2 Else GetMax = n1

End Function



' ################################################################################################################################################################

' # END BPlus's fill code

' ################################################################################################################################################################



' ################################################################################################################################################################

' # BEGIN Steve's fill code

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' SMcNeill, Super Moderator

' 4/23/2025 8:55 PM



Sub FillSteve

    $Color:32

    Screen _NewImage(1280, 720, 32)

    _ScreenMove 0, 0



    Circle (640, 360), 350, Red

    Circle (800, 500), 100, Blue

    Paint (800, 500), Blue, Blue



    Locate 1, 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Print "Press any key to fill"

    Sleep ' so we can see that the blue circle is inside the red one.



    Fill 640, 360, Red, _FALSE 'fill all transparent pixels red



    Locate 1, 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Print "Press any key to exit"

    Sleep

End Sub ' FillSteve



' /////////////////////////////////////////////////////////////////////////////



Sub Fill (x, y, Kolor As _Unsigned Long, EnableBlend%)

    Dim As _Unsigned Long OC, BC

    OC = Point(x, y) 'original color



    If EnableBlend% = _TRUE Then

        ' blend is enabled

        If _Alpha32(Kolor) <> 255 Or _Alpha32(OC) <> 255 Then ' we're going to blend

            PSet (x, y), Kolor

            BC = Point(x, y) ' blended color

        End If

        BlendFiller x, y, Kolor, OC, BC

    Else

        Filler x, y, Kolor, OC

    End If

End Sub ' Fill



' /////////////////////////////////////////////////////////////////////////////

' Paintbucket fill (opaque)



Sub Filler (x, y, Kolor As _Unsigned Long, OC As _Unsigned Long)

    Dim l, r, i

    If Kolor = OC Then Exit Sub

    l = x: r = x 'find left/right to fill

    Do Until l = 0

        If Point(l - 1, y) = OC Then l = l - 1 Else Exit Do

    Loop 'find the left boundry

    Do Until r = _Width - 1

        If Point(r + 1, y) = OC Then r = r + 1 Else Exit Do

    Loop 'find the right boundry

    Line (l, y)-(r, y), Kolor, BF

    For i = l To r

        If Point(i, y + 1) = OC Then Filler i, y + 1, Kolor, OC

    Next

    For i = l To r

        If Point(i, y - 1) = OC Then Filler i, y - 1, Kolor, OC

    Next

End Sub ' Filler



' /////////////////////////////////////////////////////////////////////////////

' Paintbucket fill with blending colors w/alpha < 255



Sub BlendFiller (x, y, Kolor As _Unsigned Long, OC As _Unsigned Long, BC As _Unsigned Long)

    Dim l, r, i

    If Kolor = OC Or Kolor = BC Then Exit Sub

    l = x: r = x 'find left/right to fill

    Do Until l = 0

        If Point(l - 1, y) = BC Then Exit Do

        If Point(l - 1, y) = OC Then l = l - 1 Else Exit Do

    Loop 'find the left boundry

    Do Until r = _Width - 1

        If Point(r + 1, y) = BC Then Exit Do

        If Point(r + 1, y) = OC Then r = r + 1 Else Exit Do

    Loop 'find the right boundry

    Line (l, y)-(r, y), Kolor, BF

    For i = l To r

        If Point(i, y + 1) = BC Then _Continue

        If Point(i, y + 1) = OC Then BlendFiller i, y + 1, Kolor, OC, BC

    Next

    For i = l To r

        If Point(i, y - 1) = BC Then _Continue

        If Point(i, y - 1) = OC Or Point(l - 1, y) = BC Then BlendFiller i, y - 1, Kolor, OC, BC

    Next

End Sub ' BlendFiller



' ################################################################################################################################################################

' # END Steve's fill code

' ################################################################################################################################################################



' ################################################################################################################################################################

' # BEGIN Petr's fill code

' ################################################################################################################################################################



' /////////////////////////////////////////////////////////////////////////////

' Petr, Mini-Mod

' 4/24/2025 9:42 AM

' https://qb64phoenix.com/forum/showthread.php?tid=1507



Sub Paint2 (x, y, c~&)

    Dim W

    Dim H

    Dim Virtual As Long

    Dim position&

    Dim Clr2~&

    Dim D&

    Dim CLR~&



    W = _Width: H = _Height

    Virtual = _NewImage(W, H, 32)



    Dim m As _MEM, n As _MEM, Bck As _Unsigned Long



    m = _MemImage(_Source)

    n = _MemImage(Virtual)



    'create mask (2 color image)

    position& = (y * W + x) * 4



    _MemGet m, m.OFFSET + position&, Bck



    Clr2~& = _RGB32(_Red32(Bck) - 1, _Green32(Bck) - 1, _Blue32(Bck) - 1, _Alpha32(Bck) - 1)



    D& = 0



    Do Until D& = n.SIZE

        CLR~& = _MemGet(m, m.OFFSET + D&, _Unsigned Long)

        If CLR~& = Bck~& Then _MemPut n, n.OFFSET + D&, CLR~& Else _MemPut n, n.OFFSET + D&, Clr2~&

        D& = D& + 4

    Loop



    D& = _Dest



    _Dest Virtual

    Paint (x, y), c~&, Clr2~&

    _Dest D&

    _ClearColor Clr2~&, Virtual

    _PutImage , Virtual, D&



    _MemFree m

    _MemFree n

    _FreeImage Virtual

End Sub ' Paint2

' ################################################################################################################################################################

' # END Petr's fill code

' ################################################################################################################################################################

Code: (Select All)

' Paint vs Fill speed comparison

' https://qb64phoenix.com/forum/showthread.php?tid=3631&pid=33725#pid33725

Screen _NewImage(800, 800, 32)

Cls , _RGB32(0, 0, 0)

Circle (400, 400), 400, _RGB32(255, 255, 255) 'white circle

TestNum% = 0

TextCols% = (_Width / _FontWidth) - 1

NumTests% = 6

TestNum% = TestNum% + 1

t0# = Timer

For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Paint)                   "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Paint (400, 400), _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), _RGB32(255, 255, 255)

Next i

TestNum% = TestNum% + 1

t1# = Timer

For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Fill EnableBlend%=_FALSE)"

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Fill 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), _FALSE

Next i

TestNum% = TestNum% + 1

t2# = Timer

For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Fill EnableBlend%=_TRUE) "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Fill 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), _TRUE

Next i

TestNum% = TestNum% + 1

t3# = Timer

For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Paint2)                  "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    Paint2 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)

Next i

TestNum% = TestNum% + 1

t4# = Timer

' only test 1x, or else we'll be here all day!

For i = 1 To 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (Paint3)                  "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 1    "

    paint3 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)

Next i

TestNum% = TestNum% + 1

t5# = Timer

ReDim arrColor(0 To 0) As _Unsigned Long

AddColor _RGB32(0, 0, 0), arrColor()

AddColor _RGB32(255, 255, 255), arrColor()

For i = 1 To 100

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Locate 1, 1: Print "Test " + _ToStr$(TestNum%) + " of " + _ToStr$(NumTests%) + " (PaintMask)               "

    Locate 2, 1: Print "Fill " + Right$("   " + _ToStr$(i), 3) + " of 100  "

    PaintMask 400, 400, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), arrColor()

Next i

t6# = Timer

Locate 1, 1: Print Left$("Test complete" + String$(TextCols%, " "), TextCols%)

Locate 2, 1: Print Left$("Results for 100 fills:" + String$(TextCols%, " "), TextCols%)

Color _RGB32(255, 255, 255), _RGB32(0, 0, 255)

Locate 3, 2: Print Using "###.### seconds Paint                   "; t1# - t0#

Locate 4, 2: Print Using "###.### seconds Fill EnableBlend%=_FALSE "; t2# - t1#

Locate 5, 2: Print Using "###.### seconds Fill EnableBlend%=_TRUE  "; t3# - t2#

Locate 6, 2: Print Using "###.### seconds Paint2                  "; t4# - t3#

Locate 7, 2: Print Using "###.### seconds Paint3                  "; (t5# - t4#) * 100

Locate 8, 2: Print Using "###.### seconds PaintMask               "; t6# - t5#

' ################################################################################################################################################################

' # BEGIN madscijr's fill code

' ################################################################################################################################################################

' /////////////////////////////////////////////////////////////////////////////

' Does a paintbucket fill with paint

' using _CLEARCOLOR to protect unwanted colors

' from being painted over.

' Receives arrIgnoreColors() an array of "protected" colors

' which are removed from temp image with _CLEARCOLOR,

' First we look at point x0, y0 to get the target color,

' then _CLEARCOLOR all the colors in arrIgnoreColors()

' then _PUTIMAGE to a temp image, paint does fill on that,

' then _PUTIMAGE that back to the original.

' * v2 eliminates a temp image we didn't need.

' Prequisites:

' _SOURCE & _DEST must be set to the target image.

' -----------------------------------------------------------------------------

' NOTES:

' The _CLEARCOLOR statement sets a specific color to be treated as

' transparent when an image is later put (via _PUTIMAGE) onto another image.

' Syntax: _CLEARCOLOR {color&|_NONE}[, Dest_Handle&]

' The _SETALPHA statement sets the alpha channel transparency level of some

' or all of the pixels of an image.

' Syntax: _SETALPHA alpha&[, color1&][ TO colour2&] [, imageHandle&]

' -----------------------------------------------------------------------------

' Example usage:

' ReDim arrIgnoreColors(0 To 0) As _Unsigned Long ' array of colors

' AddColor ColorValue&, arrIgnoreColors()

' PaintMask x0, y0, FillColor~&, arrIgnoreColors()

Sub PaintMask (x0, y0, FillColor~&, arrIgnoreColors() As _Unsigned Long)

    Dim imgSource&

    Dim imgFill&

    Dim index%

    Dim bgColor~&

    ' Reference original image

    imgSource& = _Dest

    ' Get target color

    bgColor~& = Point(x0, y0)

    If bgColor~& <> FillColor~& Then

        ' Clear any colors not the target color or fill color

        For index% = LBound(arrIgnoreColors) To UBound(arrIgnoreColors)

            If arrIgnoreColors(index%) <> FillColor~& Then

                If arrIgnoreColors(index%) <> bgColor~& Then

                    _ClearColor arrIgnoreColors(index%), imgSource&

                End If

            End If

        Next index%

        ' Create fill target

        InitImage imgFill&, _Width(imgSource&), _Height(imgSource&), _RGB32(0, 0, 0, 0)

        '_PUTIMAGE , sourceHandle&, destHandle& 'size full source to fit full destination area

        _PutImage , imgSource&, imgFill&

        ' Fill in fill target

        _Dest imgFill&

        'PAINT [STEP] (column%, row%), fillColor[, borderColor%]

        Paint (x0, y0), FillColor~&, _RGB32(0, 0, 0, 0)

        ' Copy fill target onto main image

        '_PUTIMAGE , sourceHandle&, destHandle& 'size full source to fit full destination area

        _PutImage , imgFill&, imgSource& 'size full source to fit full destination area

        ' Point back at main image

        _Source imgSource&

        _Dest imgSource&

        ' Undo _CLEARCOLOR

        _ClearColor _None, imgSource&

        '_ClearColor _RGB32(0, 0, 0, 0), imgSource& ' re-add the color we use for transparent?

        ' Cleanup

        FreeImage imgFill&

    End If

End Sub ' PaintMask



' ################################################################################################################################################################

' # END madscijr's fill code

' ################################################################################################################################################################



' ################################################################################################################################################################

' # BEGIN BPlus's fill code

' ################################################################################################################################################################

' /////////////////////////////////////////////////////////////////////////////

' From: bplus, Mini-Mod

' 4/23/2025 8:53 PM

' I have a different kind of paint, Paint3 that fills the color

' it lands on to do the painting, any other color stops the

' paint like a border

' madscijr added check for Esc key to cancel

Sub paint3 (x0, y0, MyFill As _Unsigned Long) ' needs GetMax, GetMin functions

    Dim fillColor As _Unsigned Long, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y

    fillColor = Point(x0, y0)

    'PRINT fillColor

    W = _Width - 1: H = _Height - 1

    Dim temp(W, H)

    temp(x0, y0) = 1: parentF = 1

    PSet (x0, y0), MyFill

    Dim k&: k& = 0 ' madscijr

    While parentF = 1

        parentF = 0: tick = tick + 1

        ystart = GetMax(y0 - tick, 0): ystop = GetMin(y0 + tick, H)

        y = ystart

        While y <= ystop

            xstart = GetMax(x0 - tick, 0): xstop = GetMin(x0 + tick, W)

            x = xstart

            While x <= xstop

                If Point(x, y) = fillColor And temp(x, y) = 0 Then

                    If temp(GetMax(0, x - 1), y) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(GetMin(x + 1, W), y) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(x, GetMax(y - 1, 0)) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    ElseIf temp(x, GetMin(y + 1, H)) Then

                        temp(x, y) = 1: parentF = 1: PSet (x, y), MyFill

                    End If

                End If

                x = x + 1

                k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

            Wend

            If k& = 27 Then Exit While ' madscijr

            y = y + 1

            k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

        Wend

        If k& = 27 Then Exit While ' madscijr

        k& = _KeyHit: If k& = 27 Then Exit While ' madscijr

    Wend

End Sub ' paint3

' /////////////////////////////////////////////////////////////////////////////

Function GetMin (n1, n2)

    If n1 > n2 Then GetMin = n2 Else GetMin = n1

End Function

' /////////////////////////////////////////////////////////////////////////////

Function GetMax (n1, n2)

    If n1 < n2 Then GetMax = n2 Else GetMax = n1

End Function

' ################################################################################################################################################################

' # END BPlus's fill code

' ################################################################################################################################################################

' ################################################################################################################################################################

' # BEGIN Steve's fill code

' ################################################################################################################################################################

' /////////////////////////////////////////////////////////////////////////////

' SMcNeill, Super Moderator

' 4/23/2025 8:55 PM

Sub FillSteve

    $Color:32

    Screen _NewImage(1280, 720, 32)

    _ScreenMove 0, 0

    Circle (640, 360), 350, Red

    Circle (800, 500), 100, Blue

    Paint (800, 500), Blue, Blue

    Locate 1, 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Print "Press any key to fill"

    Sleep ' so we can see that the blue circle is inside the red one.

    Fill 640, 360, Red, _FALSE 'fill all transparent pixels red

    Locate 1, 1

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Print "Press any key to exit"

    Sleep

End Sub ' FillSteve

' /////////////////////////////////////////////////////////////////////////////

Sub Fill (x, y, Kolor As _Unsigned Long, EnableBlend%)

    Dim As _Unsigned Long OC, BC

    OC = Point(x, y) 'original color

    If EnableBlend% = _TRUE Then

        ' blend is enabled

        If _Alpha32(Kolor) <> 255 Or _Alpha32(OC) <> 255 Then ' we're going to blend

            PSet (x, y), Kolor

            BC = Point(x, y) ' blended color

        End If

        BlendFiller x, y, Kolor, OC, BC

    Else

        Filler x, y, Kolor, OC

    End If

End Sub ' Fill

' /////////////////////////////////////////////////////////////////////////////

' Paintbucket fill (opaque)

Sub Filler (x, y, Kolor As _Unsigned Long, OC As _Unsigned Long)

    Dim l, r, i

    If Kolor = OC Then Exit Sub

    l = x: r = x 'find left/right to fill

    Do Until l = 0

        If Point(l - 1, y) = OC Then l = l - 1 Else Exit Do

    Loop 'find the left boundry

    Do Until r = _Width - 1

        If Point(r + 1, y) = OC Then r = r + 1 Else Exit Do

    Loop 'find the right boundry

    Line (l, y)-(r, y), Kolor, BF

    For i = l To r

        If Point(i, y + 1) = OC Then Filler i, y + 1, Kolor, OC

    Next

    For i = l To r

        If Point(i, y - 1) = OC Then Filler i, y - 1, Kolor, OC

    Next

End Sub ' Filler

' /////////////////////////////////////////////////////////////////////////////

' Paintbucket fill with blending colors w/alpha < 255

Sub BlendFiller (x, y, Kolor As _Unsigned Long, OC As _Unsigned Long, BC As _Unsigned Long)

    Dim l, r, i

    If Kolor = OC Or Kolor = BC Then Exit Sub

    l = x: r = x 'find left/right to fill

    Do Until l = 0

        If Point(l - 1, y) = BC Then Exit Do

        If Point(l - 1, y) = OC Then l = l - 1 Else Exit Do

    Loop 'find the left boundry

    Do Until r = _Width - 1

        If Point(r + 1, y) = BC Then Exit Do

        If Point(r + 1, y) = OC Then r = r + 1 Else Exit Do

    Loop 'find the right boundry

    Line (l, y)-(r, y), Kolor, BF

    For i = l To r

        If Point(i, y + 1) = BC Then _Continue

        If Point(i, y + 1) = OC Then BlendFiller i, y + 1, Kolor, OC, BC

    Next

    For i = l To r

        If Point(i, y - 1) = BC Then _Continue

        If Point(i, y - 1) = OC Or Point(l - 1, y) = BC Then BlendFiller i, y - 1, Kolor, OC, BC

    Next

End Sub ' BlendFiller

' ################################################################################################################################################################

' # END Steve's fill code

' ################################################################################################################################################################

' ################################################################################################################################################################

' # BEGIN Petr's fill code

' ################################################################################################################################################################

' /////////////////////////////////////////////////////////////////////////////

' Petr, Mini-Mod

' 4/24/2025 9:42 AM

' https://qb64phoenix.com/forum/showthread.php?tid=1507

Sub Paint2 (x, y, c~&)

    Dim W

    Dim H

    Dim Virtual As Long

    Dim position&

    Dim Clr2~&

    Dim D&

    Dim CLR~&

    W = _Width: H = _Height

    Virtual = _NewImage(W, H, 32)

    Dim m As _MEM, n As _MEM, Bck As _Unsigned Long

    m = _MemImage(_Source)

    n = _MemImage(Virtual)

    'create mask (2 color image)

    position& = (y * W + x) * 4

    _MemGet m, m.OFFSET + position&, Bck

    Clr2~& = _RGB32(_Red32(Bck) - 1, _Green32(Bck) - 1, _Blue32(Bck) - 1, _Alpha32(Bck) - 1)

    D& = 0

    Do Until D& = n.SIZE

        CLR~& = _MemGet(m, m.OFFSET + D&, _Unsigned Long)

        If CLR~& = Bck~& Then _MemPut n, n.OFFSET + D&, CLR~& Else _MemPut n, n.OFFSET + D&, Clr2~&

        D& = D& + 4

    Loop

    D& = _Dest

    _Dest Virtual

    Paint (x, y), c~&, Clr2~&

    _Dest D&

    _ClearColor Clr2~&, Virtual

    _PutImage , Virtual, D&

    _MemFree m

    _MemFree n

    _FreeImage Virtual

End Sub ' Paint2

' ################################################################################################################################################################

' # END Petr's fill code

' ################################################################################################################################################################

' ################################################################################################################################################################

' BEGIN UTILITY FUNCTIONS

' ################################################################################################################################################################

' /////////////////////////////////////////////////////////////////////////////

' Append color ColorValue to array arrColor

Sub AddColor (ColorValue As _Unsigned Long, arrColor() As _Unsigned Long)

    ReDim _Preserve arrColor(0 To UBound(arrColor) + 1) As _Unsigned Long

    arrColor(UBound(arrColor)) = ColorValue

End Sub ' AddColor

' /////////////////////////////////////////////////////////////////////////////

' Frees image if it exists

' and makes sure it isn't the current screen and _DEST

'FreeImage img

Sub FreeImage (ThisImage&)

    If ThisImage& < -1 Or ThisImage& > 0 Then

        If _ScreenImage = ThisImage& Then Screen 0

        If _Dest = ThisImage& Then _Dest 0

        _FreeImage ThisImage&

    End If

End Sub ' FreeImage

' /////////////////////////////////////////////////////////////////////////////

' Initializes an image

' (if it already exists, frees it up and re-instantiates)

'InitImage img, iWidth, iHeight, bgColor

Sub InitImage (ThisImage&, iWidth&, iHeight&, bgColor~&)

    FreeImage ThisImage&

    ThisImage& = _NewImage(iWidth&, iHeight&, 32)

    _Dest ThisImage&: Cls , bgColor~&

End Sub ' InitImage

' ################################################################################################################################################################

' END UTILITY FUNCTIONS

' ################################################################################################################################################################