speakers_86
Registered User.
- Local time
- Today, 10:55
- 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.
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