Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/LCMS2/CMYK/CMYK Example
Function:
Required plugins for this example: MBS Images Plugin, MBS MacClassic 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 Thu, 16th Nov 2016.
Project "CMYK Example.rbp"
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 getpicture(c as colorsyncbitmapMBS,s as string,nn as integer) As picture // converts a ColorSyncBitmapMBS 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=255-m.byte(n) 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 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 runColorSync p elseif PopupMenu1.ListIndex=1 then runColorMatching p elseif PopupMenu1.ListIndex=2 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 runColorSync(inputpic as picture) dim p as Picture dim m as MemoryBlock dim cb,co as ColorSyncBitmapMBS dim cw as ColorSyncWorldMBS dim i,c as integer dim ci as ColorSyncProfileInfoMBS dim ip,op as ColorSyncProfileMBS dim n as String dim e as integer dim f as FolderItem dim j as JPEGExporterMBS dim fi,fo as FolderItem fi=FindFile("Generic RGB Profile.icc") fo=FindFile("Generic CMYK Profile.icc") ip=fi.OpenAsColorSyncProfileMBS op=fo.OpenAsColorSyncProfileMBS p = new Picture(200,200,32) p.Graphics.DrawPicture inputpic,0,0 originalc.Backdrop=p cb=CreateColorSyncBitmapMBS(p,false) if cb <> nil then const cmCMYKSpace = &h0002 const cmLong8ColorPacking = &h0800 co=new ColorSyncBitmapMBS co.ColorSpaceType=cmCMYKSpace+cmLong8ColorPacking co.data=NewMemoryBlock(200*200*4) co.Height=200 co.PixelSize=32 co.RowBytes=200*4 co.Width=200 cw=New ColorSyncWorldMBS(ip,op) cw.MatchBitmap(cb,co) bc.Backdrop=getpicture(co,"black",3) cc.Backdrop=getpicture(co,"cyan",0) mc.Backdrop=getpicture(co,"magenta",1) yc.Backdrop=getpicture(co,"yellow",2) f=SpecialFolder.Desktop.Child("CMYK Example output CS.jpg") j=new JPEGExporterMBS j.File=f j.ExportCMYK co.data,co.Width,co.Height,co.RowBytes 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=NewMemoryBlock(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

Feedback, Comments & Corrections

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





Links
MBS Xojo Plugins