Erasing (or making a section of an image transparent) based on a mask from image #2?

Code: (Select All)
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

Dim in$

Do

    Screen 0: _AutoDisplay

    Cls

    Print "1. Steve_1 <- COPIES RECTANGLE BUT NOT MASK PATTERN?"

    Print "2. Petr_1 <- MOVES BOX BUT NOTHING ELSE? AFTER EXITING STUCK IN LORES MODE?"

    Print "3. Steffan68_1 <- CAN DRAW LINES BUT NOTHING HAPPENS & CAN'T EXIT? "

    Input "Your choice (Q to quit)"; in$

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

    Select Case in$

        Case "1": Steve_1

        Case "2": Petr_1

        Case "3": Steffan68_1

        Case "Q": Exit Do

    End Select

Loop

End



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

' I tried using Steve's pixel-by-pixel method here, but not working...



' based on:

' Reply #2 from SMcNeill, Yesterday, 08:11 PM (This post was last modified: Yesterday, 08:14 PM by SMcNeill.)

' https://qb64phoenix.com/forum/showthread.php?tid=3612&pid=33505#pid33505

'

' Easiest way here is just to write a loop:

' If the point in the 2nd image isn't blank

' (0, or whatever your background color might be on that image),

' then make that point blank on the first image.

' Same way for a tolerance level.

' Just change that <> 0 to the color you want, or the color range you want.

' IF POINT(x,y) >= _RGBA32(100,100,100,0) _ANDALSO POINT(x,y) <= _RGBA32(100,100,100,255)....



Sub Steve_1

    Dim sBgFile$

    Dim imgSrc&

    Dim imgDst&

    Dim imgMsk&

    Dim x1, y1 As Integer ' start point to copy from imgSrc&

    Dim x2, y2 As Integer ' end point to copy from imgSrc&

    Dim dx, dy As Integer ' point on imgDst& where portion of imgSrc& will be copied

    Dim tx, ty As Integer ' point on screen to show imgDst&

    Dim sx, sy As Integer ' for loop

    Dim cx, cy As Integer ' calculated

    Dim iSize As Integer

    Dim NextColor~&



    Randomize Timer



    ' INIT SCREEN

    Screen _NewImage(800, 600, 32)

    _ScreenMove 0, 0: _Dest 0: Cls , cBlue



    ' INIT SOURCE IMAGE

    ' horizontal green on red lines

    imgSrc& = _NewImage(800, 600, 32)

    _Dest imgSrc&: Cls , cRed

    For cy = 1 To 600 Step 10

        'DrawRectSolid iX, iY, iSizeW, iSizeH, fgColor

        DrawRectSolid 1, cy, 800, 5, cLime

    Next cy



    ' INIT MASK IMAGE

    ' "swiss cheese"

    imgMsk& = _NewImage(800, 600, 32)

    _Dest imgMsk&: Cls , cEmpty

    For cy = 1 To 600 Step 25

        For cx = 1 To 800 Step 25

            ' place random size swiss cheese hole semi-randomly

            iSize = RandomNumber%(3, 15)

            dx = RandomNumber%(0, 5) - 3

            dy = RandomNumber%(0, 5) - 3

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

            DrawCircle 0, cx + dx, cy + dy, iSize, iSize, cBlack, cBlack

        Next cx

    Next cy



    ' INIT DEST IMAGE

    ' vertical magenta on cyan stripes

    imgDst& = _NewImage(100, 300, 32)

    _Dest imgDst&: Cls , cCyan

    For cx = 1 To 100 Step 5

        'DrawRectSolid iX, iY, iSizeW, iSizeH, fgColor

        DrawRectSolid cx, 1, 4, 300, cMagenta

    Next cx



    ' COPY SOURCE TO DEST USING MASK

    dx = 25: dy = 50

    x1 = 300: x2 = 350: y1 = 200: y2 = 400



    '_DontBlend ' so 0 will change and update the image rather than blend to nothing



    For sx = x1 To x2

        For sy = y1 To y2

            ' CHECK IF PIXEL LOCATION IN MASK IS BLACK

            _Source imgMsk&

            'If Point(sx, sy) <> cEmpty Then

            If Point(sx, sy) = cBlack Then

                ' COPY PIXEL FROM THIS LOCATION FROM SOURCE

                _Source imgSrc&

                NextColor~& = Point(sx, sy)



                ' WRITE THE PIXEL TO RELATIVE LOCATION IN DEST

                _Dest imgDst&

                cx = dx + (sx - x1)

                cy = dy + (sy - y1)

                PSet (cx, cy), NextColor~&

            End If

        Next sy

    Next sx



    ' COPY DEST TO SCREEN

    _Dest 0

    tx = 100: ty = 250

    '_PUTIMAGE (dx1, dy1)-(dx2, dy2), sourceHandle&, destHandle&,(sx1, sy1)

    _PutImage (tx, ty), imgDst&



    ' WAIT FOR USER

    PressAnyKey



    ' CLEAN UP

    If imgMak& < -1 Or imgMak& > 0 Then _FreeImage imgMak&

    If imgSrc& < -1 Or imgSrc& > 0 Then _FreeImage imgSrc&

    If imgDst& < -1 Or imgDst& > 0 Then _FreeImage imgDst&

