Paint 2 (for coloring)

[Petr]

As you know, if you need to color an object, for example a rectangle, but it have its borders not colored with the same color, you cannot use the Paint statement because the color will spread everywhere. This version solves this and with this program you can color solids even though they have different colored borders. This problem is solved using mask image, this version is just for 32 bit images.

Code: (Select All)

Screen _NewImage(1024, 768, 32)
$Color:32
Do
    Cls , Red
    For c = 1 To 40
        Circle (Rnd * 980, Rnd * 740), Rnd * 100 + 10, _RGB32(25 * Rnd, 75 * Rnd, 127 * Rnd)
        X = Rnd * 1024
        Y = Rnd * 768
        Lwidth = Rnd * 100
        Lheight = Rnd * 100
        Line (X, Y)-(X + Lwidth, Y + Lheight), _RGB32(55 * Rnd, 145 * Rnd, 255 * Rnd), BF
    Next
    _Delay .1
    _MouseMove 512, 384

    Do Until K& = 27
        K& = _KeyHit
        While _MouseInput: Wend
        If _MouseButton(1) Then Paint2 _MouseX, _MouseY, DarkBlue
    Loop
    K& = 0
Loop

Sub Paint2 (x, y, c~&)
    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)
    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

[bplus]

Yep! That's a nice one for my tool box, thanks!