Platforms to show: All Mac Windows Linux Cross-Platform

/Images/LCMS2/Profile Info


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/Profile Info

This example is the version from Sat, 27th Oct 2023.

Project "Profile Info.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
EventHandler Sub NewDocument() dim f as FolderItem = GetOpenFolderItem(FileTypes1.ICCProfile) if f<>Nil then OpenDocument f end if 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
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" // queries english or first one 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 // now query all languages Dim u As Integer = n.TranslationsCount-1 For i As Integer = 0 To u Dim language As String Dim country As String Dim b As Boolean = n.translationsCodes(0, language, country) If b Then If language <> "" Or country <> "" Then List.AddRow language+"-"+country, n.getUnicode(language, country) End If End If Next // and let us query all strings Dim strings() As String = n.UnicodeStrings u= strings.ubound For i As Integer = 0 To u List.AddRow "String "+Str(i), strings(i) Next 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" 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) List.AddRow "Average Gridpoints", str(pow(stage.CLutEntries/stage.OutputChannels, 1/stage.InputChannels)) 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 ICCProfile
End FileTypes1
End Project

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


The biggest plugin in space...