End Sub ' Steve_1



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

' Reply #4 from Steffan-68, 7 hours ago

' https://qb64phoenix.com/forum/showthread.php?tid=3612&pid=33514#pid33514

'

' (Yesterday, 09:15 PM) madscijr Wrote:

' >That's straightforward, pixel by pixel, but is it fast?

' >Guess I'll run some code and find out! Thanks!

' I don't know who is more, but maybe it is something you want?



' copy/paste polygon image

' use mouse for inserting image



Sub Steffan68_1

    Image& = _ScreenImage

    _Delay .5



    Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)

    '_FullScreen

    Cls



    Type Points

        As Integer x, y

    End Type



    Type LinePoints

        X As Integer

        Y As Integer

    End Type



    ReDim LP(0) As LinePoints

    ReDim nP(0) As Points

    ReDim P(20000) As Points



    Do

        _PutImage , Image& 'place complete image to screen



        Locate 1

        Print "Use mouse, press left button and select any image area"



        While _MouseInput

        Wend

        MX = _MouseX

        MY = _MouseY

        LB = _MouseButton(1)



        Print LB, MX, MY, j, max



        If LB = -1 Then

            'insert coordinate to array if is left mouse button pressed

            If oMX <> MX Or oMY <> MY Then 'if is mouse moved to other position

                P(j).x = MX '               add new coordinates to array P

                P(j).y = MY

                oMX = MX '                  and memorize old coordinates

                oMY = MY

                j = j + 1

                max = 0

                i = UBound(P)

                If j = i Then '             if array P is full, add next 20000 records

                    ReDim _Preserve P(i + 20000) As Points

                    max = 0

                End If

            End If

        End If



        'draw selected area: find used indexes

        If max = 0 Then 'lock for search maximum once if now record is not added

            max = UBound(P)

            Do Until P(max).x > 0 Or P(max).y > 0

                If max > 0 Then max = max - 1 Else Exit Do

            Loop

        End If



        If max Then

            PReset (P(0).x, P(0).y)

            For D = 1 To max

                Line -(P(D).x, P(D).y)

            Next

        End If



        'control if area is completed

        If max > 10 Then

            If Abs(P(max).x - P(0).x) < 5 And Abs(P(max).y - P(0).y) < 5 Then

                Print "select complete!"



                'find maximal/minimal X and Y

                c = 0

                minX = _Width

                minY = _Height

                Do Until c = max

                    If minX > P(c).x Then minX = P(c).x

                    If maxX < P(c).x Then maxX = P(c).x

                    If minY > P(c).y Then minY = P(c).y

                    If maxY < P(c).y Then maxY = P(c).y

                    c = c + 1

                Loop



                'create alpha mask for image

                Mask& = _NewImage(maxX - minX + 20, maxY - minY + 20, 32)

                _Dest Mask&

                Cls , _RGB32(255)

                'here next rows is my new acces to this:

                ' 1) calculate all points in image border and write it to array nP



                For FillnP = 0 To max - 1

                    ReDim LP(0) As LinePoints

                    GETPOINTS P(FillnP).x, P(FillnP).y, P(FillnP + 1).x, P(FillnP + 1).y, LP()

                    UnP = UBound(nP)

                    ReDim _Preserve nP(UnP + UBound(LP)) As Points

                    For Fnp = 0 To UBound(LP) 'calculate all new points to field nP

                        nP(UnP + Fnp).x = LP(Fnp).X

                        nP(UnP + Fnp).y = LP(Fnp).Y

                    Next

                Next



                ReDim LP(0) As LinePoints

                GETPOINTS P(0).x, P(0).y, P(max).x, P(max).y, LP()

                UnP = UBound(nP)

                ReDim _Preserve nP(UnP + UBound(LP)) As Points

                For Fnp = 0 To UBound(LP) 'write all new points to field nP

                    nP(UnP + Fnp).x = LP(Fnp).X

                    nP(UnP + Fnp).y = LP(Fnp).Y

                Next



                '2) recalculate points on selected image border to mask image size

                For recal = 0 To UBound(nP)

                    nP(recal).x = -minX + nP(recal).x

                    nP(recal).y = -minY + nP(recal).y

                Next recal



                '3) now use LINE statement and make LINE from minX to selected image border on left

                '  and from selected image border on right to maxX



                '  3.1 draw selected image border

                '_AutoDisplay

                '_Dest 0

                'Cls

                '  Print UBound(nP)

                '  Sleep



                'Screen Mask&



                For LineDraw = 0 To UBound(nP)

                    PSet (10 + nP(LineDraw).x, 10 + nP(LineDraw).y), _RGB32(254)

                Next

                Paint (_Width(Mask&) - 1, 0), _RGB32(0), _RGB32(254)



                'Sleep



                'here is done mask: Black color - was is not selected,  White color - was is selected



                _SetAlpha 0, _RGB32(255), Mask&

                _SetAlpha 0, _RGB32(254), Mask&



                'create done image + mask: Step 1 - apply full image

                '                          Step 2 - apply mask:



                doneImage& = _NewImage(maxX - minX, maxY - minY, 32)

                'step 1

                _PutImage (0, 0), Image&, doneImage&, (minX, minY)-(maxX, maxY)

                'step 2

                _PutImage (-10, -10), Mask&, doneImage&



                'erase ram

                '_FreeImage Mask&

                '_FreeImage Image&

                If Mask& < -1 Or Mask& > 0 Then _FreeImage Mask&

                If Image& < -1 Or Image& > 0 Then _FreeImage Image&



                'return to my screen

                _Dest 0

                _Source 0



                'view output

                Cls

                _PutImage (0, 0), doneImage&

                _Display



                PressAnyKey

                'Sleep

                '_FreeImage doneImage&

                'End



            End If

        End If



        _Limit 30

        _Display

    Loop



    If doneImage& < -1 Or doneImage& > 0 Then _FreeImage doneImage&

    If Image& < -1 Or Image& > 0 Then _FreeImage Image&

