[AccessD] Just for fun! Playing With Regions!

Really cool. Just wish I could use it, but I think my customer would fall
off his chair.
--
Andy Lacey
http://www.minstersystems.co.uk



--------- Original Message --------
From: Access Developers discussion and problem solving
<accessd at databaseadvisors.com>
To: 'Access Developers discussion and problem solving'
<accessd at databaseadvisors.com>
Subject: RE: [AccessD] Just for fun! Playing With Regions!
Date: 22/06/04 10:00

>
> Drew,
>
> Excellent.  The dynamic resizing effect is pretty cool.  This reminds me
of
> an old Access97 demo I have (but never used in production) called
> ShapedForm.mdb.  IIRC it used a lot of the same API calls.
> Hmmmm...combining the two approaches...might make for an interesting
> diversion some day.
>
> Mark
>
>
>
> -----Original Message-----
> From: DWUTKA at marlow.com [mailto:DWUTKA at marlow.com]
> Sent: Monday, June 21, 2004 5:32 PM
> To: AccessD at databaseadvisors.com
> Subject: [AccessD] Just for fun! Playing With Regions!
>
>
> Okay, here's a little code I whipped up for a friend.
>
> Just put this into a module (watch for word wrap):
>
> 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
>
>
> Now, create a form, and put the following behind a command button:
>
> HoleOutForm Me.Hwnd
> DoCmd.Close acForm, Me.Name
>
> Then put a second button on the form, and put this code behind it:
>
> HoleOutForm Application.hWndAccessApplication
> DoCmd.Quit
>
> Save the form, and try out the buttons.
>
> Enjoy!
>
> Drew
> --
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
> --
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
>
>
>
>

________________________________________________
Message sent using UebiMiau 2.7.2