Platforms to show: All Mac Windows Linux Cross-Platform
/Win/ICM/Windows ICM Convert Picture
Required plugins for this example: MBS Win Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/ICM/Windows ICM Convert Picture
This example is the version from Sun, 17th Mar 2012.
Project "Windows ICM Convert Picture.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 ConvertToRight Inherits PushButton
ControlInstance ConvertToRight Inherits PushButton
EventHandler Sub Action()
ConvertColorToRight
End EventHandler
End Control
Control InputPicture Inherits Canvas
ControlInstance InputPicture Inherits Canvas
End Control
Control OutputPicture Inherits Canvas
ControlInstance OutputPicture Inherits Canvas
End Control
EventHandler Sub Open()
logo = LogoMBS(300)
InputPicture.Backdrop = logo
End EventHandler
Sub ConvertColorToRight()
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 p as new Picture(300, 300, 32)
if t.TranslatePictures(logo, p) then
OutputPicture.Backdrop = p
else
OutputPicture.Backdrop = nil
end if
End Sub
Property Protected InputProfile As WindowsICMProfileMBS
Property Protected OutputProfile As WindowsICMProfileMBS
Property logo As Picture
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.