End Sub ' Steffan68_1



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



Sub PressAnyKey

    Dim M$: Dim ty%, tx%, mx%, my%

    M$ = "PRESS ANY KEY TO CONTINUE"

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

    ty% = (_Height(0) / _FontHeight) - 1 ' how many text lines will fit

    tx% = (_Width(0) / _FontWidth) - 1 ' how many text columns will fit

    mx% = (tx% / 2) - (Len(M$) / 2): my% = (ty% / 2)

    Locate my%, mx%: Print "PRESS ANY KEY TO CONTINUE"

    _AutoDisplay

    Sleep

    _KeyClear ' CLEAR KEYBOARD BUFFER

End Sub ' PressAnyKey



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



Sub GETPOINTS (x1, y1, x2, y2, A() As LinePoints)

    Dim lenght As Integer

    lenght = _Hypot(x1 - x2, y1 - y2) 'Fellippe Heitor show me using this great function.

    ReDim A(lenght) As LinePoints

    For fill = 0 To lenght

        If x1 > x2 Then A(fill).X = x1 - fill * ((x1 - x2) / lenght)

        If x1 < x2 Then A(fill).X = x1 + fill * ((x2 - x1) / lenght)

        If x1 = x2 Then A(fill).X = x1

        If y1 > y2 Then A(fill).Y = y1 - fill * ((y1 - y2) / lenght)

        If y1 < y2 Then A(fill).Y = y1 + fill * ((y2 - y1) / lenght)

        If y1 = y2 Then A(fill).Y = y1

    Next

