Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/PNG/png with profile
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.rbp"
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:

Feedback, Comments & Corrections

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

MBS FileMaker tutorial videos