[AccessD] Just for fun! Playing With Regions!

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Steve Conklin
(Developer at UltraDNT)
Sent: Tuesday, June 22, 2004 12:11 PM
To: 'Access Developers discussion and problem solving'
Subject: RE: [AccessD] Just for fun! Playing With Regions!


Drew, this is way cool.  
I haven't even read the code yet, but is it do-able to have this work
the other way, that is, have the Access application shrink down and into
itself (sort of like an old tube tv turning off)?

Steve

<snip>

Sure can.  Put the following into a module:

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
Private Const RGN_AND = 1
Function TVTubeOut(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
rtCircle.Top = rt.Top
rtCircle.Right = rt.Right
rtCircle.Left = rt.Left
If rt.Bottom > rt.Right Then
    intMax = rt.Bottom
Else
    intMax = rt.Right
End If
Do Until rtCircle.Top >= rtCircle.Bottom
    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_AND)
    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
Loop
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



And you can call it with:

Private Sub Command8_Click()
TVTubeOut Me.hwnd
DoCmd.Close acForm, Me.Name
End Sub

Private Sub Command9_Click()
TVTubeOut Application.hWndAccessApp
DoCmd.Quit
End Sub

One closes the form, one closes Access.

Drew