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

[madscijr]

Hmmm.... none of these examples are working. 

I think I found the problem -  it seems _BLEND isn't working on my PC? 

I went to the _DONTBLEND wiki page and tried the example, and the text disappears leaving only the yellow box whether I comment out "_DontBlend" (line 7) or not: 

Code: (Select All)

'From: https://qb64phoenix.com/qb64wiki/index.php/DONTBLEND
'Example 1: Use _DONTBLEND when you want the 32 bit screen surface
'to be opaque so that it covers up other backgrounds. CLS works too.

Screen _NewImage(1280, 720, 32)
'CLS
_DontBlend '<<< comment out to see the difference

Line (100, 100)-(500, 500), _RGB32(255, 255, 0), BF

b& = SaveBackground&

Print "This is just test junk"
Print
Print "Hit any key and the text should disappear, leaving us our pretty yellow box."
Sleep
RestoreBackground b&

End

Function SaveBackground&
    SaveBackground& = _CopyImage(0)
End Function

Sub RestoreBackground (Image As Long)
    _PutImage , Image, 0
End Sub

Here is another test I tried, again the text disappears for both _BLEND and _DONTBLEND: 

Code: (Select All)

'https://qb64phoenix.com/qb64wiki/index.php/DONTBLEND

Screen _NewImage(800, 600, 32)
Cls
Print "Test / demonstration of _Blend and _DontBlend in QB64PE"
Print
Print "Press any key to begin...": Sleep: _KeyClear

Screen _NewImage(800, 600, 32)
Cls
_DontBlend
Line (100, 100)-(500, 500), _RGB32(255, 255, 0), BF
b& = SaveBackground&
Print "Part 1: _DontBlend"
Print
Print "Hit any key and this text should disappear,"
Print "leaving us our pretty yellow box.": Sleep: _KeyClear
RestoreBackground b&
Locate 33, 1: Print "Press any key for demonstration of _Blend";: Sleep: _KeyClear

Screen _NewImage(800, 600, 32)
Cls
_Blend ' this is on by default
Line (100, 100)-(500, 500), _RGB32(255, 255, 0), BF
b& = SaveBackground&
Print "Part 2: _Blend"
Print
Print "Hit any key and this text should remain.": Sleep: _KeyClear
RestoreBackground b&
Locate 33, 1: Print "Test complete. Press any key to exit.";: Sleep: _KeyClear

' CLEAN UP
If b& < -1 Or b& > 0 Then _FreeImage b&

End

Function SaveBackground&
    SaveBackground& = _CopyImage(0)
End Function

Sub RestoreBackground (Image As Long)
    _PutImage , Image, 0
End Sub

I'm still on QB64PE 4.0.0 - is there a _BLEND / _DONTBLEND bug in this version that I didn't get the memo for? 

[SMcNeill]

I'd suggest getting the latest version and giving it a try.  It all works as expected on Windows 11 for me with v 4.1.  I don't recall any glitch in 4.0 for _Blend, but a fresh install might be what you need.  I dunno.  /shrug

[Petr]

In the second part of the program (where the text should remain after the key is pressed) on line 22: CLS sets a black opaque background. Comment it out and the text will remain.
The default _NewImage has a transparent background by default. But CLS destroys this and sets the alpha channel to 255 instead of the default 0.

Code: (Select All)

'https://qb64phoenix.com/qb64wiki/index.php/DONTBLEND



Screen _NewImage(800, 600, 32)

Cls

Print "Test / demonstration of _Blend and _DontBlend in QB64PE"

Print

Print "Press any key to begin...": Sleep: _KeyClear



Screen _NewImage(800, 600, 32)

Cls

_DontBlend

Line (100, 100)-(500, 500), _RGB32(255, 255, 0), BF

b& = SaveBackground&

Print "Part 1: _DontBlend"

Print

Print "Hit any key and this text should disappear,"

Print "leaving us our pretty yellow box.": Sleep: _KeyClear

RestoreBackground b&

Locate 33, 1: Print "Press any key for demonstration of _Blend";: Sleep: _KeyClear



Screen _NewImage(800, 600, 32)

'Cls

_Blend ' this is on by default

Line (100, 100)-(500, 500), _RGB32(255, 255, 0), BF

b& = SaveBackground&

Print "Part 2: _Blend"

Print

Print "Hit any key and this text should remain.": Sleep: _KeyClear

RestoreBackground b&

Locate 33, 1: Print "Test complete. Press any key to exit.";: Sleep: _KeyClear



' CLEAN UP

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



End



Function SaveBackground&

    SaveBackground& = _CopyImage(0)

End Function



