[RESOLVED] Picturebox Water Ripple Effect

[Chris001]

Hi, I found some code on pscode.com that creates a very nice water ripple effect on a picturebox. I added a little bit of code, so the effect is only created when you click on the picturebox and move the mouse, but there are a few problems.

1) It crashes pretty fast (ntdll.dll). Maybe some API are called too fast?

2) I can't disable the timer in the MouseUp event, because the ripple effect stops immediately and won't fade away. But if I don't stop the timer, then it keeps using 60% CPU.

3) [solved this one]

(Compile the code or it's very slow)

.

<removed project - see below for updated one>

[Amir3D]

Thanks.
Nice Work.
is there any solution on preventing it's crash?

[Chris001]

I don't know, that's exactly what I'm asking.

I didn't write that code and I have no idea why it crashes so fast.

[LaVolpe]

Have you tried contacting the author of the code? PScode has methods to allow you to do that.

[Chris001]

No, I haven't. The author said in the comments that he wrote a new version, but he only made the executable available (link is dead), so I assumed he didn't want to share the code. I'll try to contact him, but pscode is down for about two days now..

[LaVolpe]

One of the crash reasons may be the scanwidth calculation used in the module
The coder is assuming Width*3 is correct for 24 bit images. Well, it is only correct if the width is evenly divisible by 4. If width is not, then crashes can occur.

Recommend adding a scanwidth function and applying that vs the hardcoded x3 calcs

Public Function ByteAlignOnWord(ByVal bitDepth As Byte, ByVal Width As Long) As Long
    ' function to align any bit depth on dWord boundaries
    ByteAlignOnWord = (((Width * bitDepth) + &H1F&) And Not &H1F&) \ &H8&
End Function

' sample: instead of the existing line:
ReDim arrOriginalPic(0 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
' use this
ReDim arrOriginalPic(0 To ByteAlignOnWord(24,bi24BitInfo.bmiHeader.biWidth) * bi24BitInfo.bmiHeader.biHeight-1)  As Byte

' there are several similar lines of code that should be replaced.

Edited: Also, in project properties, Compile tab, do not use advanced optimizations to remove the Array Bounds checking.
Doing so will crash too based on the original author's following comment. Comments like that also lead me to suspect the coder's expertise is less than desirable and therefore, the rest of the code should be scrutinized too

On Error Resume Next 'sometimes the calculations goes out of bounds, but the time taken to check for it
'is much greater than the time taken to just ignore it.

[Chris001]

Thank you, LaVolpe. I modified the code, but unfortunately it still crashes.

I guess it's best not to use this example to create the water ripple effect, but I'm not able to find any other examples that produce the same result. I thought this was a nice effect for the 'About' dialog.

[LaVolpe]

What image did you use? If you can answer that and upload the image, I can take a closer look. When I replied, I did not test the project; I only viewed thru notepad.

[Chris001]

It's not the image itself that I want to change, I could do that with PhotoShop.

When you click on the image (picturebox) and hold down the mouse button and move the mouse cursor around, a water ripple effect is created that follows the mouse cursor, like moving your finger over the surface of a bucket with water.

[LaVolpe]

The project does have some issues.

1. Since the width of the image provided in the project was an even multiple of 4, the potential for crashing because of invalid scan width is nill. However, when using any other image, I'd recommend ensuring its width is a multiple of 4 or use a scanwidth function like the one provided in post 6. Additionally, FYI, the module requires the image container's scalemode to be pixels.

2. The project will leak memory when unloading. The original code is deleting the DC then deleting the bitmap. It must be done in reverse: Unselect the iBitmap from the DC, selecting the original bitmap back in, then delete the iBitmap and then delete the DC. Simply remove all code from the subUnload. I took care of the memory leak in the subPicToDIB function

3. There are some efficiency tweaks that could be made to speed it up. I'll leave that to you and others.

4. The original author left a few test routines in the module, recommend removing them. Simply search for each routine/function/sub and see if it is used anywhere in the project. If not, remove it, it will make the project easier to debug.

5. THE REASON FOR THE CRASH. As I mentioned in post #6 above. The project has the option set to remove Array Bound checks. Since the author admits the calcs will go out of bounds, when that happens, since the checks were disabled, crash! Uncheck that option (see post 6) or modify the calcs to prevent array bound errors.

Oops, to prevent more memory leaks I modified that sub a little here is the modified sub in its entirety
You can remove these declarations from the declarations section: iBitmap and iDC

Private Function ByteAlignOnWord(ByVal bitDepth As Byte, ByVal Width As Long) As Long
    ' function to align any bit depth on dWord boundaries
    ByteAlignOnWord = (((Width * bitDepth) + &H1F&) And Not &H1F&) \ &H8&
End Function

'---------------------------------------------------------------------------------------
' subPicToDIB (SUB)
'
' Parameters: none
' Returns: nothing
' Description: Store the picture in DIB.
'---------------------------------------------------------------------------------------
Public Sub subPicToDIB()
    Dim iBitmap As Long, iDC As Long, iOldBitmap As Long
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = FrmWaterEffect.picOriginal.ScaleWidth
        .biHeight = FrmWaterEffect.picOriginal.ScaleHeight
        .biSizeImage = ByteAlignOnWord(.biBitCount, .biWidth) * .biHeight
        ReDim arrOriginalPic(1 To .biSizeImage) As Byte
        ReDim arrTargetPic(1 To .biSizeImage) As Byte
    End With 'BI24BITINFO.BMIHEADER
    iDC = CreateCompatibleDC(FrmWaterEffect.picOriginal.hdc)
    iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, 0&, 0&)
    iOldBitmap = SelectObject(iDC, iBitmap)
    BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, FrmWaterEffect.picOriginal.hdc, 0, 0, vbSrcCopy
    GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, arrOriginalPic(1), bi24BitInfo, DIB_RGB_COLORS
    GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, arrTargetPic(1), bi24BitInfo, DIB_RGB_COLORS
    DeleteObject SelectObject(iDC, iOldBitmap)
    DeleteDC iDC
    ' Draw the picture
    SetDIBitsToDevice FrmWaterEffect.picWaterEffect.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, arrTargetPic(1), bi24BitInfo, DIB_RGB_COLORS
End Sub

[Chris001]

Thank you very much, LaVolpe.

There's one more problem. As long as the timer is enabled, it uses 75&#37; CPU, but I have no idea where to disable it. If I disable it too soon, then the ripple effect stops immediately and won't fade away. Is there a way to find out if/when all waves have faded away?

[LaVolpe]

I didn't study the algorithm, but there is a note in the code that if 2 values are zero, then no action is needed. Maybe that is where to check. You might want to debug.print to the immediate window the values of those variables and see what they end up at after your waves are gone. Just ensure you can see the debug window, create a wave, and watch the results print out. Once you figure it out, the timer event should check your flag to determine if waves are done, then disable itself. I can't help you at the moment, on a machine without VB.

Regarding cpu usage... There is a lot going on there. The timer is set to fire immediately after the last wave effect was calculated/drawn, 1 ms intervals. So, it is pretty much a continuous event similar to running a loop to infinity. Try increasing the timer interval to 25 to 100, in 5/10 ms increments and see if things improve.

Edited: Here's another idea, but 2 issues may be in play. Just an idea...
1. Only works on Win2K and above
2. Your ripple timer may be interrupt the fade timer
There are plenty of examples here on how to fade a window/form. When your About box or whatever is about to be closed and the ripple timer is still active, fade the window out, when completely faded, turn all timers off and unload the form.

[Chris001]

Thank you, LaVolpe. This is resolved.

[LaVolpe]

Really? Curious how you resolved your issue. Or did you just decide it wasn't that big of an issue? Oh, and you are welcome.

[Chris001]

I played around with the two values you mentioned (disabling the timer when both values are 0), but that didn't work. Both values are 0 almost every time, which stops the timer immediately.

Now I'm using a second timer that is enabled in the mouseup event (when user releases mouse button) and stops the first timer after 4 seconds, so there's just enough time for the waves to fade away. Probably not the best way, but it works.

[LaVolpe]

I think I have a nicer solution for you.... following changes are based off the original zip you posted above.

Private Sub picWaterEffect_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If blnTrack Then
        WaveMapDrop x, MaxY - Y, 10, 25
        If tmrWaterEffect.Enabled = False Then
            Me.Caption = "timer started" ' just so we can see in runtime/compiled.
            tmrWaterEffect.Enabled = True
        End If
    End If
End Sub
Private Sub tmrWaterEffect_Timer()

    If RenderWaveMapWithDIB = False Then
        tmrWaterEffect.Enabled = False
        Me.Caption = "Timer stopped" ' runtime/compiled verification
    End If
End Sub

' now in the module's RenderWaveMapWithDIB routine
' 1. Change Sub to function and return Boolean value as function's return value
' 2. Add this: Dim bChangd As Boolean
' 3. After line: WaveMap(NW, x, Y) = W, add this new line:
If W > Damping Then bChangd = True
' 4. Add this line just before End Function:
RenderWaveMapWithDIB = bChangd

Try it out.

[LaVolpe]

See above for possible end notification. And one more minor tweak, the following gives the appearance of faster rendering.

In the module's RenderWaveMapWithDIB function, move the following line from the end of the routine to just above/before the comment:
' Recalculate the wave

        SetDIBitsToDevice FrmWaterEffect.picWaterEffect.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, arrTargetPic(1), bi24BitInfo, DIB_RGB_COLORS

[Chris001]

Perfect! Thank you very much

[LaVolpe]

Oh, it's far from perfect. There are some bugs in the code. Try this for example:
Start a very small wave and before releasing the mouse, move mouse to about same position where wave started and hold for a second, then release. If you get the same result I do, the wave pattern goes into an infinite loop. If you didn't get the same result, try again a couple of times -- I can reproduce it on demand.

Other than that and the fact the coder didn't take the time to calculate out of bounds on the array, it is a pretty cool algo and effect.

[Chris001]

I did have that problem in the beginning, but now with the changes I can't reproduce the bug anymore.

I also wish the CPU usage was a bit lower, but I guess that's what you get with all those calculations in several loops.

<attachment removed>

[LaVolpe]

Good on you, I can't reproduce that bug any longer.

Here are a couple of things you may want to update/play with
1. Since the timer is using that guesstimate to determine whether to disable itself, it may disable itself a tad early, leaving some wave pixels remaining. The easy fix is replace final line in routine with:

        If bChangd Then
            RenderWaveMapWithDIB = bChangd
        Else
             ' replace original image & reset wave image to original
            SetDIBitsToDevice FrmWaterEffect.picWaterEffect.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, arrOriginalPic(1), bi24BitInfo, DIB_RGB_COLORS
            arrTargetPic() = arrOriginalPic()
        End If

2. If you play with the passed parameters in the mousemove event, you might get faster results by reducing some of the effect: Change 10 and 25 to smaller numbers.

3. I also noticed that you may have issues using different sized images and other pictureboxes.

a. The MaxX and MaxY values in the module are hardcoded and shouldn't be. They are the dimensions of the image. So is the WaveMap array.

b. I also don't like the way the picturebox is hardcoded/referenced by form name and control name. I'd suggest tweak the module to be passed the control name in then initialize routine, so it isn't hardcode. The picbox's ScaleWidth is used in that module in other places too, but MaxX is also equal to scalewidth and can be used instead.

Note: You can declare a reference in the module's declaration section, something like the following: Private mContainer As PictureBox
Then pass the form's picturebox to the InitializeWaterEffekt sub and cache it. Now you can replace all those hardcoded form/control references with mContainer

Public Sub InitializeWaterEffekt(ImagePictureBox As Picturebox)
    Set mContainer = ImagePictureBox
    mContainer.ScaleMode = vbPixels
    ' here you can set MaxX and MaxY and also ReDim WaveMap from mContainer.ScaleWidth & .ScaleHeight
    ' vs having them hardcoded
    ' if you do, in the declarations section change
'    Public MaxX As Long
'    Public MaxY As Long
'    Dim WaveMap() As Integer
    ... rest of initialization code
End Sub

' you'd also want to release the reference too, so 
' in the RenderWaveMapWithDIB  routine when the return value is false, release it
Set mContainer = Nothing

c. I have a sneaky suspicion that the xDisplacement & yDisplacement arrays are also relative to the image's size and may not work with images of other sizes. See the CalcDisplacement routine.

Just some ideas to make it more flexible.

[Chris001]

Thanks for the ideas. I'll add them.