Platforms to show: All Mac Windows Linux Cross-Platform
/Picture/Picture Blending test
Required plugins for this example: MBS Picture Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Picture/Picture Blending test
This example is the version from Sun, 5th Nov 2022.
Project "Picture Blending test.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control CheckBox1 Inherits CheckBox
ControlInstance CheckBox1 Inherits CheckBox
EventHandler Sub Action()
update
End EventHandler
End Control
Control CheckBox2 Inherits CheckBox
ControlInstance CheckBox2 Inherits CheckBox
EventHandler Sub Action()
update
End EventHandler
End Control
Control CheckBox3 Inherits CheckBox
ControlInstance CheckBox3 Inherits CheckBox
EventHandler Sub Action()
update
End EventHandler
End Control
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control CheckBox4 Inherits CheckBox
ControlInstance CheckBox4 Inherits CheckBox
EventHandler Sub Action()
update
End EventHandler
End Control
EventHandler Sub Open()
source=LogoMBS(500)
result = new Picture(500,500,32)
dest = new Picture(500,500,32)
dest.Graphics.ForeColor=&c00FF00
dest.Graphics.FillRect 0,0,500,500
MakeMask
update
End EventHandler
Function BlendPicturesWithMask(pSourceImage As Picture, pDestImage As Picture, pMask As Picture) As Picture
#pragma disableBackgroundTasks
#pragma disableBoundsChecking
const kTileSize=100
Dim result As Picture
Dim tempSourceTile As Picture
Dim tempDestTile As Picture
Dim tempMaskTile As Picture
Dim tempResultTile As Picture
Dim tileX, tileY As Integer
Dim lastTileWidth, lastTileHeight As Integer
Dim tileWidth, tileHeight As Integer
Dim height, width As Integer
If pMask <> Nil Then
height = pMask.Height
width = pMask.Width
Elseif pDestImage <> Nil Then
height = pDestImage.Height
width = pDestImage.Width
Else
height = pSourceImage.Height
width = pSourceImage.Width
End If
result = New Picture(width, height, 32)
tileY = 0
While tileY < result.Height
tileHeight = Min(kTileSize, result.Height - tileY)
tileX = 0
While tileX < result.Width
tileWidth = Min(kTileSize, result.Width - tileX)
If (tempSourceTile = Nil) Or (tileWidth <> lastTileWidth) Or (tileHeight <> lastTIleHeight) Then
tempSourceTile = new Picture(tileWidth, tileHeight, 32)
tempDestTile = new Picture(tileWidth, tileHeight, 32)
tempMaskTile = new Picture(tileWidth, tileHeight, 32)
lastTileWidth = tileWidth
lastTileHeight = tileHeight
End If
'make sure the tiles are empty
tempDestTile.graphics.ClearRect(0, 0, tileWidth, tileHeight)
tempMaskTile.graphics.FillRect(0, 0, tileWidth, tileHeight)
tempSourceTile.graphics.DrawPicture(pSourceImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight)
If pDestImage <> Nil Then
tempDestTile.graphics.DrawPicture(pDestImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight)
End If
If pMask <> Nil Then
tempMaskTile.graphics.DrawPicture(pMask, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight)
End If
tempResultTile = BlendPicturesWithMaskMBS(tempSourceTile, tempDestTile, tempMaskTile)
'copy the tile into a 32 bit buffer then copy it into the result
tempSourceTile.graphics.DrawPicture(tempResultTile, 0, 0)
result.graphics.DrawPicture(tempSourceTile, tileX, tileY)
tileX = tileX + tileWidth
Wend
tileY = tileY + tileHeight
Wend
Return Result
End Function
Function BlendPicturesWithMask(pSourceImage As Picture, pDestImage As Picture, pMask As Picture, pBackgroundColour as color) As Picture
#pragma disableBackgroundTasks
#pragma disableBoundsChecking
const kTileSize=100
Dim result As Picture
Dim tempSourceTile As Picture
Dim tempDestTile As Picture
Dim tempMaskTile As Picture
Dim tempResultTile As Picture
Dim tileX, tileY As Integer
Dim lastTileWidth, lastTileHeight As Integer
Dim tileWidth, tileHeight As Integer
Dim height, width As Integer
If pMask <> Nil Then
height = pMask.Height
width = pMask.Width
Elseif pDestImage <> Nil Then
height = pDestImage.Height
width = pDestImage.Width
Else
height = pSourceImage.Height
width = pSourceImage.Width
End If
result = new Picture(width, height, 32)
tileY = 0
While tileY < result.Height
tileHeight = Min(kTileSize, result.Height - tileY)
tileX = 0
While tileX < result.Width
tileWidth = Min(kTileSize, result.Width - tileX)
If (tempSourceTile = Nil) Or (tileWidth <> lastTileWidth) Or (tileHeight <> lastTIleHeight) Then
tempSourceTile = New Picture(tileWidth, tileHeight, 32)
tempDestTile = New Picture(tileWidth, tileHeight, 32)
tempMaskTile = New Picture(tileWidth, tileHeight, 32)
lastTileWidth = tileWidth
lastTileHeight = tileHeight
End If
'make sure the tiles are empty
tempDestTile.graphics.ForeColor = pBackgroundColour
tempDestTile.graphics.FillRect(0, 0, tileWidth, tileHeight)
tempMaskTile.graphics.FillRect(0, 0, tileWidth, tileHeight)
tempSourceTile.graphics.DrawPicture(pSourceImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight)
If pDestImage <> Nil Then
tempDestTile.graphics.DrawPicture(pDestImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight)
End If
If pMask <> Nil Then
tempMaskTile.graphics.DrawPicture(pMask, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight)
End If
tempResultTile = BlendPicturesWithMaskMBS(tempSourceTile, tempDestTile, tempMaskTile)
'copy the tile into a 32 bit buffer then copy it into the result
tempSourceTile.graphics.DrawPicture(tempResultTile, 0, 0)
result.graphics.DrawPicture(tempSourceTile, tileX, tileY)
tileX = tileX + tileWidth
Wend
tileY = tileY + tileHeight
Wend
Return Result
End Function
Sub makeMask()
mask = new Picture(500,500,32)
dim g as Graphics=mask.Graphics
dim n as integer
for x as integer=0 to 499
n=255-(x*255)\1000
g.ForeColor=rgb(n,n,n)
g.DrawLine x,0,0,x
next
for x as integer=0 to 499
n=127-(x*255)\1000
g.ForeColor=rgb(n,n,n)
g.DrawLine 499,x,x,499
next
'canvas1.Backdrop=mask
End Sub
Sub update()
dim m as Picture
dim d as Picture
if CheckBox1.Value then
m=nil
else
m=mask
end if
if CheckBox2.Value then
d=nil
else
d=dest
end if
if CheckBox4.Value then
if CheckBox3.Value then
if BlendPicturesWithMaskWithBackgroundMBS(source,d,m,result,0,0,500,500) then
canvas1.Backdrop=result
else
beep
canvas1.Backdrop=nil
end if
else
if BlendPicturesWithMaskWithBackgroundMBS(source,d,m,result,0,0,500,500,&cFF0000) then
canvas1.Backdrop=result
else
beep
canvas1.Backdrop=nil
end if
end if
else
if CheckBox3.Value then
canvas1.Backdrop=BlendPicturesWithMask(source,d,m)
else
canvas1.Backdrop=BlendPicturesWithMask(source,d,m,&cFF0000)
end if
end if
End Sub
Property dest As Picture
Property mask As Picture
Property result As Picture
Property source As Picture
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
End Project
See also:
- /Picture/Picture blending/blend with mask
- /Picture/Picture blending/blend with plugin
- /Picture/Picture Blur
- /Picture/Picture Combine
- /Picture/Picture Combine Test
- /Picture/Picture Difference
- /Picture/Picture MinMax/mmx_demo with plugin
- /Picture/Picture Scale/Scale Compare
- /Picture/Picture to Binary Data Test
- /Picture/Picture To String
The items on this page are in the following plugins: MBS Picture Plugin.