Platforms to show: All Mac Windows Linux Cross-Platform

/Images/PNG/PNG Load To MemoryBlocks


Required plugins for this example: MBS Images Plugin, MBS GraphicsMagick 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 Load To MemoryBlocks

This example is the version from Fri, 7th Nov 2019.

Project "PNG Load To MemoryBlocks.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub Change() If Me.ListIndex >= 0 Then pic = Me.RowTag(Me.ListIndex) Else pic = Nil End If output.Invalidate End EventHandler
End Control
Control Output Inherits Canvas
ControlInstance Output Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) If pic <> Nil Then Dim faktor As Double = Min( g.Height / Pic.Height, g.Width / Pic.Width) // Calculate new size Dim w As Integer = Pic.Width * faktor Dim h As Integer = Pic.Height * faktor g.DrawPicture Pic, 0, 0, w, h, 0, 0, Pic.Width, Pic.Height End If End EventHandler
End Control
EventHandler Sub Open() CreateTestImage Test GMImageMBS.GrayscaleType, False, "Gray" Test GMImageMBS.GrayscaleMatteType, True, "Gray+Alpha" Test GMImageMBS.BilevelType, False, "1 bit" Test GMImageMBS.TrueColorType, False, "RGB" Test GMImageMBS.TrueColorMatteType, True, "RGB+Alpha" Test GMImageMBS.PaletteType, False, "Palette" Test GMImageMBS.PaletteMatteType, True, "Palette+Alpha" Test GMImageMBS.PaletteType, False, "Palette", 16 Test GMImageMBS.PaletteMatteType, True, "Palette+Alpha", 16 Test GMImageMBS.PaletteType, False, "Palette", 4 Test GMImageMBS.PaletteMatteType, True, "Palette+Alpha", 4 Test GMImageMBS.PaletteType, False, "Palette", 2 Test GMImageMBS.PaletteMatteType, True, "Palette+Alpha", 2 End EventHandler
Sub CreateTestImage() Dim p As Picture = LogoMBS(500) Dim n As New Picture(500, 500, 32) Dim m As Picture = n.Mask n.Graphics.DrawPicture p, 0, 0 // make outside area transparent m.Graphics.ForeColor = &cFFFFFF m.Graphics.FillRect 0, 0, 500, 500 m.Graphics.ForeColor = &c000000 m.Graphics.FillOval 0, 0, 500, 500 pic = n logo = n End Sub
Sub Test(type as integer, withAlpha as Boolean, name as string, ColorCount as integer = 0) // we compress test images with GraphicsMagick Dim g As New GMImageMBS(logo) g.matte = withAlpha g.backgroundColor = GMColorMBS.White If type = g.PaletteType Or type = g.PaletteMatteType Then // reduce number of colors If ColorCount > 0 then g.quantizeColors = ColorCount End If g.quantize End If g.type = type // save as PNG g.magick = "png" Dim blob As New GMBlobMBS Dim filename As String = "test "+Str(type)+" "+name+".png" Dim file As FolderItem = SpecialFolder.Desktop.child(filename) g.write blob g.write file Dim pngData As String = blob.CopyString // now read it! Dim png As New PNGReaderMBS If png.OpenData(pngData) Then // needed for our MemoryBlocks png.InvertAlpha = True // false -> RGBX or RGBA // true -> Gray, Gray+Alpha, RGB or RGBA png.ExpandGrayToRGB = True If png.ApplyOptions(0, -1) Then Dim ColorType As String = Str(png.OriginalColorType) Dim BitDepth As String = Str(png.BitDepth) Dim InterlaceType As String = Str(png.InterlaceType) //* These describe the color_type field In png_info. */ //* Color type masks */ Const PNG_COLOR_MASK_PALETTE = 1 Const PNG_COLOR_MASK_COLOR = 2 Const PNG_COLOR_MASK_ALPHA = 4 //* Color types. Note that Not all combinations are legal */ Const PNG_COLOR_TYPE_GRAY = 0 Const PNG_COLOR_TYPE_PALETTE = (PNG_COLOR_MASK_COLOR + PNG_COLOR_MASK_PALETTE) Const PNG_COLOR_TYPE_RGB = (PNG_COLOR_MASK_COLOR) Const PNG_COLOR_TYPE_RGB_ALPHA = (PNG_COLOR_MASK_COLOR + PNG_COLOR_MASK_ALPHA) Const PNG_COLOR_TYPE_GRAY_ALPHA = (PNG_COLOR_MASK_ALPHA) Select Case png.OriginalColorType Case PNG_COLOR_TYPE_GRAY ColorType = "Gray" Case PNG_COLOR_TYPE_PALETTE ColorType = "Palette" Case PNG_COLOR_TYPE_RGB ColorType = "RGB" Case PNG_COLOR_TYPE_RGB_ALPHA ColorType = "RGB+Alpha" Case PNG_COLOR_TYPE_GRAY_ALPHA ColorType = "Gray+Alpha" Else ColorType = Str(png.ColorType) End Select If png.ColorType <> png.OriginalColorType Then // if ApplyOptions changed type, show both Select Case png.ColorType Case PNG_COLOR_TYPE_GRAY ColorType = ColorType + "/Gray" Case PNG_COLOR_TYPE_PALETTE ColorType = ColorType + "/Palette" Case PNG_COLOR_TYPE_RGB ColorType = ColorType + "/RGB" Case PNG_COLOR_TYPE_RGB_ALPHA ColorType = ColorType + "/RGB+Alpha" Case PNG_COLOR_TYPE_GRAY_ALPHA ColorType = ColorType + "/Gray+Alpha" Else ColorType = Str(png.ColorType) End Select end if //* These are For the interlacing type. These values should Not be changed. */ Const PNG_INTERLACE_NONE = 0 //* Non-interlaced image */ Const PNG_INTERLACE_ADAM7 = 1 //* Adam7 interlacing */ Const PNG_INTERLACE_LAST = 2 //* Not a valid value */ Select Case png.ColorType Case PNG_INTERLACE_NONE InterlaceType = "none" Case PNG_INTERLACE_ADAM7 InterlaceType = "Adam7" End Select List.AddRow ColorType, BitDepth, InterlaceType, "", Str(png.RowBytes) If False Then // read via plugin If png.ReadPicture Then Dim p As Picture = png.CombinePictureWithMask list.RowTag(list.LastIndex) = p List.Cell(List.LastIndex, 3) = "" End If Else // read via PictureMBS Dim imgSource As PictureMBS Select Case png.ColorType Case PNG_COLOR_TYPE_GRAY imgSource = New PictureMBS(png.Width, png.Height, PictureMBS.ImageFormatG) ' Read row by row the file and puts it in a PictureMBS instance Dim nMax As Integer = png.Height - 1 For nInd As Integer = 0 To nMax Dim m As MemoryBlock = png.ReadRow imgSource.RowInFormat(nInd, PictureMBS.ImageFormatG) = m Next Case PNG_COLOR_TYPE_RGB If png.UseFiller = False Then // we expand to RGB imgSource = New PictureMBS(png.Width, png.Height, PictureMBS.ImageFormatRGB) ' Read row by row the file and puts it in a PictureMBS instance Dim nMax As Integer = png.Height - 1 For nInd As Integer = 0 To nMax imgSource.RowInFormat(nInd, PictureMBS.ImageFormatRGB) = png.ReadRow Next Else // we expand to RGBX imgSource = New PictureMBS(png.Width, png.Height, PictureMBS.ImageFormatRGBX) ' Read row by row the file and puts it in a PictureMBS instance Dim nMax As Integer = png.Height - 1 For nInd As Integer = 0 To nMax imgSource.RowInFormat(nInd, PictureMBS.ImageFormatRGBX) = png.ReadRow Next end if Case PNG_COLOR_TYPE_RGB_ALPHA imgSource = New PictureMBS(png.Width, png.Height, PictureMBS.ImageFormatRGBA) ' Read row by row the file and puts it in a PictureMBS instance Dim nMax As Integer = png.Height - 1 For nInd As Integer = 0 To nMax // alpha is swapped before imgSource.RowInFormat(nInd, PictureMBS.ImageFormatRGBA) = png.ReadRow Next Case PNG_COLOR_TYPE_GRAY_ALPHA imgSource = New PictureMBS(png.Width, png.Height, PictureMBS.ImageFormatGA) ' Read row by row the file and puts it in a PictureMBS instance Dim nMax As Integer = png.Height - 1 For nInd As Integer = 0 To nMax imgSource.RowInFormat(nInd, PictureMBS.ImageFormatGA) = png.ReadRow Next End Select ' show Picture If imgSource <> Nil then Dim p As Picture = imgSource.CopyPictureWithMask list.RowTag(list.LastIndex) = p List.Cell(List.LastIndex, 3) = imgSource.ImageFormatString End If end if End If End If End Sub
Property logo As Picture
Property pic As Picture
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
End Project

See also:

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


The biggest plugin in space...