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.