End Sub ' GETPOINTS



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

' Reply #6 from Petr, 15 minutes ago (This post was last modified: 8 minutes ago by Petr.)

' https://qb64phoenix.com/forum/showthread.php?tid=3612&pid=33519#pid33519

' If I understand correctly, you have two images.

' One with a mask, the other full.

' According to the mask you want to set the transparent area.

' In that case the solution with point is absolutely bad and slow.

' What you are looking for is _ClearColor, or _SetAlpha.

' I think this with a rectangle is a simple and clear example:



Sub Petr_1

    MyScreen = _ScreenImage

    Mask = _NewImage(100, 100, 32) ' background is transparent

    _Dest Mask

    Cls , _RGB32(255, 255, 0) ' background is now not transparent, is yellow in Mask image

    Color _RGB32(255) ' set color for foreground

    Line (10, 10)-(90, 90), _RGB32(255), BF ' create white rectangle

    _ClearColor _RGB32(255), Mask ' create white color _RGB32(255, 255, 255) transparent

    _Dest 0

    Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)

    _FullScreen



    Do Until InKey$ <> ""

        While _MouseInput: Wend

        Mx = _MouseX

        My = _MouseY



        _PutImage , MyScreen ' put background

        _PutImage (Mx, My), Mask, 0 ' put image contains transparent mask (white rectangle in Mask image)

        _Display

        _Limit 20

    Loop



    PressAnyKey



    If MyScreen < -1 Or MyScreen > 0 Then _FreeImage MyScreen

    If Mask < -1 Or Mask > 0 Then _FreeImage Mask



    '_FreeImage MyScreen

    '_FreeImage Mask

    'End

End Sub ' Petr_1



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

' BROKEN VERSION!



