Wipe Effects

speakers_86

Registered User.
Local time
Today, 00:20
Joined
May 17, 2007
Messages
1,919
I found some code that changes the way forms look when they close. I am trying to add this feature to my developers tool, Aphrodite, but I am having some trouble. It wont compile at the Call though. lngWipeEffect is a global that has been set between 1 and 5. The error is an invalid use of property. It works great in the demo I dl'ed. If you google it there are multiple places to get it.

Refernces in the demo are:
visaul basic for applications
microsoft access 12.0 object library
ole automation
microsoft activex data objects 2.1 library

My references are:
all above
microsoft dao 3.6 object librarry

I had to add the activex reference, but it changed nothing.

Code:
Private Sub Form_Close()
   Dim lngIncrement As Long
    Dim lngOpt As Long
    lngOpt = lngWipeEffect
    If lngOpt >= 0 Then
        lngIncrement = 100
        Call WipeEffect(Me, lngOpt, lngIncrement)
    End If
End Sub

Code:
Option Compare Database
Option Explicit

Global bOpened As Boolean

Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

' x, y, nWidth, nHeight in pixels
Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, _
        ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
        ByVal bRepaint As Long) As Long

Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long

Public Sub WipeEffect(frm As Form, lngOpt As Long, lngIncrement As Long)

    Dim r As RECT
    Dim lngRet As Long
    Dim lngX As Long

    Dim lngFormHeight As Long
    Dim lngFormWidth As Long
    
    Dim lngIncrementW As Long
    Dim lngIncrementH As Long
    
        
    lngRet = GetWindowRect(frm.hwnd, r)
    lngFormWidth = r.right - r.left
    lngFormHeight = r.bottom - r.top
        
    lngIncrementW = lngFormWidth \ lngIncrement
    lngIncrementH = lngFormHeight \ lngIncrement
    
    Select Case lngOpt
    Case 1 ' wipe up
        For lngX = 1 To lngIncrement
            lngRet = MoveWindow(frm.hwnd, r.left, r.top, _
                    lngFormWidth, lngFormHeight - lngX * lngIncrementH, 1)
        Next lngX
    Case 2 ' wipe down
        For lngX = 1 To lngIncrement
            lngRet = MoveWindow(frm.hwnd, r.left, r.top + lngX * lngIncrementH, _
                    lngFormWidth, lngFormHeight - lngX * lngIncrementH, 1)
        Next lngX
    Case 3 ' wipe right
        For lngX = 1 To lngIncrement
            lngRet = MoveWindow(frm.hwnd, r.left + lngX * lngIncrementW, r.top, _
                    lngFormWidth - lngX * lngIncrementW, lngFormHeight, 1)
        Next lngX
    Case 4 ' wipe left
        For lngX = 1 To lngIncrement
            lngRet = MoveWindow(frm.hwnd, r.left, r.top, _
                    lngFormWidth - lngX * lngIncrementW, lngFormHeight, 1)
        Next lngX
    Case 5 ' shrink/move
        For lngX = 1 To lngIncrement
            lngRet = MoveWindow(frm.hwnd, r.left - lngX * lngIncrementW, _
                     r.top + lngX * lngIncrementH, _
                     lngFormWidth - lngX * lngIncrementW, _
                     lngFormHeight - lngX * lngIncrementH, 1)
        Next lngX
    Case Else ' shiver
        Dim lngTop As Long
        Dim lngLeft As Long
        Dim factor As Long
        factor = 30
        For lngX = 1 To 2500
            If lngX Mod 4 = 0 Then
                lngLeft = r.left - factor
                lngTop = r.top - factor
            ElseIf lngX Mod 3 = 0 Then
                lngLeft = r.left - factor
                lngTop = r.top + factor
            ElseIf lngX Mod 2 = 0 Then
                lngLeft = r.left + factor
                lngTop = r.top - factor
            Else
                lngLeft = r.left + factor
                lngTop = r.top + factor
            End If
            lngRet = MoveWindow(frm.hwnd, _
                     lngLeft, _
                     lngTop, _
                     lngFormWidth, _
                     lngFormHeight, 1)
        Next lngX
        MsgBox "Brrrrrrrr!!  I think I hab a code.", vbCritical, "Code"
    End Select
    
End Sub
 
So I figured out it is something to do with my form, I just don't know what. I imported the form the illustrates the wipe effect from the dl, and that works without any issues, even when I use the global variable. My form doesn't like it for some reason.
 
Hi,
change the code of closing form to the following:

Dim iform As Form
Dim lngIncrement As Long

Dim lngOpt As Long

lngOpt = 1

Set iform = Me

If lngOpt >= 0 Then

lngIncrement = 100

Call WipeEffect(iform, lngOpt, lngIncrement)

End If
 
Welcome to our fine community!

Thanks for your post, but that did not work. I think the code is fine, because it works in other forms. It's got something to do with my form, I don't know what. It really doesn't matter though, because this particular form does not need the wipe effects. Just all the rest.
 
You didn't mention what the error message is speakers.
 
Looks like you did speakers ;)

Have you tried stepping through the code?
 
When the form closes, it does not break, not even when I break on all errors. It simply closes normally. Still yet it will not compile. I need to say again that it is only for this one form. The code works fine in another basically blank form.
 
I mean, set a breakpoint at the Call line and step through it using F5 or F8 (I don't remember which one it is).
 
Hi,
Just put the following properties to the corresponding values:
Pop up = yes
Modal = yes
I think it will work it.
I am sorry, who told you that google is a good friend.
 
I got it. My recordsource has a field called 'WipeEffect' which matches the name of the sub.
 
I ignored the issue until it showed up again on a different form. I swore it was corruption, because calling the function from any other form worked fine. I figured it out because for some reason I tried me.w, and wipeeffect was an intellisense option. That gave it away.
 

Users who are viewing this thread

Back
Top Bottom