Platforms to show: All Mac Windows Linux Cross-Platform

/Picture/Image effects/ColourTinter


Required plugins for this example: MBS Picture Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Picture/Image effects/ColourTinter

This example is the version from Thu, 6th Apr 2016.

Project "ColourTinter.xojo_binary_project"
FileTypes
Filetype text
Filetype image/jpeg
Filetype image/pict
End FileTypes
Class Window1 Inherits Window
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) If ( fTintedPicture <> nil ) then g.DrawPicture fTintedPicture, 0, 0 Else g.DrawString "No picture", 10, 20 End if g.DrawRect 0, 0, Canvas1.Width-1, Canvas1.Height-1 End EventHandler
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() fFile = GetOpenFolderItem( "image/jpeg" ) If ( fFile <> nil ) then fBasePicture = fFile.OpenAsPicture() End if DoColorTinting End EventHandler
End Control
Control Canvas2 Inherits Canvas
ControlInstance Canvas2 Inherits Canvas
EventHandler Function MouseDown(X As Integer, Y As Integer) As Boolean return TRUE End EventHandler
EventHandler Sub MouseUp(X As Integer, Y As Integer) Dim theResult as Boolean dim c as color c=fTintBase theResult = SelectColor( c, "Choose the tint base:" ) fTintBase=c Canvas2.Refresh DoColorTinting End EventHandler
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) g.ForeColor = fTintBase g.FillRect 0, 0, Canvas2.Width, Canvas2.Height g.ForeColor = RGB( 0, 0, 0 ) g.DrawRect 0, 0, Canvas2.Width, Canvas2.Height End EventHandler
End Control
Control Canvas3 Inherits Canvas
ControlInstance Canvas3 Inherits Canvas
EventHandler Function MouseDown(X As Integer, Y As Integer) As Boolean return TRUE End EventHandler
EventHandler Sub MouseUp(X As Integer, Y As Integer) Dim theResult as Boolean dim c as color c=fGreyBase theResult = SelectColor( c, "Choose the grey base:" ) fGreyBase=c Canvas3.Refresh DoColorTinting End EventHandler
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) g.ForeColor = fGreyBase g.FillRect 0, 0, Canvas3.Width, Canvas3.Height g.ForeColor = RGB( 0, 0, 0 ) g.DrawRect 0, 0, Canvas3.Width, Canvas3.Height End EventHandler
End Control
Control PopupMenu1 Inherits PopupMenu
ControlInstance PopupMenu1 Inherits PopupMenu
EventHandler Sub Change() DoColorTinting End EventHandler
End Control
EventHandler Sub Open() dim f as FolderItem fGreyBase = RGB( 100, 100, 100 ) fTintBase = RGB( 255, 245, 171 ) if DebugBuild then f=FindFile("test.jpg") if f.exists then fBasePicture = f.OpenAsPicture() DoColorTinting end if end if End EventHandler
Protected Sub DoColorTinting() Dim theTinter as ColourTinter dim b as Boolean dim s as PictureSepiaMBS dim d as integer If fBasePicture <> nil then theTinter = New ColourTinter Select case PopupMenu1.ListIndex case 0 fTintedPicture=TintPictureMBS(fBasePicture,fGreyBase, fTintBase ) case 1 s=new PictureSepiaMBS s.SourcePicture=fBasePicture d=(fTintBase.red+fTintBase.green+fTintBase.blue)/3 s.SepiaRed=fTintBase.red-d s.SepiaGreen=fTintBase.green-d s.SepiaBlue=fTintBase.blue-d b=s.Run fTintedPicture=s.DestinationPicture case 2 fTintedPicture = fBasePicture.CloneMBS theTinter.TintPicture( fTintedPicture, fGreyBase, fTintBase ) end Select Canvas1.Refresh End if End Sub
Function FindFile(name as string) As FolderItem // Look for file in parent folders from executable on dim parent as FolderItem = app.ExecutableFile.Parent while parent<>Nil dim file as FolderItem = parent.Child(name) if file<>Nil and file.Exists then Return file end if parent = parent.Parent wend End Function
Property Protected fBasePicture As Picture
Property Protected fFile As FolderItem
Property Protected fGreyBase As Color
Property Protected fTintBase As Color
Property Protected fTintedPicture As Picture
End Class
MenuBar MenuBar1
MenuItem UntitledMenu1 = ""
MenuItem FileMenu = "&File"
MenuItem FileQuit = "Quit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
End Class
Class ColourTinter
Sub TintPicture(theImg as Picture, pGreyBase as Color, pSepiaBase as Color) Dim theRGBSurface as RGBSurface Dim theWidth, theHeight as Integer Dim pColor as Color Dim x, y as Integer Dim theGrey as Integer dim SepiaBaseR as Double dim SepiaBaseG as Double dim SepiaBaseB as Double dim GreyBaseR as Double dim GreyBaseG as Double dim GreyBaseB as Double SepiaBaseR=pSepiaBase.Red / 255.0 SepiaBaseG=pSepiaBase.Green / 255.0 SepiaBaseB=pSepiaBase.Blue / 255.0 GreyBaseR=pGreyBase.Red / 255.0 GreyBaseG=pGreyBase.Green / 255.0 GreyBaseB=pGreyBase.Blue / 255.0 theRGBSurface = theImg.RGBSurface theWidth = theImg.Width-1 theHeight = theImg.Height-1 For x = 0 to theWidth For y = 0 to theHeight pColor = theImg.RGBSurface.Pixel( x, y ) theGrey = ( GreyBaseR * pColor.Red ) + ( GreyBaseG * pColor.Green ) + ( GreyBaseB * pColor.Blue ) theImg.RGBSurface.Pixel( x, y ) = RGB( theGrey * SepiaBaseR, theGrey * SepiaBaseG, theGrey * SepiaBaseB ) Next Next End Sub
End Class
End Project

See also:

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


The biggest plugin in space...