Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Win Plugin, MBS Util Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/ICM/Windows ICM
This example is the version from Thu, 31th Jul 2019.
Project "Windows ICM.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class MainWindow Inherits Window
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control StaticText2 Inherits Label
ControlInstance StaticText2 Inherits Label
EventHandler Sub Open()
dim f as FolderItem = WindowsICMModuleMBS.GetColorDirectory
if f=nil then
me.text = "?"
else
me.text = f.NativePath
end if
End EventHandler
End Control
Control StaticText3 Inherits Label
ControlInstance StaticText3 Inherits Label
End Control
Control StaticText4 Inherits Label
ControlInstance StaticText4 Inherits Label
EventHandler Sub Open()
me.text = WindowsICMModuleMBS.GetStandardColorSpaceProfile(WindowsICMModuleMBS.LCS_WINDOWS_COLOR_SPACE)
End EventHandler
End Control
Control StaticText5 Inherits Label
ControlInstance StaticText5 Inherits Label
EventHandler Sub Open()
me.text = WindowsICMModuleMBS.GetStandardColorSpaceProfile(WindowsICMModuleMBS.LCS_sRGB)
End EventHandler
End Control
Control StaticText6 Inherits Label
ControlInstance StaticText6 Inherits Label
End Control
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub DoubleClick()
dim s as string = me.Cell(me.ListIndex, 0)
dim f as FolderItem = GetFolderItem(s, FolderItem.PathTypeAbsolute)
if f = nil then
MsgBox "Failed to get folderitem for file."
Return
end if
dim p as WindowsICMProfileMBS = WindowsICMProfileMBS.OpenProfilePath(f.Name, WindowsICMProfileMBS.PROFILE_READ, WindowsICMProfileMBS.FILE_SHARE_READ, WindowsICMProfileMBS.OPEN_EXISTING)
if p=nil then
MsgBox "Failed to open profile."
else
InfoWindow.Load p
InfoWindow.Title = f.DisplayName
InfoWindow.show
end if
End EventHandler
EventHandler Sub Open()
dim c as new WindowsICMEnumMBS
dim a(-1) as string = WindowsICMModuleMBS.EnumColorProfiles(c)
for each s as string in a
me.AddRow s
next
End EventHandler
End Control
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
Class InfoWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
Sub Load(p as WindowsICMProfileMBS)
dim c as integer = p.CountColorProfileElements
dim m as MemoryBlock = NewMemoryBlock(5)
for i as integer = 1 to c
dim tag as integer = p.GetColorProfileElementTag(i)
dim data as string = p.GetColorProfileElement(Tag)
m.LittleEndian = true
m.Int32Value(0)=tag
List.AddRow hex(tag)
List.Cell(List.LastIndex,1)=m.CString(0)
List.Cell(List.LastIndex,2)=ReplaceNonPrintableCharactersMBS(data)
next
End Sub
End Class
End Project
See also:
The items on this page are in the following plugins: MBS Win Plugin.