Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/LCMS2/Image test
Function:
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.rbp"
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

Feedback, Comments & Corrections

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




Links
MBS Xojo Chart Plugins