Sub RestoreBackground (Image As Long)

    _PutImage , Image, 0

End Sub

[TempodiBasic]

Hi
I'm with Steve. Not only because Steve is Amazing! But also because your second demo works as expected (or as projected).

Making a step back on the theory of Blending and Alpha channel...

   

 Alpha  Foreground       +     Alpha  Background    --->        Effect
     
                  1                   +              1                   --->      Foreground Showed
                  1                   +              0                   --->      Foreground Showed
                  0                   +              1                   --->      Background Showed
                  0                   +              0                   --->      Clearcolor Showed    (or Third Image under Background :-)  )
               >0 & <1           +        1 /  >0&<1           --->      Fusion (yeah blending) of colors following their alpha intensity!

Well coming back to your second demo on BLEND, it works as expected both in 4.0.0 both in 4.1.0!
If you like see the blending.... you must use alpha channels >0 & <1 ! 

here attached the demo with the right corrections and working as you desire and not as you code...

[madscijr]

Thanks gentlemen, I will upgrade to the latest per Steve (why not), check the CLS like @Petr suggests, and thanks @TempodiBasic for your correction & explanation. Then I'll go back to the above examples and try them again. Outta QB64PE time for today, used it learning about making screensavers!

[madscijr]

I had a couple minutes downtime, and (finally) got the Steve method and Steffan-68's example working! 

Code: (Select All)

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

$Color:32
Screen _NewImage(800, 600, 32): Cls , _RGB32(255, 255, 255): _ScreenMove 0, 0

' =============================================================================
' Init gold background
imgBg& = _NewImage(800, 600, 32): _Dest imgBg&: Cls , Gold

' Show it
_Dest 0: Cls , _RGB32(255, 255, 255): If imgBg& < -1 Or imgBg& > 0 Then _PutImage (0, 0), imgBg&, 0
Color Black, White: Locate 1, 1
Print "Step 1. Background before masking. Press any key"
Sleep: _KeyClear: '_Delay 1

' =============================================================================
' Draw source image = 2 overlapping circles
imgSource& = _NewImage(320, 240, 32)
_Dest imgSource&: Cls , Green
Circle (100, 100), 75, Red: Paint (100, 100), Red
Circle (150, 150), 75, Blue: Paint (150, 150), Blue

' Show it
' _PutImage (-10, -10), Mask&, doneImage&
''_PUTIMAGE (dx1, dy1)-(dx2, dy2), sourceHandle&, destHandle&,(sx1, sy1)
_Dest 0: Cls , _RGB32(255, 255, 255): If imgSource& < -1 Or imgSource& > 0 Then _PutImage (0, 0), imgSource&, 0
Color Black, White: Locate 1, 1
Print "Step 2. Image to be copied. Press any key"
Sleep: _KeyClear: '_Delay 1

' =============================================================================
' Draw mask image = a big "+"
imgMask& = _NewImage(320, 240, 32)
_Dest imgMask&: Cls , _RGBA32(0, 0, 0, 0)
iX = 1: iY = 100: iSizeW = 320: iSizeH = 40: fgColor~& = Black
DrawRectSolid iX, iY, iSizeW, iSizeH, fgColor~&
iX = 140: iY = 1: iSizeW = 40: iSizeH = 240: fgColor~& = Black
DrawRectSolid 140, 1, 40, 240, Black

' Show it
_Dest 0: Cls , _RGB32(255, 255, 255): If imgMask& < -1 Or imgMask& > 0 Then _PutImage (0, 0), imgMask&, 0
Color Black, White: Locate 1, 1
Print "Step 3. The mask. Press any key"
Sleep

' =============================================================================
' Copy source to screen using mask
Mask 100, 100, imgSource&, imgMask&, imgBg&

' Show it
_Dest 0: Cls , _RGB32(255, 255, 255): If imgBg& < -1 Or imgBg& > 0 Then _PutImage (0, 0), imgBg&, 0
Color Black, White: Locate 1, 1
Print "Step 4. Screen after masking. Press any key"
Sleep: _KeyClear: '_Delay 1

' =============================================================================
' Clean up
Screen 0
If imgBg& < -1 Or imgBg& > 0 Then _FreeImage imgBg&
If imgSource& < -1 Or imgSource& > 0 Then _FreeImage imgSource&
If imgMask& < -1 Or imgMask& > 0 Then _FreeImage imgMask&
System

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

