DMA and resizing a picturebox

I'm using DMA per BillSoo's tutorial to plot an image in a picture box. Everything works fine until the user resizes the form (larger). The picture box resizes with the form and I get index out of bounds when I try to replot the image. It seems that I can't get the "Data" array in his class to resize. It seems that the method only works with a Picture property that was set at design time. I'm sure I'm just missing something.

I'm using DMA per BillSoo's tutorial to plot an image in a picture box. Everything works fine until the user resizes the form (larger). The picture box resizes with the form and I get index out of bounds when I try to replot the image. It seems that I can't get the "Data" array in his class to resize. It seems that the method only works with a Picture property that was set at design time. I'm sure I'm just missing something.
Are you talking about BillSoo's DMA thread in the Tutor's Corner:
http://www.xtremevbtalk.com/t25347.html

If so, you may have missed (overlooked) this section:


Simple? Well, not exactly....there are some caveats...
1) The Picture object MUST have a picture preloaded. This will set up the objects BMP structure. Otherwise, it will be uninstantiated.
The GetObject API is what's setting up the BMP structure. If you resize the picbox you've altered the underling picture data, so the BMP structure is no longer valid. (Thus yielding the "Index Out of Bounds" error).

If you want to try and get the program to work as described (with dynamic runtime resizing) you're going to have to do a little more work and re-initialize the BMP structure (and the whole DMA structure creation process) when triggered by your picbox's ReSize event. Sorri :(

Thanks anon,

Any pointers on how to re-initialize the structures?

it'll be obvious from my weak attempt to implement DMA that I don't understand it very well. the following code crashes with out of bounds or memory leaks. can anyone give me a fe wpointers?

Option Explicit

Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" _
(Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY2D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 1) As SAFEARRAYBOUND
End Type

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type


Dim Data() As Byte
Dim imgBlank As Picture
Dim SA As SAFEARRAY2D
Dim BMP As BITMAP
Dim mvarBytesPerPixel As Integer

Private Function LoadPicArray(p As StdPicture, Data() As Byte) As Boolean
'returns true if function works.
If GetObjectAPI(p.Handle, Len(BMP), BMP) Then 'retrieve bitmap information about p
If BMP.bmWidth Then
mvarBytesPerPixel = BMP.bmWidthBytes \ BMP.bmWidth
If mvarBytesPerPixel = 3 Then
' make the local matrix point to bitmap pixels
With SA
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = BMP.bmHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = BMP.bmWidthBytes
.pvData = BMP.bmBits
End With
' copy bitmap data into byte array
CopyMemory ByVal VarPtrArray(Data), VarPtr(SA), 4
'mvarUBoundX = UBound(Data, 1) \ mvarBytesPerPixel
'mvarUBoundY = UBound(Data, 2)
LoadPicArray = True
Else
MsgBox "Colour resolution must be 3 bytes instead of " & CStr(mvarBytesPerPixel)
End If
Else
MsgBox "Picture width cannot be zero"
End If
Else
MsgBox "Can't retrieve BMP object"
End If

End Function


Private Sub DrawPixel(Data() As Byte, ByVal X&, ByVal Y&, ByVal C&)
Data(X * 3, Y) = (C \ 65536) And &HFF
Data(X * 3 + 1, Y) = (C \ 256) And &HFF
Data(X * 3 + 2, Y) = C And &HFF
End Sub

'Private Function ReadPixel(Data() As Byte, ByVal X&, ByVal Y&) As Long
'ReadPixel = ((Data(X * 3, Y) * 256&) + Data(X * 3 + 1, Y)) * 256& + Data(X * 3 + 2, Y)
'End Function

Private Sub ReleaseData(a() As Byte)
CopyMemory ByVal VarPtrArray(a), 0&, 4
End Sub

Private Sub Plot_Map()
' when this sub is called, dblXmin, dblXmax, dblXrange, dblYmin, dblYmax and dblYrange
' define the Longitude and Latitude boundries and ranges to be plotted

Dim i As Long
Dim j As Long
Dim lngLonLB As Long
Dim lngLonUB As Long
Dim lngLatLB As Long
Dim lngLatUB As Long
Dim intPicStep As Integer
Dim intScale As Integer
Dim lngTempX As Long
Dim lngTempY As Long
Dim lngLastX As Long
Dim lngLastY As Long
Dim strTemp() As String
Dim intDraw As Integer
Dim intPFlag As Integer ' poly line flag
Dim strXY1() As String
Dim strXY2() As String
Dim intColor As Integer

picMain.Cls
picMain.AutoRedraw = True

intPlotFlag = 1

Screen.MousePointer = vbHourglass
' if the open dialog for Map files was used, plot map
If intMapFlag = 1 Then

sngMult = CSng(gintMod) * gsngDec

' the map files are HUGE, don't want to plot any more of them than we have to
' is any of the map within the plot area
If glngLonUB * sngMult > dblXmin And glngLonLB * sngMult < dblXmax _
And glngLatUB * sngMult > dblYmin And glngLatLB * sngMult < dblYmax Then

' at least some of the map is in the plot region
' determine how much of the Map to plot
' if the Xmax < upper bound of the map array
If dblXmax < glngLonUB * sngMult Then
lngLonUB = Int(dblXmax / sngMult) ' set the upper bound to Xmax
Else
lngLonUB = glngLonUB ' set upper bound to UBound of map array
End If
' same thing for Xmin, Ymax and Ymin
If dblXmax - dblXrange > glngLonLB * sngMult Then
lngLonLB = Int((dblXmax - dblXrange) / sngMult) + 1
Else
lngLonLB = glngLonLB
End If
If dblYmax < glngLatUB * sngMult Then
lngLatUB = Int(dblYmax / sngMult)
Else
lngLatUB = glngLatUB
End If
If dblYmax - dblYrange > glngLatLB * sngMult Then
lngLatLB = Int((dblYmax - dblYrange) / sngMult) + 1
Else
lngLatLB = glngLatLB
End If

' make sure we don't try to plot outside of the picture due to rounding errors in the above
If CLng(picMain.ScaleWidth * (dblXmax - lngLonLB * sngMult) / dblXrange) >= picMain.ScaleWidth Then
lngLonLB = Int((dblXmax - dblXrange * (picMain.ScaleWidth - 1) / picMain.ScaleWidth) / sngMult) + 1
End If
If CLng(picMain.ScaleWidth * (dblXmax - lngLonUB * sngMult) / dblXrange) < 1 Then
lngLonUB = CLng((dblXmax - dblXrange / picMain.ScaleWidth) / sngMult)
End If
If CLng(picMain.ScaleHeight * (dblYmax - lngLatLB * sngMult) / dblYrange) >= picMain.ScaleHeight Then
lngLatLB = Int((dblYmax - dblYrange * (picMain.ScaleHeight - 1) / picMain.ScaleHeight) / sngMult) + 1
End If
If CLng(picMain.ScaleHeight * (dblYmax - lngLatUB * sngMult) / dblYrange) < 1 Then
lngLatUB = CLng((dblYmax - dblYrange / picMain.ScaleHeight) / sngMult)
End If

' if zoomed out, there's way more data than pixels and if all the data is plotted
' we end up overwriting pixels several times => very slow
'
' what's the incement for plotting
' scale: (width in array indexes)/(number of pixels)
intScale = Int((lngLonUB - lngLonLB) / picMain.ScaleWidth)
' If the scale is greater than one, loop through the array using the
' scale (rounded down) as the step and draw width of one
If intScale >= 1 Then
intPicStep = intScale
End If

' ****************************************
' ****************************************
' the slow part
' plot
lngLastX = -1
lngLastY = -1
For i = lngLonLB To lngLonUB Step intPicStep
lngTempX = picMain.ScaleWidth * (dblXmax - i * sngMult) / dblXrange
If lngTempX <> lngLastX Then ' don't plot the same pixel twice
lngLastX = lngTempX
For j = lngLatLB To lngLatUB Step intPicStep
lngTempY = picMain.ScaleHeight - picMain.ScaleHeight * (dblYmax - j * sngMult) / dblYrange
If lngTempY <> lngLastY Then ' don't plot the same pixel twice
lngLastY = lngTempY
DrawPixel Data(), lngTempX, lngTempY, glngMap(i, j)
End If
Next j
End If
Next i
' ****************************************
' ****************************************

' set the DrawWidth back to one
picMain.DrawWidth = 1
End If
End If
Screen.MousePointer = vbNormal
End Sub

Private Sub Form_Load()
' set plot flag to indicate we haven't plotted yet
intPlotFlag = 0
' set flag to indicate we haven't loaded a map
intMapFlag = 0
' set flag to indicate we haven't loaded way points
intWayPtsFlag = 0
End Sub

Private Sub Form_Resize()
Dim blnSuccess As Boolean
' resize the picture box to match the form resize
If frmMain.Height > 2000 And frmMain.Width > 2000 Then
picMain.Height = frmMain.Height - 1055
picMain.Width = frmMain.Width - 1425
End If

' load the picture array to set the memory address
picMain.ScaleMode = 3 ' pixels
If blnSuccess = True Then Call ReleaseData(Data())
Set imgBlank = LoadPicture(App.Path & "\blankpicture.bmp", , , picMain.ScaleWidth, picMain.ScaleHeight)
Set picMain.Picture = imgBlank

blnSuccess = LoadPicArray(imgBlank, Data())

dblHtWdth = Abs(picMain.Height / picMain.Width)
DoEvents
If intPlotFlag = 1 Then Call Plot_Map
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim frm As Form

Call ReleaseData(Data())
Set imgBlank = Nothing

For Each frm In Forms
Unload frm
Next
End Sub

I've spent many hours and I've given up. Apparently, there's no way to use DMA if you resize the picturebox. If anyone comes up with a way around this, I'd sure appreciate a heads up.