Example: /Images/PNG/PNG Load To MemoryBlocks

Online Documentation   -   Statistics   -   FAQ   -   Plugin Parts (All, Dependencies)   -   Class hierarchy

New in Version 22.2 22.3 22.4 22.5 23.0 23.1 23.2 23.3 23.4 23.5 24.0 24.1

The list of the   topics,   classes,   interfaces,   controls,   modules,   global methods by category,   global methods by name,   screenshots,   licenses   and   examples.

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.


💬 Ask a question or report a problem