Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/LCMS2/Create Profile
Function:
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.rbp"
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:

Feedback, Comments & Corrections

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




Links
MBS FileMaker blog