Sub Steve_1b

    Dim sBgFile$

    Dim imgSrc&

    Dim imgMask&

    Dim x1, y1 As Integer ' start point to copy from imgSrc&

    Dim x2, y2 As Integer ' end point to copy from imgSrc&

    Dim dx, dy As Integer ' point on imgDst& where portion of imgSrc& will be copied

    Dim tx, ty As Integer ' point on screen to show imgDst&

    Dim sx, sy As Integer ' for loop

    Dim cx, cy As Integer ' calculated

    Dim NextColor~&



    Screen _NewImage(800, 600, 32)

    _ScreenMove 0, 0: _Dest 0: Cls , cBlack



    '_PutImage , bgImage&, 0 ' Add the background

    'imgSrc& = _ScreenImage: x1 = 300: x2 = 350: y1 = 200: y2 = 400



    sBgFile$ = "erase-mask-image.png"

    imgSrc& = _LoadImage(m_ProgramPath$ + sBgFile$, 32)



    imgMask& = _NewImage(100, 300, 32): dx = 25: dy = 50

    _Dest imgMask&: Cls , cRed





    'DrawRectSolid iX, iY, iSizeW, iSizeH, fgColor

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







    _Source imgSrc&

    _Dest 0

    _DontBlend ' so 0 will change and update the image rather than blend to nothing

    'For sx = 0 To _Width(imgSrc&)

    For sx = x1 To x2

        'For sy = 0 To _Height(imgSrc&)

        For sy = y1 To y2

            cx = dx + (sx - x1)

            cy = dy + (sy - y1)



            ' *****************************************************************************

            ' *** BEGIN DEBUG

            If _TRUE = _FALSE Then

                _Dest 0

            print _

                "sx=" + _TRIM$(str$(sx)) + ", " + _

                "sy=" + _TRIM$(str$(sy)) + ", " + _

                "dx=" + _TRIM$(str$(dx)) + ", " + _

                "dy=" + _TRIM$(str$(dy)) + ", " + _

                "x1=" + _TRIM$(str$(x1)) + ", " + _

                "y1=" + _TRIM$(str$(y1)) + ", "

            print _

                "cx = dx + (sx - x1) = " + _

                _TRIM$(str$(dx)) + " + (" + _TRIM$(str$(sx)) + " - " + _TRIM$(str$(x1)) + ") = " + _

                _TRIM$(str$(cx))

            print "cy = dy + (sy - y1) = " + _

                _TRIM$(str$(dy)) + " + (" + _TRIM$(str$(sy)) + " - " + _TRIM$(str$(y1)) + ") = " + _

                _TRIM$(str$(cy)) + _

                ""

                _Dest imgDst&

                _DontBlend ' so 0 will change and update the image rather than blend to nothing

            End If

            ' *** END DEBUG

            ' *****************************************************************************



            _Source imgMask&

            If Point(sx, sy) <> 0 Then

                _Source imgSrc&

                NextColor~& = Point(sx, sy)



                _Dest 0

                PSet (cx, cy), NextColor~&



                'PSet (cx, cy), 0 ' make transparent

            End If

        Next sy

    Next sx



    _Dest 0

    '_PUTIMAGE (dx1, dy1)-(dx2, dy2), sourceHandle&, destHandle&,(sx1, sy1)

    _PutImage (tx, ty), imgDst&, 0



    PressAnyKey



    If bgImage& < -1 Or bgImage& > 0 Then _FreeImage bgImage&

    If imgSrc& < -1 Or imgSrc& > 0 Then _FreeImage imgSrc&

    If imgDst& < -1 Or imgDst& > 0 Then _FreeImage imgDst&

End Sub ' Steve_1b



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

' Reply #7

' From: Petr, 10 minutes ago

' In my thread, there is a program called Paint2 that uses this

' property to color various shapes regardless of the color of

' the edges, thus bypassing the limitations of the Paint command.

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

' and is based on masking.



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

' 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



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

' 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



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

' Generate random value between Min and Max inclusive.

' Note: random-number generator should be initialized with 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%



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

' Some functions



Function cBlack~& ()

    cBlack = _RGB32(0, 0, 0)

End Function ' cBlack~&



Function cGray~& ()

    cGray = _RGB32(128, 128, 128)

End Function ' cGray~&



Function cLightGray~& ()

    cLightGray = _RGB32(211, 211, 211)

End Function ' cLightGray~&



Function cWhite~& ()

    cWhite = _RGB32(255, 255, 255)

End Function ' cWhite~&



Function cRed~& ()

    cRed = _RGB32(255, 0, 0)

End Function ' cRed~&



Function cMagenta~& ()

    cMagenta = _RGB32(255, 0, 255)

End Function ' cMagenta~&



Function cBlue~& ()

    cBlue = _RGB32(0, 0, 255)

End Function ' cBlue~&



Function cCyan~& ()

    cCyan = _RGB32(0, 255, 255)

End Function ' cCyan~&



Function cLime~& ()

    cLime = _RGB32(0, 255, 0)

End Function ' cLime~&



Function cYellow~& ()

    cYellow = _RGB32(255, 255, 0)

End Function ' cYellow~&



Function cOrange~& ()

    cOrange = _RGB32(255, 165, 0)

End Function ' cOrange~&



Function cEmpty~& ()

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

End Function ' cEmpty~&