Yup. Takes lots of Windows API calls though. Check this out. Drew on the Database Advisor's forum wrote it.
Create a form and add the following event handlers behind two command buttons.
Private Sub Command0_Click()
HoleOutForm Me.hwnd
DoCmd.Close acForm, Me.Name
End Sub
Private Sub Command1_Click()
HoleOutForm Application.hWndAccessApp
DoCmd.Quit
End Sub
Then add this to a standard module, open the form, click the buttons, and be amazed! Works in A2K2 for sure:
Option Compare Database
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function CreateEllipticRgn Lib _
"gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 _
As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal _
hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal _
nCombineMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 _
As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const RGN_XOR = 3
Function HoleOutForm(ByVal intHwnd As Long)
Dim X As Long
Dim rt As RECT
Dim rtCircle As RECT
Dim dwReturn As Long
Dim InitialRegion As Long
Dim i As Long
Dim intMax As Long
dwReturn = GetWindowRect(intHwnd, rt)
rt.Bottom = rt.Bottom - rt.Top
rt.Top = 0
rt.Right = rt.Right - rt.Left
rt.Left = 0
InitialRegion = CreateRectRgn(rt.Left, rt.Top, rt.Right, rt.Bottom)
rtCircle.Bottom = ((rt.Bottom - rt.Top) / 2) + rt.Top + 1
rtCircle.Top = ((rt.Bottom - rt.Top) / 2) + rt.Top - 1
rtCircle.Right = ((rt.Right - rt.Left) / 2) + rt.Left + 1
rtCircle.Left = ((rt.Right - rt.Left) / 2) + rt.Left - 1
If rt.Bottom > rt.Right Then
intMax = rt.Bottom
Else
intMax = rt.Right
End If
For i = 1 To intMax
X = CreateEllipticRgn(rtCircle.Left, rtCircle.Top, rtCircle.Right, _
rtCircle.Bottom)
InitialRegion = CreateRectRgn(rt.Left, rt.Top, rt.Right, rt.Bottom)
dwReturn = CombineRgn(InitialRegion, InitialRegion, X, RGN_XOR)
SetMainWindowRegion InitialRegion, intHwnd
rtCircle.Bottom = rtCircle.Bottom + 1
rtCircle.Top = rtCircle.Top - 1
rtCircle.Left = rtCircle.Left - 1
rtCircle.Right = rtCircle.Right + 1
DeleteObject X
DeleteObject InitialRegion
Next i
DeleteObject X
DeleteObject InitialRegion
End Function
Private Function SetMainWindowRegion(cRgn As Long, intHwnd As Long)
Dim dwReturn As Long
dwReturn = SetWindowRgn(intHwnd, cRgn, True)
End Function
|
