Class App Inherits Application

Const kEditClear = "&Löschen"

Const kFileQuit = "Beenden"

Const kFileQuitShortcut = ""

End Class

Class MainWindow Inherits Window

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