It is possible if we don’t try to do it.
We can instantiate a popup container Form which holds a subform.
The subform is automatically instantiated for us.
Once the container Form is instantiated its SourceObject can be changed to the passed argument Form name.
When that is done we can set the calling passback Control pointer.
We can then position the container Form instance.
And then we can fade in the instance of the container Form which fades its subform as well.
Code:
'********************************************************************************
'* *
'* Please leave any trademarks or credits in place. *
'* ChrisO, Access World Forums *
'* http://www.access-programmers.co.uk/forums/ *
'* *
'********************************************************************************
Option Explicit
Option Compare Text
' KPD-Team 2000
' URL: http://www.allapi.net/
' E-Mail: KPDTeam@Allapi.net
' But somewhat modified by ChrisO.
Public frmCurrentPopupForm As Access.Form
Public Const conSaturation As Byte = 190
Private Const LWA_ALPHA As Long = 2
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_EX_LAYERED As Long = 524288
Private Const conOpacityStep As Byte = 5
Private Const conFadeSleep As Long = 10
Private Const conTwipsPerPixel As Long = 15
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowOpacity Lib "user32" _
Alias "SetLayeredWindowAttributes" (ByVal hWnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
'
Public Function OpenPopup(ByRef Ctl As Access.Control, _
ByVal strPopupFormName As String)
' ChrisO
Dim MouseXY As POINTAPI
Set frmCurrentPopupForm = New Form_frmPopupContainer
With frmCurrentPopupForm
.ctlPopupForm.SourceObject = strPopupFormName
.Visible = True
Set .ctlPopupForm.Form.CallerControl = Ctl
GetCursorPos MouseXY
DoCmd.MoveSize MouseXY.X * conTwipsPerPixel, MouseXY.Y * conTwipsPerPixel
FadeForm .hWnd, 0
FadeInOut .hWnd, conSaturation, "In"
End With
End Function
Public Sub FadeInOut(ByVal lhWnd As Long, _
ByVal bytSaturation As Byte, _
ByVal strInOut As String)
' ChrisO
Dim lngOpacity As Long
Select Case strInOut
Case "In"
For lngOpacity = 0 To bytSaturation Step conOpacityStep
FadeForm lhWnd, lngOpacity
Sleep conFadeSleep
DoEvents
Next lngOpacity
Case "Out"
For lngOpacity = bytSaturation To 0 Step -conOpacityStep
FadeForm lhWnd, lngOpacity
Sleep conFadeSleep
DoEvents
Next lngOpacity
End Select
End Sub
Public Sub FadeForm(ByRef lhWnd As Long, _
ByVal bytOpacity As Byte)
' KPD-Team 2000
' URL: http://www.allapi.net/
' E-Mail: KPDTeam@Allapi.net
' But somewhat modified by ChrisO.
Dim lngReturn As Long
' Set the window style to 'Layered'
lngReturn = GetWindowLong(lhWnd, GWL_EXSTYLE)
lngReturn = lngReturn Or WS_EX_LAYERED
SetWindowLong lhWnd, GWL_EXSTYLE, lngReturn
' Set the opacity of the layered window.
SetWindowOpacity lhWnd, 0, bytOpacity, LWA_ALPHA
End Sub
A2003 demo attached.
Chris.