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:

The items on this page are in the following plugins: MBS Picture Plugin.


The biggest plugin in space...