This is very raw<grin> code. A couple of the array bounds are out by one
but since you asked for a hard coded Image size it doesn't matter for
this example.
Place the code in a standard code module. Call the Function TestRaw
passing the Image control you want to fill. I will leave you to fill the
arrays i nthe TestRaw function with your own data.
Option Compare Database
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long 'ERGBCompression
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
'bmiColors As RGBQUAD
End Type
Private Const BI_RGB = 0&
Public Function RawToPictureData(ctl As Access.Image, RawData() As Byte,
Width As Long, Height As Long, Pal() As Byte) As Boolean
' This specific example will only work for
' an incoming raw array of 400 x 400 byte values
' and an incoming array of 256 RGBQUAD struct.
' All incoming arrays are assumed to be 0 based.
Dim lTemp As Long
Dim bm As BITMAPINFO
Dim a() As Byte
Dim x As Long
Dim BytesPerScanLine As Long
Dim y As Long, z As Long
Dim quad() As RGBQUAD
Dim varTemp() As Byte
' Copy our RGBQUAD data
' Assumes Pal array is a byte array of RGBQUAD structs
' not an array of RGBQUAD structs
ReDim quad(0 To 255) As RGBQUAD
CopyMemory quad(0), Pal(0), 256 * 4 'UBound(Pal)
' Calculate our new Bimtap width
' Scans must align on dword boundaries:
With bm.bmiHeader
..biSize = LenB(bm)
.biBitCount = 32
.biWidth = Width
.biHeight = Height
.biPlanes = 1
.biCompression = BI_RGB
End With
' Not needed for this specific example as we are using a 32bit BitCount
BytesPerScanLine = (Width * (bm.bmiHeader.biBitCount / 8) + 3) And
&HFFFFFFFC
bm.bmiHeader.biSizeImage = BytesPerScanLine * bm.bmiHeader.biHeight
ReDim a(0 To bm.bmiHeader.biSizeImage - 1) As Byte
y = 4
z = 0
' De-palettize the original data
For x = 0 To (Height * Width) - 1 'Step 4
a(x * y) = quad(RawData(x)).rgbBlue
a((x * y) + 1) = quad(RawData(x)).rgbGreen
a((x * y) + 2) = quad(RawData(x)).rgbRed
a((x * y) + 3) = quad(RawData(x)).rgbReserved
z = z + 1
If z = 256 Then z = 0
Next x
' Allow 40 Bytes for the DIBHeader
ReDim varTemp(bm.bmiHeader.biSizeImage + 40)
' Copy Image Data only
CopyMemory varTemp(40), a(0), bm.bmiHeader.biSizeImage
' Copy BITMAPINFOHEADER
CopyMemory varTemp(0), bm.bmiHeader, 40
' Update the PictureData property of the Image control
ctl.PictureData = varTemp
End Function
Public Function TestRaw(ctl As Access.Image) As Boolean
Dim a() As Byte
Dim p() As Byte
Dim x As Long
Dim y As Long
Dim z As Long
' Redim as per this specific example
ReDim a(0 To (159999)) As Byte
ReDim p(0 To (256 * 4)) As Byte
' Fill Raw Image array with pointers to the 256 element palette
For x = 0 To UBound(a) Step 256
For y = 0 To 255
a(x + y) = y
Next y
Next x
' Fill Palette array with RGBQUAD data to the 256 element palette
z = 0
y = 4
For x = 0 To 255 'Step 4
p(x * y) = z
p((x * y) + 1) = z
p((x * y) + 2) = z
p((x * y) + 3) = z
z = z + 1
If z > 255 Then z = 0
Next x
z = RawToPictureData(ctl, a(), 400, 400, p())
End Function
--
HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.
