Platforms to show: All Mac Windows Linux Cross-Platform
/Picture/Picture To Memoryblock
Required plugins for this example: MBS Picture Plugin, MBS Util Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Picture/Picture To Memoryblock
This example is the version from Sun, 10th Dec 2016.
Project "Picture To Memoryblock.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Function CellBackgroundPaint(g As Graphics, row As Integer, column As Integer) As Boolean
// Color lines which have a color
if row<me.ListCount then
dim v as Variant = me.RowTag(row)
if v.Type = Variant.TypeColor then
dim c as color = v
g.ForeColor = c
g.FillRect 0,0,g.Width,g.Height
Return true
end if
end if
End EventHandler
End Control
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
EventHandler Sub Open()
dim pic as Picture = LogoMBS(500)
dim mask as Picture = new Picture(500,500,32)
mask.Graphics.ForeColor = &cFFFFFF
mask.Graphics.FillRect 0,0,mask.Width,mask.Height
mask.Graphics.ForeColor = &c000000
mask.Graphics.FillOval 0,0,mask.Width,mask.Height
dim m as MemoryBlock
Check1(pic, "RGB16")
Check1(pic, "ARGB16")
Check1(pic, "RGB16_565")
Check1(pic, "ARGB32")
Check1(pic, "RGB32")
Check1(pic, "RGB24")
Check1(pic, "MASK8")
Check2(pic, mask, "RGB16")
Check2(pic, mask, "ARGB16")
Check2(pic, mask, "RGB16_565")
Check2(pic, mask, "ARGB32")
Check2(pic, mask, "RGB32")
Check2(pic, mask, "RGB24")
Check2(pic, mask, "MASK8")
// done
pic.mask.Graphics.DrawPicture mask,0,0
canvas1.Backdrop = pic
End EventHandler
Sub Check(m1 as MemoryBlock, m2 as MemoryBlock)
if m1<>nil and m2<>nil then
if m1.Size = m2.size then
List.AddRow "Size equal"
if m1.BytesEqualMBS(0, m1.Size, m2, 0) then
List.AddRow "Bytes equal"
else
List.AddFail "Bytes not equal"
dim c as integer = m1.Size-1-32
for i as integer = 0 to c
if m1.Int8Value(i)<>m2.Int8Value(i) then
List.AddFail "Position: "+str(i)
List.AddFail EncodingToHexMBS(m1.StringValue(i,32))
List.AddFail EncodingToHexMBS(m2.StringValue(i,32))
exit
end if
next
end if
else
List.AddFail "Size not equal"
end if
end if
End Sub
Sub Check1(pic as Picture, mode as string)
#pragma DisableBackgroundTasks
dim d as Double
dim m1,m2 as MemoryBlock
d = Microseconds
for i as integer = 1 to 10
m1 = GetMBfromPicture(pic, mode)
next
d = Microseconds-d
if m1 = nil then
List.AddFail "GetMBfromPicture(pic, "+mode+") Failed"
else
List.AddRow "GetMBfromPicture(pic, "+mode+") = "+Format(d/10.0/1000000.0,"0.0000")
end if
d = Microseconds
for i as integer = 1 to 10
m2 = GetMBfromPictureMBS(pic, mode)
next
d = Microseconds-d
if m2 = nil then
List.AddFail "GetMBfromPictureMBS(pic, "+mode+") Failed"
else
List.AddRow "GetMBfromPictureMBS(pic, "+mode+") = "+Format(d/10.0/1000000.0,"0.0000")
end if
Check m1,m2
End Sub
Sub Check2(pic as Picture, mask as picture, mode as string)
#pragma DisableBackgroundTasks
dim d as Double
dim m1,m2 as MemoryBlock
d = Microseconds
for i as integer = 1 to 10
m1 = GetMBfromPicture(pic, mask, mode)
next
d = Microseconds-d
if m1 = nil then
List.AddFail "GetMBfromPicture(pic, mask, "+mode+") Failed"
else
List.AddRow "GetMBfromPicture(pic, mask, "+mode+") = "+Format(d/10.0/1000000.0,"0.0000")
end if
d = Microseconds
for i as integer = 1 to 10
m2 = GetMBfromPictureMBS(pic, mask, mode)
next
d = Microseconds-d
if m2 = nil then
List.AddFail "GetMBfromPictureMBS(pic, mask, "+mode+") Failed"
else
List.AddRow "GetMBfromPictureMBS(pic, mask, "+mode+") = "+Format(d/10.0/1000000.0,"0.0000")
end if
Check m1,m2
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
Module Module1
Sub AddFail(extends l as listbox, s as string)
// add line with red color
l.AddRow s
l.RowTag(l.LastIndex)=&cFF7777
End Sub
Function GetMBfromPicture(pic As Picture, mask As Picture, type As String = "RGB32") As MemoryBlock
// Converts a picture into a MemoryBlock.
// Will set w and h to the picture's width & height respectively.
//image must be in power of 2! be sure to trap for this (by cropping texture when importing)
#pragma DisableBackgroundTasks
dim x, y, offset,height,width as integer
Dim xx, yy As Integer
Dim rgb as RGBSurface
Dim rgbMask As RGBSurface
dim c as color
Dim texData As MemoryBlock
Dim p, pmask As Picture
p = new Picture(pic.Width,pic.Height,32)
p.Graphics.DrawPicture pic,0,0
height = pic.graphics.height
width = pic.graphics.width
// Use if you want pass ByRef h & w as Integer
'h = height
'w = width
// Set texData MemoryBlock to hold the exact size
// of a pixel' color.
Select Case type
Case "RGB16", "ARGB16", "RGB16_565"
texData = New MemoryBlock(height*width * 2)
texData.LittleEndian = False
Case "ARGB32", "RGB32", "RGB24"
texData = New MemoryBlock(height*width * 4)
texData.LittleEndian = True
Case "MASK8"
texData = New MemoryBlock(height*width) // 8-bit picture mask
texData.LittleEndian = False
End Select
rgb = p.RGBSurface
if mask <> nil then
pmask = new Picture(p.Width, p.Height, 32)
pmask.Graphics.DrawPicture mask,0,0
rgbMask = pmask.RGBsurface
end if
xx = width - 1
yy = height - 1
for y = 0 to yy
for x = 0 to xx
Select Case type // Parse RGB data
Case "RGB32", "RGB24"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,24) = c
texData.UInt8Value(offset+3) = 255
offset = offset + 4
Case "ARGB32"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,24) = c
c = rgbMask.Pixel(x,y) // mask
texData.UInt8Value(offset+3) = c.red
offset = offset + 4
Case "RGB16"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,16) = c
offset = offset + 2
Case "ARGB16"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,16) = c
offset = offset + 2
Case "RGB16_565"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,16) = c
offset = offset + 2
Case "MASK8"// Parse mask data
c = rgbMask.Pixel(x,y)
texData.Byte(offset) = c.red
offset = offset + 1
End Select
next
next
Return texData
End Function
Function GetMBfromPicture(pic As Picture, type As String = "RGB32") As MemoryBlock
// Converts a picture into a MemoryBlock.
// Will set w and h to the picture's width & height respectively.
//image must be in power of 2! be sure to trap for this (by cropping texture when importing)
#pragma DisableBackgroundTasks
dim x, y, offset,height,width as integer
Dim xx, yy As Integer
dim rgb as RGBSurface
dim maskS As RGBSurface
dim c as color
Dim texData As MemoryBlock
Dim p As Picture
p = new Picture(pic.Width,pic.Height,32)
p.Graphics.DrawPicture pic,0,0
height = p.graphics.height
width = p.graphics.width
// Use if you want pass ByRef h & w as Integer
'h = height
'w = width
// Set texData MemoryBlock to hold the exact size
// of a pixel' color.
Dim clr As MemoryBlock= New MemoryBlock(4)
Select Case type
Case "RGB16", "ARGB16", "RGB16_565"
texData = New MemoryBlock(height*width * 2)
texData.LittleEndian = False
Case "ARGB32", "RGB32", "RGB24"
texData = New MemoryBlock(height*width * 4)
texData.LittleEndian = True
Case "MASK8"
texData = New MemoryBlock(height*width) // 8-bit picture mask
texData.LittleEndian = False
End Select
rgb = p.RGBSurface
maskS = p.Mask.RGBSurface 'if p.Mask <> nil then
xx = width - 1
yy = height - 1
for y = 0 to yy
for x = 0 to xx
Select Case type // Parse RGB data
Case "RGB32", "RGB24"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,24) = c
texData.UInt8Value(offset+3) = 255
offset = offset + 4
Case "ARGB32"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,24) = c
c = maskS.Pixel(x,y) // mask
texData.UInt8Value(offset+3) = c.red
offset = offset + 4
Case "RGB16"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,16) = c
offset = offset + 2
Case "ARGB16"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,16) = c
offset = offset + 2
Case "RGB16_565"
c = rgb.Pixel(x,y)
texData.ColorValue(offset,16) = c
offset = offset + 2
Case "MASK8"// Parse mask data
c = maskS.Pixel(x,y)
texData.Byte(offset) = c.red
offset = offset + 1
End Select
next
next
Return texData
End Function
End Module
End Project
See also:
- /Picture/Picture blending/blend with mask
- /Picture/Picture blending/blend with plugin
- /Picture/Picture blending/blend without plugin
- /Picture/Picture Blur
- /Picture/Picture Combine Test
- /Picture/Picture manipulation
- /Picture/Picture Matrix/matrix with plugin
- /Picture/Picture Matrix/matrix without plugin
- /Picture/Picture Scale/Scale Test
- /Picture/Picture to Binary Data Test
The items on this page are in the following plugins: MBS Picture Plugin.