Platforms to show: All Mac Windows Linux Cross-Platform
/Images/LCMS2/CMYK/CMYK Example
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/CMYK/CMYK Example
This example is the version from Tue, 21th Jan 2019.
Project "CMYK Example.xojo_binary_project"
FileTypes
Filetype special/any
End FileTypes
Class CMYKExample Inherits Window
Control originalc Inherits Canvas
ControlInstance originalc Inherits Canvas
End Control
Control cc Inherits Canvas
ControlInstance cc Inherits Canvas
End Control
Control mc Inherits Canvas
ControlInstance mc Inherits Canvas
End Control
Control yc Inherits Canvas
ControlInstance yc Inherits Canvas
End Control
Control bc Inherits Canvas
ControlInstance bc Inherits Canvas
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control StaticText2 Inherits Label
ControlInstance StaticText2 Inherits Label
End Control
Control PopupMenu1 Inherits PopupMenu
ControlInstance PopupMenu1 Inherits PopupMenu
EventHandler Sub Change()
run lastfile
End EventHandler
End Control
EventHandler Sub DropObject(obj As DragItem, action As Integer)
dim f as FolderItem
do
if obj.FolderItemAvailable then
f=obj.FolderItem
lastfile=F
run f
end if
loop until not obj.NextItem
End EventHandler
EventHandler Sub EnableMenuItems()
FileLoadCMYKJPEG.Enable
End EventHandler
EventHandler Sub Open()
me.AcceptFileDrop "special/any"
End EventHandler
Function FileLoadCMYKJPEG() As Boolean
dim f as FolderItem
f=GetOpenFolderItem("special/any")
if f<>nil then
loadjpeg f
end if
End Function
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
Function getpictureCM(c as LCMS2bitmapMBS, s as string,nn as integer) As picture
// converts a CMBitmapMBS to a picture taking only one channel with offset nn
dim p as Picture
dim r as RGBSurface
dim x,y as integer
dim m as MemoryBlock
dim n as integer
dim i as integer
p = new Picture(200,200,32)
r=p.RGBSurface
m=c.Data
n=nn
for x=0 to 199
for y=0 to 199
i=m.UInt8Value(n)
i=255-i
r.Pixel(y,x)=rgb(i,i,i)
n=n+4
Next
next
p.Graphics.ForeColor=rgb(255,0,0)
p.Graphics.DrawString s,10,10
Return p
End Function
Function getpictureJPEG(m as memoryblock, w as integer,h as integer, s as string,nn as integer,rowbytes as integer) As picture
// converts a JPEG memoryblock to a picture taking only one channel with offset nn
dim p as Picture
dim r as RGBSurface
dim x,y as integer
dim n as integer
dim i as integer
dim ww,hh as integer
dim d as integer
ww=w-1
hh=h-1
p = new Picture(w,h,32)
r=p.RGBSurface
d=nn
for x=0 to ww
n=d
for y=0 to hh
i=m.byte(n)
r.Pixel(y,x)=rgb(i,i,i)
n=n+4
Next
d=d+rowbytes
next
p.Graphics.ForeColor=rgb(255,0,0)
p.Graphics.DrawString s,10,10
Return p
End Function
Function getpictureRBCM(m as memoryblock, w as integer,h as integer, s as string,nn as integer) As picture
// converts a memoryblock to a picture taking only one channel with offset nn
dim p as Picture
dim r as RGBSurface
dim x,y as integer
dim n as integer
dim i as integer
dim ww,hh as integer
ww=w-1
hh=h-1
p = new Picture(w,h,32)
r=p.RGBSurface
n=nn
for x=0 to ww
for y=0 to hh
i=m.byte(n)
i=255-i
r.Pixel(y,x)=rgb(i,i,i)
n=n+4
Next
next
p.Graphics.ForeColor=rgb(255,0,0)
p.Graphics.DrawString s,10,10
Return p
End Function
Sub loadjpeg(f as folderItem)
dim j as JPEGImporterMBS
dim m as MemoryBlock
j=new JPEGImporterMBS
j.File=f
j.ImportCMYK
Title=f.DisplayName+" ("+str(j.Width)+" x "+str(j.Height)+")"
m=j.PictureData
if m=nil then
MsgBox "No data imported!?"
else
cc.Backdrop=getpictureJPEG(m,min(200,j.Width),min(200,j.Height),"cyan",0,j.Width*4)
mc.Backdrop=getpictureJPEG(m,min(200,j.Width),min(200,j.Height),"magenta",1,j.Width*4)
yc.Backdrop=getpictureJPEG(m,min(200,j.Width),min(200,j.Height),"yellow",2,j.Width*4)
bc.Backdrop=getpictureJPEG(m,min(200,j.Width),min(200,j.Height),"black",3,j.Width*4)
end if
End Sub
Protected Sub run(f as folderitem)
dim p as Picture
if f<>nil then
p=f.OpenAsPicture
if p<>nil then
if PopupMenu1.ListIndex=0 then
runColorMatching p
elseif PopupMenu1.ListIndex=1 then
runRBCM p,true
else
runRBCM p,false
end if
end if
end if
End Sub
Sub runColorMatching(inputpic as picture)
dim p as Picture
dim m as MemoryBlock
dim cb,co as LCMS2BitmapMBS
dim cw as LCMS2TransformMBS
dim i,c as integer
dim ip,op as LCMS2ProfileMBS
dim n as String
dim e as integer
dim fi,fo as FolderItem
dim f as FolderItem
dim j as JPEGExporterMBS
fi = FindFile("Generic RGB Profile.icc")
fo = FindFile("Generic CMYK Profile.icc")
ip = LCMS2ProfileMBS.OpenProfileFromFile(fi)
op = LCMS2ProfileMBS.OpenProfileFromFile(fo)
p = new Picture(200,200,32)
p.Graphics.DrawPicture inputpic,0,0
originalc.Backdrop=p
// input bitmap
cb = new LCMS2BitmapMBS(p,8)
// output bitmap
co = new LCMS2BitmapMBS(200, 200, LCMS2MBS.kcmsSigCmykData)
dim foi as integer = ip.FormatterForBitmap
dim foo as integer = op.FormatterForBitmap
cw = LCMS2TransformMBS.CreateTransform(ip, foi, op, foo, 0)
if cw.Transform(cb,co) then
bc.Backdrop=getpictureCM(co,"black",3)
cc.Backdrop=getpictureCM(co,"cyan",0)
mc.Backdrop=getpictureCM(co,"magenta",1)
yc.Backdrop=getpictureCM(co,"yellow",2)
f = SpecialFolder.Desktop.Child("CMYK Example output CM.jpg")
j=new JPEGExporterMBS
j.File=f
j.ExportCMYK (co.data), 200, 200, 200*4
if j.ErrorCode <> 0 then
MsgBox str(j.ErrorCode)+" "+j.ErrorMessage
end if
end if
End Sub
Sub runRBCM(inputpic as picture, noblack as boolean)
dim p as Picture
dim m as MemoryBlock
dim f as FolderItem
dim j as JPEGExporterMBS
dim x,y,xx,yy as integer
dim r as RGBSurface
dim n as integer
dim c as color
dim rr,gg,bb as integer
dim kk as integer
p = new Picture(200,200,32)
p.Graphics.DrawPicture inputpic,0,0
originalc.Backdrop=p
m=New MemoryBlock(200*200*4)
r=p.RGBSurface
xx=p.Width-1
yy=p.Height-1
n=0
if noblack then
for y=0 to yy
for x=0 to xx
c=r.Pixel(x,y)
// without black part it's faster:
m.Byte(n)=255-c.red // c
n=n+1
m.Byte(n)=255-c.green // m
n=n+1
m.Byte(n)=255-c.blue // y
n=n+1
m.Byte(n)=0 // k
n=n+1
next
next
else
for y=0 to yy
for x=0 to xx
// with black
c=r.Pixel(x,y)
rr=255-c.red
gg=255-c.green
bb=255-c.blue
kk=min(min(rr,gg),bb)
rr=rr-kk
gg=gg-kk
bb=bb-kk
m.Byte(n)=rr // c
n=n+1
m.Byte(n)=gg // m
n=n+1
m.Byte(n)=bb // y
n=n+1
m.Byte(n)=kk // k
n=n+1
next
next
end if
cc.Backdrop=getpictureRBCM(m,p.Width,p.Height,"cyan",0)
mc.Backdrop=getpictureRBCM(m,p.Width,p.Height,"magenta",1)
yc.Backdrop=getpictureRBCM(m,p.Width,p.Height,"yellow",2)
bc.Backdrop=getpictureRBCM(m,p.Width,p.Height,"black",3)
if noblack then
f=SpecialFolder.Desktop.Child("CMYK Example output CMRB1.jpg")
else
f=SpecialFolder.Desktop.Child("CMYK Example output CMRB2.jpg")
end if
j=new JPEGExporterMBS
j.File=f
j.ExportCMYK m,p.Width,p.Height,p.Width*4
'MsgBox str(j.ErrorCode)+" "+j.ErrorMessage
End Sub
Property Protected lastfile As folderitem
End Class
MenuBar Menu
MenuItem UntitledMenu4 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileLoadCMYKJPEG = "Load CMYK JPEG"
MenuItem UntitledMenu3 = "-"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
EventHandler Function UnhandledException(error As RuntimeException) As Boolean
#if DebugBuild
#else
if error isa NilObjectException then
MsgBox "There was a nil object exception somewhere."
else
MsgBox "There was an exception somewhere."
end if
Return true
#endif
End EventHandler
End Class
End Project
The items on this page are in the following plugins: MBS Images Plugin.