Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Images Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/PNG/png with profile
This example is the version from Sun, 5th May 2018.
Project "png with profile.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
EventHandler Sub Open()
write
read
End EventHandler
Protected Sub read()
dim current as PictureMBS
dim f as FolderItem
dim intent as integer
dim name as string
dim compression as integer
dim data as string
f=SpecialFolder.Temporary.child("test.png")
if f<>Nil then
Current=nil
dim p as new PNGReaderMBS
if p.OpenFile(f) then
if p.ApplyOptions(0) then
if p.ReadsRGBTag(intent) then
if p.ReadICCProfile(name, compression, data) then
Current=new PictureMBS(p.Width,p.Height,PictureMBS.ImageFormatRGB)
dim i,c as integer
c=p.Height-1
for i=0 to c
Current.RowInFormat(i, PictureMBS.ImageFormatRGBA)=p.ReadRow()
next
Backdrop=Current.CopyPicture
Title="Intent: "+str(intent)+", Profile: "+name+" ("+str(lenb(data))+")"
end if
end if
end if
end if
end if
End Sub
Protected Sub write()
// This is for compression type. PNG 1.0-1.2 only define the single type.
const PNG_COMPRESSION_TYPE_BASE=0 // Deflate method 8, 32K window
// These are for the sRGB chunk.
const PNG_sRGB_INTENT_PERCEPTUAL = 0
const PNG_sRGB_INTENT_RELATIVE = 1
const PNG_sRGB_INTENT_SATURATION = 2
const PNG_sRGB_INTENT_ABSOLUTE = 3
const PNG_COLOR_MASK_PALETTE = 1
const PNG_COLOR_MASK_COLOR = 2
const PNG_COLOR_MASK_ALPHA = 4
dim f as FolderItem
dim current as new PictureMBS(LogoMBS(500)) // needs Main Plugin
f=SpecialFolder.Temporary.child("test.png")
if f<>Nil then
dim profile as LCMS2ProfileMBS = LCMS2ProfileMBS.CreatesRGBProfile
dim profiledata as string = profile.SaveProfileToString
dim p as new PNGWriterMBS
p.Width=Current.Width
p.Height=Current.Height
p.Type=PNG_COLOR_MASK_COLOR
p.bpc=3
p.Rowbytes=p.Width*p.bpc
if p.OpenWriteDestination(f) then
if p.SetHeader(false, -1) then
if p.SetGamma(0) then
if p.SetsRGB(PNG_sRGB_INTENT_ABSOLUTE) then
if p.SetICCProfile(profile.Name, PNG_COMPRESSION_TYPE_BASE, profiledata) then
if p.WriteInfo then
dim i,c as integer
c=p.Height-1
for i=0 to c
p.WriteRow current.RowInFormat(i, Current.ImageFormatRGB)
next
if p.WriteEnd then
MsgBox "OK"
end if
end if
end if
end if
end if
end if
end if
end if
End Sub
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
End Project
See also:
The items on this page are in the following plugins: MBS Images Plugin.