Sub Mask (xPos, yPos, imgSource&, imgMask&, imgDest&)
    Dim OldBlend%: OldBlend% = _Blend
    Dim OldSource&: OldSource& = _Source
    Dim OldDest&: OldDest& = _Dest
   
    For x = 0 To _Width(imgMask&) - 1
        For y = 0 To _Height(imgMask&) - 1
            _Source imgMask&
            If Point(x, y) <> _RGB32(0, 0, 0, 0) Then
                _Source imgSource&
                MyColor~& = Point(x, y)
               
                _Dest imgDest&
                _DontBlend
                PSet (xPos + x, yPos + y), MyColor~&
            End If
        Next y
    Next x
   
    If OldBlend% Then _Blend
    _Source OldSource&
    _Dest OldDest&
End Sub ' Mask

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

Function cEmpty~& ()
    cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&

' /////////////////////////////////////////////////////////////////////////////
'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

---

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

For some reason your example never finished selecting, so I changed the logic so pressing Enter finishes the selection (and Esc to quit).

I also had to comment out the line 

Code: (Select All)

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

and now it works. Very nice! 

Code: (Select All)

' Erasing (or making a section of an image transparent) based on a mask from image #2?, reply #4
' https://qb64phoenix.com/forum/showthread.php?tid=3612&pid=33514#pid33514

' From: Steffan-68
' Date: 4/13/2025, 04:31 AM

' (04-12-2025, 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

Const KeyCode_Escape = 2
Const KeyCode_Spacebar = 58
Const KeyCode_Enter = 29
Const KeyCode_Up = 329
Const KeyCode_Down = 337
Const KeyCode_Left = 332
Const KeyCode_Right = 334

Type Points
    As Integer x, y
End Type

Type LinePoints
    X As Integer
    Y As Integer
End Type

Dim Image&
Dim Mask&
Dim doneImage&

Dim bSelected%

ReDim Shared LP(0) As LinePoints
ReDim nP(0) As Points
ReDim P(20000) As Points

Image& = _ScreenImage
_Delay .5

Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)
'_FullScreen
Cls


bSelected% = _FALSE
Do
    _PutImage , Image& 'place complete image to screen

    Locate 1, 1: Print "Use mouse, press left button and select any image area";
    Locate 2, 1: Print "Then press Enter to copy selected area.";
    Locate 3, 1: Print "Or press Esc to quit.";


    While _MouseInput
    Wend
    MX = _MouseX
    MY = _MouseY
    LB = _MouseButton(1)


    'Print LB, MX, MY, j, max

    Locate 4, 1
    Print _
        "LB=" + _TRIM$(str$(LB)) + _
        ", MX=" + _TRIM$(str$(MX)) + _
        ", MY=" + _TRIM$(str$(MY)) + _
        ", j=" + _TRIM$(str$(j)) + _
        ", max=" + _TRIM$(str$(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

    ' PROCESS KEYBOARD INPUT
    While _DeviceInput(1): Wend ' clear and update the keyboard buffer
    If _Button(KeyCode_Escape) Then
        Exit Do
    ElseIf _Button(KeyCode_Enter) Then
        bSelected% = _TRUE
    End If
    _KeyClear ' CLEAR KEYBOARD BUFFER

    'control if area is completed
    'If max > 10 Then
    If bSelected% = _TRUE Then
        If _TRUE = _TRUE 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&

            'return to my screen
            _Dest 0
            _Source 0

            'view output
            Cls
            _PutImage (0, 0), doneImage&
            _Display
            Sleep
        End If
    End If

    _Limit 30
    _Display
Loop

'erase ram
Screen 0
If Mask& < -1 Or Mask& > 0 Then _FreeImage Mask&
If Image& < -1 Or Image& > 0 Then _FreeImage Image&
If doneImage& < -1 Or doneImage& > 0 Then _FreeImage doneImage&
End

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 fill
End Sub ' GETPOINTS

Later I'll play around with _SetAlpha and _ClearColor some more...

[Steffan-68]

I had a couple minutes downtime, and (finally) got the Steve method and Steffan-68's example working! 
Later I'll play around with _SetAlpha and _ClearColor some more...

The program runs as strange for me as it is.
I can mask part with the mouse and it is completed and ESC also ends the program.
Use QB6PE V 4.1 with Windows 10

[madscijr]

I will upgrade to QB64PE 4.1, but my laptop is Windows 11. 
(BTW, I prefer Windows 10 for a few reasons, but unfortunately Microsoft is ending support later this year, which doesn't leave us much choice but to upgrade - or move to Linux or Mac, and I still prefer Windows with all its flaws to the alternatives. If someone would make a Linux that truly works & feels like classic Windows, I'd give it a try, but every attempt to do that I've ever seen is not even close!)

I'll let you know how your code works with QB64PE 4.1 when I do the update, but probably not for a day or 2... Thanks!