Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Images Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/LCMS2/Image test
This example is the version from Sun, 25th Nov 2017.
Project "Image test.xojo_binary_project"
FileTypes
Filetype special/any
End FileTypes
Class Window1 Inherits Window
Control preview Inherits Canvas
ControlInstance preview Inherits Canvas
End Control
Control result Inherits Canvas
ControlInstance result Inherits Canvas
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action()
dim p as picture
dim f as folderItem
f=FindFile("testbild.tif")
p=f.openaspicture
if p<>Nil then
original.graphics.drawPicture p,0,0
update
end if
End EventHandler
EventHandler Sub Open()
dim f as folderItem
f=FindFile("testbild.tif")
if f = nil or not f.exists then
me.visible=false
end if
End EventHandler
End Control
Control StaticText2 Inherits Label
ControlInstance StaticText2 Inherits Label
End Control
Control StaticText3 Inherits Label
ControlInstance StaticText3 Inherits Label
End Control
Control StaticText4 Inherits Label
ControlInstance StaticText4 Inherits Label
End Control
Control change Inherits Canvas
ControlInstance change Inherits Canvas
End Control
Control StaticText5 Inherits Label
ControlInstance StaticText5 Inherits Label
End Control
Control checkchange Inherits CheckBox
ControlInstance checkchange Inherits CheckBox
EventHandler Sub Action()
update
End EventHandler
End Control
Control sourceinfo Inherits Label
ControlInstance sourceinfo Inherits Label
EventHandler Sub DropObject(obj As DragItem, action As Integer)
dim c as LCMS2ProfileMBS
do
if obj.folderItemavailable then
c = LCMS2ProfileMBS.OpenProfileFromFile(obj.folderItem)
if c<>nil then
source=c
me.text=c.Name
update
else
MsgBox "Failed to load the profile "+obj.FolderItem.Name
end if
end if
loop until not obj.nextItem
End EventHandler
EventHandler Function MouseDown(X As Integer, Y As Integer) As Boolean
source=LCMS2ProfileMBS.CreateSRGBProfile
me.text="Default RGB"
update
return true
End EventHandler
EventHandler Sub Open()
source=LCMS2ProfileMBS.CreateSRGBProfile
me.text="Default RGB"
me.acceptFileDrop "special/any"
End EventHandler
End Control
Control destinfo Inherits Label
ControlInstance destinfo Inherits Label
EventHandler Sub DropObject(obj As DragItem, action As Integer)
dim c as LCMS2ProfileMBS
do
if obj.folderItemavailable then
c = LCMS2ProfileMBS.OpenProfileFromFile(obj.FolderItem)
if c<>nil then
dest=c
me.text=c.Name
update
else
MsgBox "Failed to load the profile "+obj.FolderItem.Name
end if
end if
loop until not obj.nextItem
End EventHandler
EventHandler Function MouseDown(X As Integer, Y As Integer) As Boolean
dest=LCMS2ProfileMBS.CreateSRGBProfile
me.text="Default RGB"
update
return true
End EventHandler
EventHandler Sub Open()
dest=LCMS2ProfileMBS.CreateSRGBProfile
destinfo.text="Default RGB"
me.acceptFileDrop "special/any"
End EventHandler
End Control
Control CheckSlow Inherits CheckBox
ControlInstance CheckSlow Inherits CheckBox
EventHandler Sub Action()
update
End EventHandler
End Control
Control CheckInvert Inherits CheckBox
ControlInstance CheckInvert Inherits CheckBox
EventHandler Sub Action()
update
End EventHandler
End Control
Control StaticText6 Inherits Label
ControlInstance StaticText6 Inherits Label
End Control
EventHandler Sub Close()
source=nil
dest=nil
End EventHandler
EventHandler Sub Open()
create
ready=true
update
End EventHandler
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
Sub convert(p as picture, t as LCMS2TransformMBS)
dim r as rgbSurface
dim x,y as integer
dim h,w as integer
h=p.height-1
w=p.width-1
r=p.RGBSurface
for y=0 to h
for x=0 to w
r.pixel(x,y)=t.TransformRGB(r.pixel(x,y))
next
next
End Sub
Function convertfast(p as picture,t as LCMS2TransformMBS) As picture
dim c as new LCMS2BitmapMBS(p,16)
if t.Transform(c) then
if checkinvert.value then
c.invert
end if
return c.Picture
end if
End Function
Sub create()
dim g as graphics
dim x as integer
dim y as integer
dim r as RGBSurface
dim w as integer
dim h as integer
original = new picture(preview.width,preview.height,32)
r=original.RGBSurface
g=original.graphics
w=original.width-1
h=original.height-1
for x=0 to w
for y=0 to h
r.pixel(x,y)=rgb(x*255/w,y*255/h,y*255/h)
next
next
preview.backdrop=original
difference = new picture(preview.width,preview.height,32)
change.backdrop=difference
End Sub
Sub makedifference()
dim x,y as integer
dim c1,c2,c as color
dim h,w as integer
dim s,d,e as rgbSurface
if checkchange.value then
w=preview.width-1
h=preview.height-1
s=original.rgbSurface
d=result.backdrop.rgbSurface
e=difference.rgbSurface
for x=0 to h
for y=0 to w
c1=s.Pixel(x,y)
c2=d.Pixel(x,y)
c=Rgb(255-abs(c1.red-c2.red),255-abs(c1.green-c2.green),255-abs(c1.blue-c2.blue))
e.pixel(x,y)=c
next
next
change.refresh
end if
End Sub
Sub update()
dim p as picture
dim e as integer
dim t as LCMS2TransformMBS
if ready then
t = LCMS2TransformMBS.CreateTransform(source,source.FormatterForColorspace(2,false),dest,dest.FormatterForColorspace(2,false),0)
if t<>Nil then
p = new picture(original.width,original.height,32)
p.graphics.drawpicture original,0,0
if CheckSlow.value then
convert(p,t)
else
p = convertfast(p,t)
end if
end if
result.backdrop=p
result.refresh
makedifference
end if
End Sub
Property dest As LCMS2profileMBS
Property difference As picture
Property original As picture
Property ready As boolean
Property source As LCMS2profileMBS
End Class
MenuBar Menu
MenuItem UntitledMenu4 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu7 = ""
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
MenuItem UntitledMenu6 = ""
MenuItem UntitledMenu5 = ""
MenuItem UntitledMenu3 = ""
End MenuBar
Class App Inherits Application
End Class
End Project
The items on this page are in the following plugins: MBS Images Plugin.