Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Images Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/LCMS2/Create Profile
This example is the version from Mon, 16th Mar 2014.
Project "Create Profile.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
EventHandler Sub Open()
lcms2mbs.SetLogErrorHandler ErrorLog
CreateRGB1
CreateRGB2
CreateGray1
CreateGrayLab1
if ErrorLog.Visible = false then
quit
end if
End EventHandler
Sub CreateGray1()
// A gamma-2.2 gray space
dim curve as LCMS2ToneCurveMBS = LCMS2ToneCurveMBS.BuildGamma(nil, 2.2)
dim profile as LCMS2ProfileMBS = LCMS2ProfileMBS.CreateGrayProfile(nil, LCMS2MBS.D50_xyY, curve)
dim file as FolderItem = SpecialFolder.Desktop.Child("gray1.icc")
call profile.SaveProfileToFile(file)
End Sub
Sub CreateGrayLab1()
// A gamma-2.2 gray space
dim curve as LCMS2ToneCurveMBS = LCMS2ToneCurveMBS.BuildGamma(nil, 1.0)
dim profile as LCMS2ProfileMBS = LCMS2ProfileMBS.CreateGrayProfile(nil, LCMS2MBS.D50_xyY, curve)
profile.PCS = LCMS2MBS.kcmsSigLabData
dim file as FolderItem = SpecialFolder.Desktop.Child("graylab1.icc")
call profile.SaveProfileToFile(file)
End Sub
Sub CreateRGB1()
dim Curve(2) as LCMS2ToneCurveMBS
dim Primaries as new 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)
dim d65 as LCMS2CIExyYMBS = LCMS2MBS.WhitePointFromTemp(6504)
dim profile as LCMS2ProfileMBS = LCMS2ProfileMBS.CreateRGBProfile(nil, D65, Primaries, Curve)
dim file as FolderItem = SpecialFolder.Desktop.Child("rgb1.icc")
call profile.SaveProfileToFile(file)
End Sub
Sub CreateRGB2()
dim Curve(2) as LCMS2ToneCurveMBS
dim Primaries as new 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)
dim whitepoint as LCMS2CIExyYMBS = LCMS2MBS.WhitePointFromTemp(6504)
dim profile as LCMS2ProfileMBS = LCMS2ProfileMBS.CreateProfilePlaceholder
profile.ProfileVersion = 4.3
profile.DeviceClass = LCMS2MBS.kcmsSigDisplayClass
profile.ColorSpaceType = LCMS2MBS.kcmsSigRgbData
profile.PCS = LCMS2MBS.kcmsSigXYZData
profile.renderingIntent = LCMS2MBS.kINTENT_PERCEPTUAL
// Implement profile using following tags:
//
// 1 cmsSigProfileDescriptionTag
// 2 cmsSigMediaWhitePointTag
// 3 cmsSigRedColorantTag
// 4 cmsSigGreenColorantTag
// 5 cmsSigBlueColorantTag
// 6 cmsSigRedTRCTag
// 7 cmsSigGreenTRCTag
// 8 cmsSigBlueTRCTag
// 9 Chromatic adaptation Tag
// This conforms a standard RGB DisplayProfile as says ICC, and then I add (As per addendum II)
// 10 cmsSigChromaticityTag
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 profile.WriteMLU LCMS2MBS.kcmsSigProfileDescriptionTag, DescriptionMLU
call profile.WriteMLU LCMS2MBS.kcmsSigCopyrightTag, CopyrightMLU
if whitepoint<>nil then
call profile.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 profile.WriteChromaticAdaptation(CHAD)
end if
if WhitePoint<>nil and Primaries<>nil then
dim MaxWhite as new LCMS2CIExyYMBS
MaxWhite.x = WhitePoint.x
MaxWhite.y = WhitePoint.y
MaxWhite.YY = 1.0
dim Colorants as new LCMS2CIEXYZTripleMBS
dim MColorants as LCMS2MAT3MBS
MColorants = LCMS2MBS.BuildRGB2XYZtransferMatrix(MaxWhite, Primaries)
Colorants.Red.X = MColorants.value(0).value(0)
Colorants.Red.Y = MColorants.value(1).value(0)
Colorants.Red.Z = MColorants.value(2).value(0)
Colorants.Green.X = MColorants.value(0).value(1)
Colorants.Green.Y = MColorants.value(1).value(1)
Colorants.Green.Z = MColorants.value(2).value(1)
Colorants.Blue.X = MColorants.value(0).value(2)
Colorants.Blue.Y = MColorants.value(1).value(2)
Colorants.Blue.Z = MColorants.value(2).value(2)
call profile.WriteCIEXYZ LCMS2MBS.kcmsSigRedColorantTag, Colorants.Red
call profile.WriteCIEXYZ LCMS2MBS.kcmsSigGreenColorantTag, Colorants.Green
call profile.WriteCIEXYZ LCMS2MBS.kcmsSigBlueColorantTag, Colorants.blue
end if
if UBound(curve)>=2 then
call profile.WriteToneCurve LCMS2MBS.kcmsSigRedTRCTag, curve(0)
call profile.WriteToneCurve LCMS2MBS.kcmsSigGreenTRCTag, curve(1)
call profile.WriteToneCurve LCMS2MBS.kcmsSigBlueTRCTag, curve(2)
end if
if Primaries<>Nil then
call profile.WriteChromaticity(Primaries)
end if
dim file as FolderItem = SpecialFolder.Desktop.Child("rgb2.icc")
call profile.SaveProfileToFile(file)
End Sub
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
End Module
Class ErrorLog Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
Sub Error(context as LCMS2ContextMBS, ErrorCode as UInt32, Text as string)
// Teil des Interfaces von LCMS2ErrorHandlerMBS
list.AddRow hex(ErrorCode)+": "+text
if me.Visible = false then
me.show
end if
End Sub
End Class
End Project
See also:
The items on this page are in the following plugins: MBS Images Plugin.