Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/LCMS2/Create a CMYK Profile
Required plugins for this example: MBS Images Plugin, MBS Util Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/LCMS2/Create a CMYK Profile
This example is the version from Mon, 27th Sep 2015.
Project "Create a CMYK Profile.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
EventHandler Sub Open() LCMS2MBS.SetLogErrorHandler self 'OpenDocument SpecialFolder.Desktop.Child("test.icc") dim h as LCMS2ProfileMBS = CreateFakeCMYK(300, false) dim f as FolderItem = SpecialFolder.Desktop.Child("test.icc") if h.SaveProfileToFile(f) then else MsgBox "Failed" end if dim w as new ProfileWindow w.Title = "fake" w.run h w.show End EventHandler
EventHandler Sub OpenDocument(item As FolderItem) dim p as LCMS2ProfileMBS = LCMS2ProfileMBS.OpenProfileFromFile(item) if p = nil then MsgBox "Failed to open profile." else dim w as new ProfileWindow w.Title = item.DisplayName w.run p w.show end if End EventHandler
Function CreateFakeCMYK(InkLimit as Double, lUseAboveRGB as Boolean) As LCMS2ProfileMBS dim ContextID as Variant dim AToB0, BToA0 as LCMS2PipelineMBS dim CLUT as LCMS2StageMBS dim ForwardSampler as new MyForwardSampler dim ReverseSampler as new MyReverseSampler dim hsRGB as LCMS2ProfileMBS // some transform to generate sample data if (lUseAboveRGB) then hsRGB = Create_AboveRGB else hsRGB = LCMS2ProfileMBS.CreateSRGBProfile(ContextID) end if dim hLab as LCMS2ProfileMBS = LCMS2ProfileMBS.CreateLab4Profile(ContextID) dim hLimit as LCMS2ProfileMBS = LCMS2ProfileMBS.CreateInkLimitingDeviceLink(ContextID, LCMS2MBS.kcmsSigCmykData, InkLimit) dim channels as UInt32 = LCMS2MBS.CHANNELS_SH(4) dim bytes as UInt32 = LCMS2MBS.BYTES_SH(0) dim float as UInt32 = LCMS2MBS.FLOAT_SH(1) dim cmykfrm as UInt32 = Bitwise.BitOr( float, bytes, channels) dim flags as integer = BitwiseOr( LCMS2MBS.kcmsFLAGS_NOOPTIMIZE, LCMS2MBS.kcmsFLAGS_NOCACHE ) dim hLab2sRGB as LCMS2TransformMBS = LCMS2TransformMBS.CreateTransform(hLab, LCMS2MBS.kTYPE_Lab_16, hsRGB, LCMS2MBS.kTYPE_RGB_DBL, LCMS2MBS.kINTENT_PERCEPTUAL, LCMS2MBS.kcmsFLAGS_NOOPTIMIZE + LCMS2MBS.kcmsFLAGS_NOCACHE) dim sRGB2Lab as LCMS2TransformMBS = LCMS2TransformMBS.CreateTransform(hsRGB, LCMS2MBS.kTYPE_RGB_DBL, hLab, LCMS2MBS.kTYPE_Lab_16, LCMS2MBS.kINTENT_PERCEPTUAL, LCMS2MBS.kcmsFLAGS_NOOPTIMIZE + LCMS2MBS.kcmsFLAGS_NOCACHE) dim hIlimit as LCMS2TransformMBS = LCMS2TransformMBS.CreateTransform(hLimit, cmykfrm, nil, LCMS2MBS.kTYPE_CMYK_16, LCMS2MBS.kINTENT_PERCEPTUAL, flags) ForwardSampler.hLab2sRGB = hLab2sRGB ForwardSampler.sRGB2Lab = sRGB2Lab ForwardSampler.hIlimit = hIlimit ReverseSampler.hLab2sRGB = hLab2sRGB ReverseSampler.sRGB2Lab = sRGB2Lab ReverseSampler.hIlimit = hIlimit // create profile dim hICC as LCMS2ProfileMBS = LCMS2ProfileMBS.CreateProfilePlaceholder if hICC = nil then break return nil end if hICC.ProfileVersion = 4.3 hICC.DeviceClass = LCMS2MBS.kcmsSigOutputClass hICC.ColorSpaceType = LCMS2MBS.kcmsSigCmykData hICC.PCS = LCMS2MBS.kcmsSigLabData BToA0 = new LCMS2PipelineMBS(ContextID, 3, 4) CLUT = LCMS2StageMBS.CreateStageWithCLut16bit(ContextID, 17, 3, 4) if CLUT = nil then break return nil end if call CLUT.SampleCLut16bit(ForwardSampler, 0) // we need dummy curves, so make dummy one dim curves(0) as LCMS2ToneCurveMBS curves(0) = LCMS2ToneCurveMBS.BuildGamma(nil, 1.0) Curves.append curves(0) Curves.append curves(0) dim CurveStage3 as LCMS2StageMBS = LCMS2StageMBS.CreateStageWithToneCurves(ContextID, Curves) Curves.append curves(0) dim CurveStage4 as LCMS2StageMBS = LCMS2StageMBS.CreateStageWithToneCurves(ContextID, Curves) call BToA0.InsertStage BToA0.kAtBegin, CurveStage3 call BToA0.InsertStage BToA0.kAtEnd, CLUT call BToA0.InsertStage BToA0.kAtEnd, CurveStage4 if not hICC.WritePipeline(LCMS2MBS.kcmsSigBToA0Tag, BToA0) then break return nil end if AToB0 = new LCMS2PipelineMBS(ContextID, 4, 3) CLUT = LCMS2StageMBS.CreateStageWithCLut16bit(ContextID, 17, 4, 3) if clut = nil then break return nil end if call clut.SampleCLut16bit(ReverseSampler, 0) call AToB0.InsertStage AToB0.kAtBegin, CurveStage4 call AToB0.InsertStage AToB0.kAtEnd, CLUT call AToB0.InsertStage AToB0.kAtEnd, CurveStage3 if not hICC.WritePipeline(LCMS2MBS.kcmsSigAToB0Tag, AToB0) then break return nil end if if not hICC.LinkTag(LCMS2MBS.kcmsSigAToB1Tag, LCMS2MBS.kcmsSigAToB0Tag) then break Return nil end if if not hICC.LinkTag(LCMS2MBS.kcmsSigAToB2Tag, LCMS2MBS.kcmsSigAToB0Tag) then break Return nil end if if not hICC.LinkTag(LCMS2MBS.kcmsSigBToA1Tag, LCMS2MBS.kcmsSigBToA0Tag) then break Return nil end if if not hICC.LinkTag(LCMS2MBS.kcmsSigBToA2Tag, LCMS2MBS.kcmsSigBToA0Tag) then break Return nil end if dim DescriptionMLU as new LCMS2MLUMBS(nil, 1) dim CopyrightMLU as new LCMS2MLUMBS(nil, 1) call DescriptionMLU.setUnicode "en", "US", "RGB built-in" call CopyrightMLU.setUnicode "en", "US", "No copyright, use freely" call hICC.WriteMLU LCMS2MBS.kcmsSigProfileDescriptionTag, DescriptionMLU call hICC.WriteMLU LCMS2MBS.kcmsSigCopyrightTag, CopyrightMLU dim whitepoint as LCMS2CIExyYMBS = LCMS2MBS.WhitePointFromTemp(6504) if whitepoint<>nil then call hICC.WriteCIEXYZ LCMS2MBS.kcmsSigMediaWhitePointTag, LCMS2MBS.D50_XYZ dim WhitePointXYZ as LCMS2CIEXYZMBS = WhitePoint.XYZ dim CHAD as LCMS2MAT3MBS CHAD = LCMS2MBS.AdaptationMatrix(nil, WhitePointXYZ, LCMS2MBS.D50_XYZ) // This is a V4 tag, but many CMM does read and understand it no matter which version call hICC.WriteChromaticAdaptation(CHAD) end if return hICC End Function
Function Create_AboveRGB() As LCMS2ProfileMBS dim Curve(3) as LCMS2ToneCurveMBS dim hProfile as LCMS2ProfileMBS dim d65 as LCMS2CIExyYMBS = LCMS2MBS.WhitePointFromTemp(6504) dim Primaries as LCMS2CIExyYTripleMBS Primaries.Red = new LCMS2CIExyYMBS(0.64, 0.33, 1) Primaries.Green = new LCMS2CIExyYMBS(0.21, 0.71, 1) Primaries.Blue = new LCMS2CIExyYMBS(0.15, 0.06, 1) Curve(0) = LCMS2ToneCurveMBS.BuildGamma(nil, 2.19921875) Curve(1) = curve(0) Curve(2) = curve(0) hProfile = LCMS2ProfileMBS.CreateRGBProfile(nil, d65, Primaries, Curve) return hProfile End Function
Sub Error(context as LCMS2ContextMBS, ErrorCode as UInt32, Text as string) // Teil des Interfaces von LCMS2ErrorHandlerMBS MsgBox text End Sub
End Class
Class ProfileWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub ExpandRow(row As Integer) dim v as Variant = me.RowTag(row) Add v End EventHandler
End Control
Sub Add(tag as Uint32, name as string) dim c as Variant = p.ReadTag(tag) if c<>Nil then List.AddFolder name List.RowTag(List.LastIndex) = c else AddRaw tag, name end if End Sub
Sub Add(v as Variant) if v = nil then // ignore elseif v isa LCMS2CIEXYZMBS then AddCIEXYZ v elseif v isa LCMS2SequenceMBS then AddSequence v elseif v isa LCMS2PipelineMBS then AddPipeline v elseif v isa LCMS2NamedColorListMBS then AddNamedColorList v elseif v isa LCMS2ScreeningMBS then AddScreening v elseif v isa LCMS2ICCDataMBS then AddICCData v elseif v isa LCMS2MLUMBS then AddMLU v elseif v isa LCMS2CIExyYTripleMBS then AddCIExyYTriple v elseif v isa MemoryBlock then AddMemoryblock v elseif v isa LCMS2SequenceDescriptionMBS then AddSequenceDescription v elseif v isa LCMS2ToneCurveMBS then AddToneCurve v elseif v isa LCMS2StageMBS then AddStage v elseif v.IsArray then else break // some type is missing here end if End Sub
Sub AddCIEXYZ(x as LCMS2CIEXYZMBS) List.AddRow "CIE XYZ" List.AddRow "xyz point", str(x.x)+"/"+str(x.y)+"/"+str(x.z) dim l as LCMS2CIELabMBS = x.Lab if l<>Nil then List.AddRow "as lab", str(l.l)+"/"+str(l.a)+"/"+str(l.b) end if dim y as LCMS2CIExyYMBS = x.xyY if y<>Nil then List.AddRow "as xyY", str(y.x)+"/"+str(y.Y)+"/"+str(y.yy) end if End Sub
Sub AddCIExyYTriple(v as LCMS2CIExyYTripleMBS) List.AddRow "CIE xyY Triple" dim r as LCMS2CIExyYMBS = v.Red dim g as LCMS2CIExyYMBS = v.Green dim b as LCMS2CIExyYMBS = v.Blue List.AddRow "Red", str(r.x)+"/"+str(r.y)+"/"+str(r.yy) List.AddRow "Green", str(g.x)+"/"+str(g.y)+"/"+str(g.yy) List.AddRow "Blue", str(b.x)+"/"+str(b.y)+"/"+str(b.yy) End Sub
Sub AddICCData(n as LCMS2ICCDataMBS) List.AddRow "ICC Data" List.AddRow "Length",str(n.Size) List.AddRow "Flags",str(n.Flags) dim m as MemoryBlock = n.Data if m<>Nil then dim size as integer = m.size if size > 100 then size = 100 end if dim s as string = m.StringValue(0,size) List.AddRow "Data", EncodingToHexMBS(s) List.AddRow "Text", ClearText(s) end if End Sub
Sub AddMLU(n as LCMS2MLUMBS) List.AddRow "MLU" dim s as string = n.getUnicode("en", n.kNoCountry) if s<>"" then List.AddRow "Unicode Text", s else s = n.getASCII("en", n.kNoCountry) if s<>"" then List.AddRow "ASCII Text", s end if end if End Sub
Sub AddMemoryblock(m as MemoryBlock) dim size as integer = m.size List.AddRow "Length",str(Size) if size > 100 then size = 100 end if dim s as string = m.StringValue(0,size) List.AddRow "Data", EncodingToHexMBS(s) List.AddRow "Text", ClearText(s) End Sub
Sub AddNamedColorList(n as LCMS2NamedColorListMBS) List.AddRow "Named Color List" dim c as integer = n.Count List.AddRow "Color Count", str(c) dim u as integer = n.Count-1 for i as integer = 0 to u List.AddRow "Name "+str(i), n.Name(i) List.AddRow "Prefix "+str(i), n.Prefix(i) List.AddRow "Suffix "+str(i), n.Suffix(i) dim PCSs(-1) as string dim colorants(-1) as string dim PCS(-1) as integer = n.PCS(i) dim Colorant(-1) as integer = n.Colorant(i) for each xx as integer in PCS PCSs.Append str(xx) next for each xx as integer in Colorant Colorants.Append str(xx) next List.AddRow "PCS "+str(i), Join(PCSs, ", ") dim l as LCMS2CIELabMBS if p.ProfileVersion = 4 then l = LCMS2MBS.LabEncoded2Float(PCS(0), PCS(1), PCS(2)) else l = LCMS2MBS.LabEncoded2FloatV2(PCS(0), PCS(1), PCS(2)) end if if l<>nil then List.AddRow "PCS as Lab "+str(i), str(l.l)+"/"+str(l.a)+"/"+str(l.b) end if dim ll as LCMS2CIEXYZMBS ll = LCMS2MBS.XYZEncoded2Float(PCS(0), PCS(1), PCS(2)) if ll<>nil then List.AddRow "PCS as XYZ "+str(i), str(ll.x)+"/"+str(ll.y)+"/"+str(ll.z) end if List.AddRow "Colorant "+str(i), Join(colorants, ", ") next End Sub
Sub AddPipeline(v as LCMS2PipelineMBS) List.AddRow "Pipeline" List.AddRow "InputChannels", str(v.InputChannels) List.AddRow "OutputChannels", str(v.OutputChannels) List.AddRow "StageCount", str(v.StageCount) dim stages() as LCMS2StageMBS = v.Stages for each stage as LCMS2StageMBS in stages List.AddFolder "Stage" List.RowTag(List.LastIndex) = stage next dim m1 as new MemoryBlock(4*16) dim m2 as new MemoryBlock(4*16) for i as integer = 0 to 15 m1.SingleValue(i*4) = 1.0 next v.EvalFloat m1,m2 dim u as integer = v.OutputChannels-1 for i as integer = 0 to u List.AddRow "Channel "+str(i)+" with 1.0 gives", str(m2.SingleValue(4*i)) next End Sub
Sub AddRaw(tag as UInt32, name as string) dim c as MemoryBlock = p.ReadRawTag(tag) if c<>Nil then List.AddFolder name List.RowTag(List.LastIndex) = c end if End Sub
Sub AddScreening(v as LCMS2ScreeningMBS) List.AddRow "Screening" List.AddRow "Channels", str(v.Channels) List.AddRow "Flags", str(v.Flag) dim u as integer = v.Channels-1 for i as integer = 0 to u dim s as LCMS2ScreeningChannelMBS = v.Channel(i) List.AddRow "Channel "+str(i), str(s.Frequency)+"/"+str(s.ScreenAngle)+"/"+str(s.SpotShape) next End Sub
Sub AddSequence(v as LCMS2SequenceMBS) List.AddRow "Sequence" List.AddRow "Count", str(v.Count) dim u as integer = v.Count-1 for i as integer = 0 to u dim c as LCMS2SequenceDescriptionMBS = v.Description(i) List.AddFolder str(i)+". description" List.RowTag(List.LastIndex) = c next End Sub
Sub AddSequenceDescription(v as LCMS2SequenceDescriptionMBS) List.AddRow "AttributeFlags", hex(v.AttributeFlags) List.AddFolder "Description" List.RowTag(List.LastIndex) = v.Description List.AddRow "DeviceMfg", hex(v.DeviceMfg) List.AddRow "DeviceModel", hex(v.DeviceModel) List.AddFolder "Manufacturer" List.RowTag(List.LastIndex) = v.Manufacturer List.AddFolder "Model" List.RowTag(List.LastIndex) = v.Model List.AddRow "ProfileID", EncodingToHexMBS(v.ProfileID) List.AddRow "Technology", hex(v.Technology) End Sub
Sub AddStage(stage as LCMS2StageMBS) dim s as string = "" Select case stage.Type case LCMS2MBS.kcmsSigCurveSetElemType s = ": CurveSet" case LCMS2MBS.kcmsSigMatrixElemType s = ": Matrix" case LCMS2MBS.kcmsSigCLutElemType s = ": CLut" case LCMS2MBS.kcmsSigBAcsElemType s = ": BAcs" case LCMS2MBS.kcmsSigEAcsElemType s = ": EAcs" case LCMS2MBS.kcmsSigIdentityElemType s = ": identity" end Select List.AddRow "Stage.Type", hex(stage.Type)+s List.AddRow "Stage.InputChannels", str(stage.InputChannels) List.AddRow "Stage.OutputChannels", str(stage.OutputChannels) Select case stage.Type case LCMS2MBS.kcmsSigCurveSetElemType dim t(-1) as LCMS2ToneCurveMBS = stage.ToneCurves for each tt as LCMS2ToneCurveMBS in t List.AddFolder "Tone Curve" List.RowTag(List.LastIndex) = tt next case LCMS2MBS.kcmsSigMatrixElemType case LCMS2MBS.kcmsSigCLutElemType List.AddRow "CLutEntries", str(stage.CLutEntries) case LCMS2MBS.kcmsSigBAcsElemType case LCMS2MBS.kcmsSigEAcsElemType end Select End Sub
Sub AddToneCurve(v as LCMS2ToneCurveMBS) List.AddRow "Tone Curve" List.AddRow "IsDescending", str(v.IsDescending) List.AddRow "IsLinear", str(v.IsLinear) List.AddRow "IsMonotonic", str(v.IsMonotonic) List.AddRow "IsMultisegment", str(v.IsMultisegment) List.AddRow "ParametricType", str(v.ParametricType) End Sub
Function ClearText(s as string) As string dim m as MemoryBlock = s dim u as integer = m.Size-1 for i as integer = 0 to u if m.Byte(i)<32 then m.Byte(i) = asc(".") elseif m.Byte(i)>127 then m.Byte(i) = asc(".") end if next Return m End Function
Function GetColorSpaceTypeName(x as integer) As string Select case x case LCMS2MBS.kcmsSigXYZData return "XYZ" case LCMS2MBS.kcmsSigLabData return "Lab" case LCMS2MBS.kcmsSigLuvData return "Luv" case LCMS2MBS.kcmsSigYCbCrData return "YCbCr" case LCMS2MBS.kcmsSigYxyData return "Yxy" case LCMS2MBS.kcmsSigRgbData return "Rgb" case LCMS2MBS.kcmsSigGrayData return "Gray" case LCMS2MBS.kcmsSigHsvData return "Hsv" case LCMS2MBS.kcmsSigHlsData return "Hls" case LCMS2MBS.kcmsSigCmykData return "Cmyk" case LCMS2MBS.kcmsSigCmyData return "Cmy" case LCMS2MBS.kcmsSigMCH1Data return "MCH1" case LCMS2MBS.kcmsSigMCH2Data return "MCH2" case LCMS2MBS.kcmsSigMCH3Data return "MCH3" case LCMS2MBS.kcmsSigMCH4Data return "MCH4" case LCMS2MBS.kcmsSigMCH5Data return "MCH5" case LCMS2MBS.kcmsSigMCH6Data return "MCH6" case LCMS2MBS.kcmsSigMCH7Data return "MCH7" case LCMS2MBS.kcmsSigMCH8Data return "MCH8" case LCMS2MBS.kcmsSigMCH9Data return "MCH9" case LCMS2MBS.kcmsSigMCHAData return "MCHA" case LCMS2MBS.kcmsSigMCHBData return "MCHB" case LCMS2MBS.kcmsSigMCHCData return "MCHC" case LCMS2MBS.kcmsSigMCHDData return "MCHD" case LCMS2MBS.kcmsSigMCHEData return "MCHE" case LCMS2MBS.kcmsSigMCHFData return "MCHF" case LCMS2MBS.kcmsSigNamedData return "Named" case LCMS2MBS.kcmsSig1colorData return "1color" case LCMS2MBS.kcmsSig2colorData return "2color" case LCMS2MBS.kcmsSig3colorData return "3color" case LCMS2MBS.kcmsSig4colorData return "4color" case LCMS2MBS.kcmsSig5colorData return "5color" case LCMS2MBS.kcmsSig6colorData return "6color" case LCMS2MBS.kcmsSig7colorData return "7color" case LCMS2MBS.kcmsSig8colorData return "8color" case LCMS2MBS.kcmsSig9colorData return "9color" case LCMS2MBS.kcmsSig10colorData return "10color" case LCMS2MBS.kcmsSig11colorData return "11color" case LCMS2MBS.kcmsSig12colorData return "12color" case LCMS2MBS.kcmsSig13colorData return "13color" case LCMS2MBS.kcmsSig14colorData return "14color" case LCMS2MBS.kcmsSig15colorData return "15color" case LCMS2MBS.kcmsSigLuvKData return "LuvK" else Return "?" end Select End Function
Function GetDeviceClassName(x as uint32) As string select case x case LCMS2MBS.kcmsSigInputClass return "Input" case LCMS2MBS.kcmsSigDisplayClass return "Display" case LCMS2MBS.kcmsSigOutputClass return "Output" case LCMS2MBS.kcmsSigLinkClass return "Link" case LCMS2MBS.kcmsSigAbstractClass return "Abstract" case LCMS2MBS.kcmsSigColorSpaceClass return "ColorSpace" case LCMS2MBS.kcmsSigNamedColorClass return "NamedColor" else Return "?" end Select End Function
Sub Run(p as LCMS2ProfileMBS) self.p = p 'List.AddRow "Handle", hex(p.Handle) // EncodingToHexMBS from Util plugin List.AddRow "Name", p.name List.AddRow "HeaderProfileID", EncodingToHexMBS(p.HeaderProfileID) List.AddRow "ProfileICCversion", hex(p.ProfileICCversion) List.AddRow "ProfileVersion", hex(p.ProfileVersion) List.AddRow "PCS", str(p.PCS) List.AddRow "DeviceClass", hex(p.DeviceClass)+": "+GetDeviceClassName(p.DeviceClass) List.AddRow "TagCount", str(p.TagCount) List.AddRow "HeaderFlags", str(p.HeaderFlags) List.AddRow "HeaderAttributes", str(p.HeaderAttributes) List.AddRow "RenderingIntent", str(p.RenderingIntent) List.AddRow "ColorSpaceType", hex(p.ColorSpaceType)+": "+GetColorSpaceTypeName(p.ColorSpaceType) List.AddRow "ChannelCount", str(p.ChannelCount) List.AddRow "HeaderManufacturer", str(p.HeaderManufacturer) List.AddRow "HeaderModel", str(p.HeaderModel) List.AddRow "IsMatrixShaper",str(p.IsMatrixShaper) dim d as LCMS2DateMBS = p.HeaderCreationDateTime if d = nil then List.AddRow "HeaderCreationDateTime", "n/a" else dim da as new date da.Year = d.Year+1900 da.Month = d.Month da.day = d.Day da.Minute = d.Minute da.Hour = d.Hour da.Second = d.Second List.AddRow "HeaderCreationDateTime", da.SQLDateTime end if Add LCMS2MBS.kcmsSigAToB0Tag, "A to B 0" Add LCMS2MBS.kcmsSigAToB1Tag, "A to B 1" Add LCMS2MBS.kcmsSigAToB2Tag, "A to B 2" Add LCMS2MBS.kcmsSigBlueColorantTag, "BlueColorant" Add LCMS2MBS.kcmsSigBlueMatrixColumnTag, "BlueMatrixColumn" Add LCMS2MBS.kcmsSigBlueTRCTag, "BlueTRC" Add LCMS2MBS.kcmsSigBToA0Tag, "B to A 0" Add LCMS2MBS.kcmsSigBToA1Tag, "B to A 1" Add LCMS2MBS.kcmsSigBToA2Tag, "B to A 2" Add LCMS2MBS.kcmsSigCalibrationDateTimeTag, "CalibrationDateTime" Add LCMS2MBS.kcmsSigCharTargetTag, "CharTarget" Add LCMS2MBS.kcmsSigChromaticAdaptationTag, "ChromaticAdaptation" Add LCMS2MBS.kcmsSigChromaticityTag, "Chromaticity" Add LCMS2MBS.kcmsSigColorantOrderTag, "ColorantOrder" Add LCMS2MBS.kcmsSigColorantTableTag, "ColorantTable" Add LCMS2MBS.kcmsSigColorantTableOutTag, "ColorantTableOut" Add LCMS2MBS.kcmsSigColorimetricIntentImageStateTag, "ColorimetricIntentImageState" Add LCMS2MBS.kcmsSigCopyrightTag, "Copyright" Add LCMS2MBS.kcmsSigCrdInfoTag, "CrdInfo" Add LCMS2MBS.kcmsSigDataTag, "Data" Add LCMS2MBS.kcmsSigDateTimeTag, "DateTime" Add LCMS2MBS.kcmsSigDeviceMfgDescTag, "DeviceMfgDesc" Add LCMS2MBS.kcmsSigDeviceModelDescTag, "DeviceModelDesc" Add LCMS2MBS.kcmsSigDeviceSettingsTag, "DeviceSettings" Add LCMS2MBS.kcmsSigDToB0Tag, "D to B 0" Add LCMS2MBS.kcmsSigDToB1Tag, "D to B 1" Add LCMS2MBS.kcmsSigDToB2Tag, "D to B 2" Add LCMS2MBS.kcmsSigDToB3Tag, "D to B 3" Add LCMS2MBS.kcmsSigBToD0Tag, "B to D 0" Add LCMS2MBS.kcmsSigBToD1Tag, "B to D 1" Add LCMS2MBS.kcmsSigBToD2Tag, "B to D 2" Add LCMS2MBS.kcmsSigBToD3Tag, "B to D 3" Add LCMS2MBS.kcmsSigGamutTag, "Gamut" Add LCMS2MBS.kcmsSigGrayTRCTag, "GrayTRC" Add LCMS2MBS.kcmsSigGreenColorantTag, "GreenColorant" Add LCMS2MBS.kcmsSigGreenMatrixColumnTag, "GreenMatrixColumn" Add LCMS2MBS.kcmsSigGreenTRCTag, "GreenTRC" Add LCMS2MBS.kcmsSigLuminanceTag, "Luminance" Add LCMS2MBS.kcmsSigMeasurementTag, "Measurement" Add LCMS2MBS.kcmsSigMediaBlackPointTag, "MediaBlackPoint" Add LCMS2MBS.kcmsSigMediaWhitePointTag, "MediaWhitePoint" Add LCMS2MBS.kcmsSigNamedColorTag, "NamedColor" Add LCMS2MBS.kcmsSigNamedColor2Tag, "NamedColor2" Add LCMS2MBS.kcmsSigOutputResponseTag, "OutputResponse" Add LCMS2MBS.kcmsSigPerceptualRenderingIntentGamutTag, "PerceptualRenderingIntentGamut" Add LCMS2MBS.kcmsSigPreview0Tag, "Preview0" Add LCMS2MBS.kcmsSigPreview1Tag, "Preview1" Add LCMS2MBS.kcmsSigPreview2Tag, "Preview2" Add LCMS2MBS.kcmsSigProfileDescriptionTag, "ProfileDescription" Add LCMS2MBS.kcmsSigProfileSequenceDescTag, "ProfileSequenceDesc" Add LCMS2MBS.kcmsSigProfileSequenceIdTag, "ProfileSequenceId" Add LCMS2MBS.kcmsSigPs2CRD0Tag, "PS 2 CRD 0" Add LCMS2MBS.kcmsSigPs2CRD1Tag, "PS 2 CRD 1" Add LCMS2MBS.kcmsSigPs2CRD2Tag, "PS 2 CRD 2" Add LCMS2MBS.kcmsSigPs2CRD3Tag, "PS 2 CRD 3" Add LCMS2MBS.kcmsSigPs2CSATag, "PS 2 CSA" Add LCMS2MBS.kcmsSigPs2RenderingIntentTag, "PS 2 RenderingIntent" Add LCMS2MBS.kcmsSigRedColorantTag, "RedColorant" Add LCMS2MBS.kcmsSigRedMatrixColumnTag, "RedMatrixColumn" Add LCMS2MBS.kcmsSigRedTRCTag, "RedTRC" Add LCMS2MBS.kcmsSigSaturationRenderingIntentGamutTag, "SaturationRenderingIntentGamut" Add LCMS2MBS.kcmsSigScreeningDescTag, "ScreeningDesc" Add LCMS2MBS.kcmsSigScreeningTag, "Screening" Add LCMS2MBS.kcmsSigTechnologyTag, "Technology" Add LCMS2MBS.kcmsSigUcrBgTag, "UcrBg" Add LCMS2MBS.kcmsSigViewingCondDescTag, "ViewingCondDesc" Add LCMS2MBS.kcmsSigViewingConditionsTag, "ViewingConditions" Add LCMS2MBS.kcmsSigVcgtTag, "Vcgt" Add LCMS2MBS.kcmsSigMetaTag, "Meta" dim c as integer = List.ListCount-1 for i as integer = c DownTo 0 List.Expanded(i) = true next End Sub
Property p As LCMS2ProfileMBS
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
Module Module1
Sub AddRow(extends l as listbox, s as string, t as string) l.AddRow s l.Cell(l.LastIndex,1)=t End Sub
End Module
Filetype ICC Profile
End FileTypes1
Class MyForwardSampler Inherits LCMS2StageSamplerMBS
EventHandler Function SamplerInteger(InValues as Ptr, OutValues as Ptr, InputChannels as integer, OutputChannels as integer) As boolean call hLab2sRGB.Transform(InValues, rgb, 1) // this is a very bad way to make cmy from rgb dim c as double = 1.0 - rgb.DoubleValue(0) dim m as double = 1.0 - rgb.DoubleValue(8) dim y as double = 1.0 - rgb.DoubleValue(16) dim k as double if c < m then k = min(c, y) else k = min(m, y) end if // NONSENSE WARNING!: I'm doing this just because this is a test // profile that may have ink limit up to 400%. There is no UCR here // so the profile is basically useless for anything but testing. cmyk.doubleValue( 0) = c cmyk.doubleValue( 8) = m cmyk.doubleValue(16) = y cmyk.doubleValue(24) = k call hIlimit.Transform(cmyk, OutValues, 1) return true End EventHandler
Shared Function Clip(v as Double) As Double if v < 0.0 then Return 0 end if if v > 1.0 then Return 1 end if Return v End Function
Sub Constructor() rgb = new MemoryBlock(4*8) cmyk = new MemoryBlock(4*8) End Sub
Property cmyk As MemoryBlock
Property hIlimit As LCMS2TransformMBS
Property hLab2sRGB As LCMS2TransformMBS
Property rgb As MemoryBlock
Property sRGB2Lab As LCMS2TransformMBS
End Class
Class MyReverseSampler Inherits LCMS2StageSamplerMBS
EventHandler Function SamplerInteger(InValues as Ptr, OutValues as Ptr, InputChannels as integer, OutputChannels as integer) As boolean dim c as double = InValues.UInt16(0) / 65535.0 dim m as double = InValues.UInt16(2) / 65535.0 dim y as double = InValues.UInt16(4) / 65535.0 dim k as double = InValues.UInt16(6) / 65535.0 if k = 0 then rgb.doublevalue( 0) = Clip(1 - c) rgb.doublevalue( 8) = Clip(1 - m) rgb.doublevalue(16) = Clip(1 - y) else if k = 1 then rgb.doublevalue( 0) = 0 rgb.doublevalue( 8) = 0 rgb.doublevalue(16) = 0 else rgb.doublevalue( 0) = Clip((1 - c) * (1 - k)) rgb.doublevalue( 8) = Clip((1 - m) * (1 - k)) rgb.doublevalue(16) = Clip((1 - y) * (1 - k)) end if end if call sRGB2Lab.Transform(rgb, OutValues, 1) Return true End EventHandler
Shared Function Clip(v as Double) As Double if v < 0.0 then Return 0 end if if v > 1.0 then Return 1 end if Return v End Function
Sub Constructor() rgb = new MemoryBlock(4*8) cmyk = new MemoryBlock(4*8) End Sub
Property cmyk As MemoryBlock
Property hIlimit As LCMS2TransformMBS
Property hLab2sRGB As LCMS2TransformMBS
Property rgb As MemoryBlock
Property sRGB2Lab As LCMS2TransformMBS
End Class
End Project

See also:

Feedback, Comments & Corrections

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

MBS Xojo Plugins