Example: /Picture/Picture To Memoryblock

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

/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:

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


💬 Ask a question or report a problem