Platforms to show: All Mac Windows Linux Cross-Platform
/Win/ICM/Windows ICM Convert Colors
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.xojo_binary_project"
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:
The items on this page are in the following plugins: MBS Win Plugin.
