Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/ICM/Windows ICM Convert Picture
Function:
Required plugins for this example: MBS Main Plugin, 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 Picture
This example is the version from Sun, 17th Mar 2012.
Project "Windows ICM Convert Picture.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 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:

Feedback, Comments & Corrections

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





Links
MBS FileMaker Plugins