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.