Platforms to show: All Mac Windows Linux Cross-Platform
/MacCF/ColorSync/Colorsync Transform to CMYK
Required plugins for this example: MBS MacCF Plugin, MBS Main Plugin, MBS Images Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /MacCF/ColorSync/Colorsync Transform to CMYK
This example is the version from Thu, 29th May 2019.
Project "Colorsync Transform to CMYK.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class MainWindow Inherits Window
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control Canvas2 Inherits Canvas
ControlInstance Canvas2 Inherits Canvas
End Control
EventHandler Sub Open()
Dim p As Picture = LogoMBS(500)
canvas1.Backdrop = p
// Xojo pictures are in Generic RGB usually.
Dim SourceProfileFile As FolderItem = GetFolderItem("/System/Library/ColorSync/Profiles/Generic RGB Profile.icc", FolderItem.PathTypeShell)
Dim DestinProfileFile As FolderItem = GetFolderItem("/System/Library/ColorSync/Profiles/Generic CMYK Profile.icc", FolderItem.PathTypeShell)
If SourceProfileFile.Exists = False Then
break
MsgBox "Failed to locate source profile."
Return
end if
if DestinProfileFile.Exists = false then
break
MsgBox "Failed to locate destination profile."
Return
end if
dim SourceProfile as new CSProfileMBS(SourceProfileFile)
dim DestinProfile as new CSProfileMBS(DestinProfileFile)
if SourceProfile.Handle = 0 then
break
MsgBox "Failed to load source profile."
Return
end if
if DestinProfile.Handle = 0 then
break
MsgBox "Failed to load destination profile."
Return
end if
Dim options As New Dictionary
options.Value(CSTransformMBS.kColorSyncConvertQuality) = CSTransformMBS.kColorSyncBestQuality
dim profilesequence(-1) as Dictionary
dim SourceProfileDic as new Dictionary
dim DestinProfileDic as new Dictionary
SourceProfileDic.Value(CSTransformMBS.kColorSyncProfile) = SourceProfile
DestinProfileDic.Value(CSTransformMBS.kColorSyncProfile) = DestinProfile
SourceProfileDic.Value(CSTransformMBS.kColorSyncRenderingIntent) = CSTransformMBS.kColorSyncRenderingIntentRelative
DestinProfileDic.Value(CSTransformMBS.kColorSyncRenderingIntent) = CSTransformMBS.kColorSyncRenderingIntentRelative
SourceProfileDic.Value(CSTransformMBS.kColorSyncTransformTag) = CSTransformMBS.kColorSyncTransformDeviceToPCS
DestinProfileDic.Value(CSTransformMBS.kColorSyncTransformTag) = CSTransformMBS.kColorSyncTransformPCSToDevice
SourceProfileDic.Value(CSTransformMBS.kColorSyncBlackPointCompensation) = True
DestinProfileDic.Value(CSTransformMBS.kColorSyncBlackPointCompensation) = True
profilesequence.Append SourceProfileDic
profilesequence.Append DestinProfileDic
Dim t As New CSTransformMBS(profilesequence, options)
if t.Handle = 0 then
MsgBox "Failed to initialize the transformation."
else
Dim toptions As New Dictionary
toptions.Value(t.kColorSyncConvertQuality) = t.kColorSyncBestQuality
Dim dstHeight As Integer = p.Height
Dim dstWidth As Integer = p.Width
Dim dstBytesPerPixel As Integer = 4 // CMYK
Dim dstBytesPerRow As Integer = dstWidth * dstBytesPerPixel
Dim dstDepth As Integer = t.kColorSync8BitInteger
Dim dstLayout As Integer = t.kColorSyncAlphaNone
Dim dest As New MemoryBlock(dstBytesPerRow * Height)
If t.Convert(dest, dstDepth, dstLayout, dstBytesPerRow, p, toptions) Then
// read ICC Profile to embed it in JPEG file
Dim ProfileStream As BinaryStream = BinaryStream.Open(DestinProfileFile)
Dim ProfileData As String = ProfileStream.Read(ProfileStream.Length)
// save memory block as jpeg with CMYK
Dim je As New JPEGExporterMBS
je.File = SpecialFolder.Desktop.Child("outputCMYK.jpg")
je.ProfileData = ProfileData
je.ExportCMYK(dest, dstWidth, dstHeight, dstBytesPerRow)
// save memory block as jpeg with RGB
'dim je as New JPEGExporterMBS
'je.File = SpecialFolder.Desktop.Child("outputRGB.jpg")
'je.ExportRGB(dest, dstWidth, dstHeight, dstBytesPerRow)
canvas2.Backdrop = Picture.Open(je.file)
else
MsgBox "Failed to convert."
end if
end if
End EventHandler
Private Function CopyCMYKChannel(m as MemoryBlock, width as integer, height as integer, offset as integer) As Picture
dim p as new Picture(width, height, 32)
dim h as integer = height-1
dim w as integer = width-1
dim r as RGBSurface = p.RGBSurface
dim c as color
dim n as integer
for y as integer = 0 to h
for x as integer = 0 to w
n = m.UInt8Value(width*4*y+x*4+offset)
c = rgb(n,n,n)
r.Pixel(x,y)=c
next
next
Return p
End Function
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
End Project
See also:
The items on this page are in the following plugins: MBS MacCF Plugin.