Platforms to show: All Mac Windows Linux Cross-Platform
/Images/LCMS2/Create a CMYK Profile
Required plugins for this example: MBS Util Plugin, MBS Images 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.xojo_binary_project"
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
FileTypes1
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:
The items on this page are in the following plugins: MBS Images Plugin.