Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/ICM/Windows ICM Convert Colors
Function:
Required plugins for this example: MBS Win Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/ICM/Windows ICM Convert Colors
This example is the version from Sun, 17th Mar 2012.
Project "Windows ICM Convert Colors.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class MainWindow Inherits Window
Control InputProfileGroup Inherits GroupBox
ControlInstance InputProfileGroup Inherits GroupBox
End Control
Control SelectInputProfileButton Inherits PushButton
ControlInstance SelectInputProfileButton Inherits PushButton
EventHandler Sub Action() dim f as FolderItem = GetopenFolderItem(FileTypes.All) if f = nil then Return dim b as BinaryStream = f.OpenAsBinaryFile(false) if b = nil then MsgBox "Failed to open file." Return end if dim s as string = b.Read(b.Length) if lenb(s) = 0 then MsgBox "Failed to read file." Return end if dim w as WindowsICMProfileMBS = WindowsICMProfileMBS.OpenProfileData(s, WindowsICMProfileMBS.PROFILE_READ) if b = nil then MsgBox "Failed to load profile." Return end if InputProfileName.text = f.DisplayName InputProfile = w InputProfileClass.text = w.ProfileClassName InputProfileColorspace.text = w.ProfileColorSpace End EventHandler
End Control
Control InputProfileName Inherits Label
ControlInstance InputProfileName Inherits Label
End Control
Control InputProfileClass Inherits Label
ControlInstance InputProfileClass Inherits Label
End Control
Control InputProfileColorspace Inherits Label
ControlInstance InputProfileColorspace Inherits Label
End Control
Control OutputProfileGroup Inherits GroupBox
ControlInstance OutputProfileGroup Inherits GroupBox
End Control
Control SelectOutputProfileButton Inherits PushButton
ControlInstance SelectOutputProfileButton Inherits PushButton
EventHandler Sub Action() dim f as FolderItem = GetopenFolderItem(FileTypes.All) if f = nil then Return dim b as BinaryStream = f.OpenAsBinaryFile(false) if b = nil then MsgBox "Failed to open file." Return end if dim s as string = b.Read(b.Length) if lenb(s) = 0 then MsgBox "Failed to read file." Return end if dim w as WindowsICMProfileMBS = WindowsICMProfileMBS.OpenProfileData(s, WindowsICMProfileMBS.PROFILE_READ) if b = nil then MsgBox "Failed to load profile." Return end if OutputProfileName.text = f.DisplayName OutputProfile = w OutputProfileClass.text = w.ProfileClassName OutputProfileColorspace.text = w.ProfileColorSpace End EventHandler
End Control
Control OutputProfileName Inherits Label
ControlInstance OutputProfileName Inherits Label
End Control
Control OutputProfileClass Inherits Label
ControlInstance OutputProfileClass Inherits Label
End Control
Control OutputProfileColorspace Inherits Label
ControlInstance OutputProfileColorspace Inherits Label
End Control
Control InputColorGroup Inherits GroupBox
ControlInstance InputColorGroup Inherits GroupBox
End Control
Control ilColor Inherits Label
ControlInstance ilColor(0) Inherits Label
ControlInstance ilColor(1) Inherits Label
ControlInstance ilColor(2) Inherits Label
ControlInstance ilColor(3) Inherits Label
ControlInstance ilColor(4) Inherits Label
ControlInstance ilColor(5) Inherits Label
ControlInstance ilColor(6) Inherits Label
ControlInstance ilColor(7) Inherits Label
End Control
Control InputPopupMenu Inherits PopupMenu
ControlInstance InputPopupMenu Inherits PopupMenu
EventHandler Sub Change() Select case me.ListIndex case 0 // Gray SetInputColors 1, "Gray" case 1 // RGB SetInputColors 3, "Red", "Green", "Blue" case 2 // CMYK SetInputColors 4, "Cyan", "Magenta", "Yellow", "Black" case 3 // Named Index SetInputColors 1, "Index" case 4 // Lab SetInputColors 3, "L", "a", "b" case 5 // XYZ SetInputColors 3, "X", "Y", "Z" case 6 // Yxy SetInputColors 3, "Y", "x", "y" case 7 // 3 Channels SetInputColors 3, "Channel 1", "Channel 2", "Channel 3" case 8 // 4 Channels SetInputColors 4, "Channel 1", "Channel 2", "Channel 3", "Channel 4" case 9 // 5 Channels SetInputColors 5, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5" case 10 // 6 Channels SetInputColors 6, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5", "Channel 6" case 11 // 7 Channels SetInputColors 7, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5", "Channel 6", "Channel 7" case 12 // 8 Channels SetInputColors 8, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5", "Channel 6", "Channel 7", "Channel 8" end Select End EventHandler
End Control
Control ieColor Inherits TextField
ControlInstance ieColor(0) Inherits TextField
ControlInstance ieColor(1) Inherits TextField
ControlInstance ieColor(2) Inherits TextField
ControlInstance ieColor(3) Inherits TextField
ControlInstance ieColor(4) Inherits TextField
ControlInstance ieColor(5) Inherits TextField
ControlInstance ieColor(6) Inherits TextField
ControlInstance ieColor(7) Inherits TextField
End Control
Control ConvertToRight Inherits PushButton
ControlInstance ConvertToRight Inherits PushButton
EventHandler Sub Action() ConvertColorToRight End EventHandler
End Control
Control OutputColorGroup Inherits GroupBox
ControlInstance OutputColorGroup Inherits GroupBox
End Control
Control olColor Inherits Label
ControlInstance olColor(0) Inherits Label
ControlInstance olColor(1) Inherits Label
ControlInstance olColor(2) Inherits Label
ControlInstance olColor(3) Inherits Label
ControlInstance olColor(4) Inherits Label
ControlInstance olColor(5) Inherits Label
ControlInstance olColor(6) Inherits Label
ControlInstance olColor(7) Inherits Label
End Control
Control OutputPopupMenu Inherits PopupMenu
ControlInstance OutputPopupMenu Inherits PopupMenu
EventHandler Sub Change() Select case me.ListIndex case 0 // Gray SetOutputColors 1, "Gray" case 1 // RGB SetOutputColors 3, "Red", "Green", "Blue" case 2 // CMYK SetOutputColors 4, "Cyan", "Magenta", "Yellow", "Black" case 3 // Named Index SetOutputColors 1, "Index" case 4 // Lab SetOutputColors 3, "L", "a", "b" case 5 // XYZ SetOutputColors 3, "X", "Y", "Z" case 6 // Yxy SetOutputColors 3, "Y", "x", "y" case 7 // 3 Channels SetOutputColors 3, "Channel 1", "Channel 2", "Channel 3" case 8 // 4 Channels SetOutputColors 4, "Channel 1", "Channel 2", "Channel 3", "Channel 4" case 9 // 5 Channels SetOutputColors 5, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5" case 10 // 6 Channels SetOutputColors 6, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5", "Channel 6" case 11 // 7 Channels SetOutputColors 7, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5", "Channel 6", "Channel 7" case 12 // 8 Channels SetOutputColors 8, "Channel 1", "Channel 2", "Channel 3", "Channel 4", "Channel 5", "Channel 6", "Channel 7", "Channel 8" end Select End EventHandler
End Control
Control oeColor Inherits TextField
ControlInstance oeColor(0) Inherits TextField
ControlInstance oeColor(1) Inherits TextField
ControlInstance oeColor(2) Inherits TextField
ControlInstance oeColor(3) Inherits TextField
ControlInstance oeColor(4) Inherits TextField
ControlInstance oeColor(5) Inherits TextField
ControlInstance oeColor(6) Inherits TextField
ControlInstance oeColor(7) Inherits TextField
End Control
Sub ConvertColorToRight() dim InputColor as new WindowsICMColorMBS dim InputColorType as integer Select case InputPopupMenu.ListIndex case 0 // Gray InputColor.gray = cdbl(ieColor(0).text) InputColorType = WindowsICMColorMBS.COLOR_GRAY case 1 // RGB InputColor.red = cdbl(ieColor(0).text) InputColor.green = cdbl(ieColor(1).text) InputColor.blue = cdbl(ieColor(2).text) InputColorType = WindowsICMColorMBS.COLOR_RGB case 2 // CMYK InputColor.cyan = cdbl(ieColor(0).text) InputColor.magenta = cdbl(ieColor(1).text) InputColor.yellow = cdbl(ieColor(2).text) InputColor.black = cdbl(ieColor(3).text) InputColorType = WindowsICMColorMBS.COLOR_CMYK case 3 // Named Index InputColor.Index = cdbl(ieColor(0).text) InputColorType = WindowsICMColorMBS.COLOR_NAMED case 4 // Lab InputColor.L = cdbl(ieColor(0).text) InputColor.a = cdbl(ieColor(1).text) InputColor.b = cdbl(ieColor(2).text) InputColorType = WindowsICMColorMBS.COLOR_Lab case 5 // XYZ InputColor.XYZ_X = cdbl(ieColor(0).text) InputColor.XYZ_Y = cdbl(ieColor(1).text) InputColor.XYZ_Z = cdbl(ieColor(2).text) InputColorType = WindowsICMColorMBS.COLOR_XYZ case 6 // Yxy InputColor.Yxy_YY = cdbl(ieColor(0).text) InputColor.Yxy_x = cdbl(ieColor(1).text) InputColor.Yxy_y = cdbl(ieColor(2).text) InputColorType = WindowsICMColorMBS.COLOR_Yxy case 7 // 3 Channels for i as integer = 0 to 2 InputColor.Channel(i) = cdbl(ieColor(i).text) next InputColorType = WindowsICMColorMBS.COLOR_3_CHANNEL case 8 // 4 Channels for i as integer = 0 to 3 InputColor.Channel(i) = cdbl(ieColor(i).text) next InputColorType = WindowsICMColorMBS.COLOR_CMYK case 9 // 5 Channels for i as integer = 0 to 4 InputColor.Channel(i) = cdbl(ieColor(i).text) next InputColorType = WindowsICMColorMBS.COLOR_5_CHANNEL case 10 // 6 Channels for i as integer = 0 to 5 InputColor.Channel(i) = cdbl(ieColor(i).text) next InputColorType = WindowsICMColorMBS.COLOR_6_CHANNEL case 11 // 7 Channels for i as integer = 0 to 6 InputColor.Channel(i) = cdbl(ieColor(i).text) next InputColorType = WindowsICMColorMBS.COLOR_7_CHANNEL case 12 // 8 Channels for i as integer = 0 to 7 InputColor.Channel(i) = cdbl(ieColor(i).text) next InputColorType = WindowsICMColorMBS.COLOR_8_CHANNEL else Return end Select dim OutputColorType as integer Select case OutputPopupMenu.ListIndex case 0 // Gray OutputColorType = WindowsICMColorMBS.COLOR_GRAY case 1 // RGB OutputColorType = WindowsICMColorMBS.COLOR_RGB case 2 // CMYK OutputColorType = WindowsICMColorMBS.COLOR_CMYK case 3 // Named Index OutputColorType = WindowsICMColorMBS.COLOR_NAMED case 4 // Lab OutputColorType = WindowsICMColorMBS.COLOR_Lab case 5 // XYZ OutputColorType = WindowsICMColorMBS.COLOR_XYZ case 6 // Yxy OutputColorType = WindowsICMColorMBS.COLOR_Yxy case 7 // 3 Channels OutputColorType = WindowsICMColorMBS.COLOR_3_CHANNEL case 8 // 4 Channels OutputColorType = WindowsICMColorMBS.COLOR_CMYK case 9 // 5 Channels OutputColorType = WindowsICMColorMBS.COLOR_5_CHANNEL case 10 // 6 Channels OutputColorType = WindowsICMColorMBS.COLOR_6_CHANNEL case 11 // 7 Channels OutputColorType = WindowsICMColorMBS.COLOR_7_CHANNEL case 12 // 8 Channels OutputColorType = WindowsICMColorMBS.COLOR_8_CHANNEL else Return end Select dim profiles(1) as WindowsICMProfileMBS profiles(0)=InputProfile profiles(1)=OutputProfile dim intents(1) as integer intents(0)=0 intents(1)=0 dim t as new WindowsICMTransformMBS(profiles, intents, 3, WindowsICMTransformMBS.INDEX_DONT_CARE) if t.Handle = 0 then MsgBox "Failed to create transform." end if dim InputColors(0) as WindowsICMColorMBS dim OutputColors(0) as WindowsICMColorMBS InputColors(0) = InputColor if t.TranslateColors(InputColors, InputColorType, OutputColors, OutputColorType) then dim OutputColor as WindowsICMColorMBS = OutputColors(0) Select case OutputPopupMenu.ListIndex case 0 // Gray oeColor(0).text = cstr(OutputColor.gray) case 1 // RGB oeColor(0).text = cstr(OutputColor.red) oeColor(1).text = cstr(OutputColor.green) oeColor(2).text = cstr(OutputColor.blue) case 2 // CMYK oeColor(0).text = cstr(OutputColor.cyan) oeColor(1).text = cstr(OutputColor.magenta) oeColor(2).text = cstr(OutputColor.yellow) oeColor(3).text = cstr(OutputColor.black) case 3 // Named Index InputColor.Index = cdbl(ieColor(0).text) InputColorType = WindowsICMColorMBS.COLOR_NAMED case 4 // Lab InputColor.L = cdbl(ieColor(0).text) InputColor.a = cdbl(ieColor(1).text) InputColor.b = cdbl(ieColor(2).text) InputColorType = WindowsICMColorMBS.COLOR_Lab case 5 // XYZ oeColor(0).text = cstr(OutputColor.XYZ_X) oeColor(1).text = cstr(OutputColor.XYZ_Y) oeColor(2).text = cstr(OutputColor.XYZ_Z) case 6 // Yxy oeColor(0).text = cstr(OutputColor.Yxy_YY) oeColor(1).text = cstr(OutputColor.Yxy_x) oeColor(2).text = cstr(OutputColor.Yxy_y) case 7 // 3 Channels for i as integer = 0 to 2 oeColor(i).text = cstr(OutputColor.Channel(i)) next case 8 // 4 Channels for i as integer = 0 to 3 oeColor(i).text = cstr(OutputColor.Channel(i)) next case 9 // 5 Channels for i as integer = 0 to 4 oeColor(i).text = cstr(OutputColor.Channel(i)) next case 10 // 6 Channels for i as integer = 0 to 5 oeColor(i).text = cstr(OutputColor.Channel(i)) next case 11 // 7 Channels for i as integer = 0 to 6 oeColor(i).text = cstr(OutputColor.Channel(i)) next case 12 // 8 Channels for i as integer = 0 to 7 oeColor(i).text = cstr(OutputColor.Channel(i)) next else Return end Select end if End Sub
Sub SetInputColors(n as integer, paramarray names as string) for i as integer = 0 to n-1 ilColor(i).text = names(i) ilColor(i).Visible = true ieColor(i).Visible = true next for i as integer = n to 7 ilColor(i).Visible = false ieColor(i).Visible = false next End Sub
Sub SetOutputColors(n as integer, paramarray names as string) for i as integer = 0 to n-1 olColor(i).text = names(i) olColor(i).Visible = true oeColor(i).Visible = true next for i as integer = n to 7 olColor(i).Visible = false oeColor(i).Visible = false next End Sub
Property Protected InputProfile As WindowsICMProfileMBS
Property Protected OutputProfile As WindowsICMProfileMBS
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
FileTypes
Filetype ICC Profile
End FileTypes
Module Util
Function ProfileClassName(extends w as WindowsICMProfileMBS) As string dim h as WindowsICMProfileHeaderMBS = w.ColorProfileHeader if h=nil then Return "?" Select case h.Classs case WindowsICMProfileHeaderMBS.CLASS_MONITOR Return "Monitor" case WindowsICMProfileHeaderMBS.CLASS_PRINTER Return "Printer" case WindowsICMProfileHeaderMBS.CLASS_SCANNER Return "Scanner" case WindowsICMProfileHeaderMBS.CLASS_LINK Return "Link" case WindowsICMProfileHeaderMBS.CLASS_ABSTRACT Return "Abstract" case WindowsICMProfileHeaderMBS.CLASS_COLORSPACE Return "Colorspace" case WindowsICMProfileHeaderMBS.CLASS_NAMED Return "Named" case WindowsICMProfileHeaderMBS.CLASS_CAMP Return "Camp" case WindowsICMProfileHeaderMBS.CLASS_GMMP Return "GNMP" else Return "Unknown: "+hex(h.Classs) end Select End Function
Function ProfileColorSpace(extends w as WindowsICMProfileMBS) As string dim h as WindowsICMProfileHeaderMBS = w.ColorProfileHeader if h=nil then Return "?" Select case h.DataColorSpace case WindowsICMProfileHeaderMBS.SPACE_XYZ Return "XYZ" case WindowsICMProfileHeaderMBS.SPACE_Lab Return "Lab" case WindowsICMProfileHeaderMBS.SPACE_Luv Return "Luv" case WindowsICMProfileHeaderMBS.SPACE_YCbCr Return "YCbCr" case WindowsICMProfileHeaderMBS.SPACE_Yxy Return "Yxy" case WindowsICMProfileHeaderMBS.SPACE_RGB Return "RGB" case WindowsICMProfileHeaderMBS.SPACE_GRAY Return "GRAY" case WindowsICMProfileHeaderMBS.SPACE_HSV Return "HSV" case WindowsICMProfileHeaderMBS.SPACE_HLS Return "HLS" case WindowsICMProfileHeaderMBS.SPACE_CMYK Return "CMYK" case WindowsICMProfileHeaderMBS.SPACE_CMY Return "CMY" case WindowsICMProfileHeaderMBS.SPACE_2_CHANNEL Return "2 Channel" case WindowsICMProfileHeaderMBS.SPACE_3_CHANNEL Return "2 Channel" case WindowsICMProfileHeaderMBS.SPACE_4_CHANNEL Return "2 Channel" case WindowsICMProfileHeaderMBS.SPACE_5_CHANNEL Return "2 Channel" case WindowsICMProfileHeaderMBS.SPACE_6_CHANNEL Return "2 Channel" case WindowsICMProfileHeaderMBS.SPACE_7_CHANNEL Return "2 Channel" case WindowsICMProfileHeaderMBS.SPACE_8_CHANNEL Return "2 Channel" else Return "Unknown: "+hex(h.DataColorSpace) end Select End Function
End Module
End Project

See also:

Feedback, Comments & Corrections

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





Links
MBS Xojo Chart Plugins