Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Picture/Picture Blending test
Function:
Required plugins for this example: MBS Main Plugin, MBS Picture 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, 10th Dec 2016.
Project "Picture Blending test.rbp"
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 Dim origUseOldRenderer As Boolean 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) If TargetMacOS Then origUseOldRenderer = result.graphics.UseOldRenderer result.graphics.UseOldRenderer = True End If 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) If TargetMacOS Then tempSourceTile.graphics.UseOldRenderer = True End If tempSourceTile.graphics.DrawPicture(pSourceImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight) If pDestImage <> Nil Then If TargetMacOS Then tempDestTile.graphics.UseOldRenderer = True End If tempDestTile.graphics.DrawPicture(pDestImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight) End If If pMask <> Nil Then If TargetMacOS Then tempMaskTile.graphics.UseOldRenderer = True End If 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 If TargetMacOS Then result.graphics.UseOldRenderer = origUseOldRenderer End If 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 Dim origUseOldRenderer As Boolean 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) If TargetMacOS Then origUseOldRenderer = result.graphics.UseOldRenderer result.graphics.UseOldRenderer = True End If 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) If TargetMacOS Then tempSourceTile.graphics.UseOldRenderer = True End If tempSourceTile.graphics.DrawPicture(pSourceImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight) If pDestImage <> Nil Then If TargetMacOS Then tempDestTile.graphics.UseOldRenderer = True End If tempDestTile.graphics.DrawPicture(pDestImage, 0, 0, tileWidth, tileHeight, tileX, tileY, tileWidth, tileHeight) End If If pMask <> Nil Then If TargetMacOS Then tempMaskTile.graphics.UseOldRenderer = True End If 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 If TargetMacOS Then result.graphics.UseOldRenderer = origUseOldRenderer End If 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:

Feedback, Comments & Corrections

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




Links
MBS FileMaker Plugins