I implemented the Shift requirement for moving the UserForm around on
purpose. Doing it that way preserves your ability to implement Click event
code for the UserForm, it stops the user from accidentally moving the form
by a stray click drag, and I kind of thought using the Shift key was a good
memory aid for the user, as in "you press the Shift key to shift the
UserForm around".

Rick


"Geoff" wrote in message
...
Correction:
"xlprimaryButton" is ok - however "If Button and 1 Then" permits me to
move
the form around without the need for Shift. Captionless and moving the
form
are important features.

Geoff

"Geoff" wrote:

Hi Rick
The only thing I've noticed so far is it didn't like "xlprimaryButton" in
MouseDown so I changed the line to:
"If Button and 1 Then" and it now works as expected.

I presume that defining the region prevents a caption being added to the
shape? If so how would I define a simple rectangle? I have a custom
msgbox
from which I remove the caption but the code is quite longwinded and
yours is
much briefer.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

By the way... one thing I forgot to mention is that those coordinates
for
the polygon (the MyRegion array) are in pixels (I'm pretty sure all API
window measurements are always in pixels), not Points, with the 0,0
coordinate being in the normal upper, left corner of the UserForm.

Rick


"Rick Rothstein (MVP - VB)" wrote
in
message ...
Okay, here is a different method to create shaped forms for you to
play
around with based on code I developed quite awhile ago in the
compiled VB
newsgroups. It is not as flexible, shape-wise as the method in the
link
you posted, but it was easier for me to develop given I had all the
code
and it is a method I am familiar with. Check back in this thread
later
today or tomorrow to see if I was able to make use of them method
from you
link.

Insert a UserForm into your project and add 3 OptionButtons and a
CommandButton to the UserForm (don't worry about size or location,
the
code will handle that). Copy paste the code below my signature into
the
UserForm's code window and Run it. You will be presented with 3
different
shapes you can make your UserForm via the OptionButtons. Press the
CommandButton to exit. Important... note the Delete Object call in
the
CommandButton's click event... you must delete the Region objects you
create before exiting your running code, otherwise they will remain
in
memory after your Excel session ends and, if the user runs your code
enough, eventually crash the user's system. Using the API requires
extra
attention to details that working in VBA doesn't, so be warned.

Finally, the polygon method will allow you to create intricately
shaped
UserForms, just change the MyRegion array to contain enough points to
form
the intended shape and set the indicated X,Y coordinates for it. And,
as
noted in the comments, do NOT set the last polygon point equal to the
first one (that is, do not close the polygon) as the API does that
automatically). Oh, and I have provided a mechanism whereby you can
drag
the captionless form around the screen... just hold down the Shift
key and
left-click (primary) mouse button in a blank area of the UserForm and
drag
the mouse around.

Rick

'******************* START OF CODE *******************
Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function CreatePolygonRgn Lib "gdi32" _
(lpPoint As POINTAPI, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long) _
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 SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw As Long) _
As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) _
As Long

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

' Used to support captionless drag
Private Declare Function ReleaseCapture Lib "user32" () As Long

' Used to support captionless drag
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Dim hWnd As Long
Dim DefinedRegion As Long
Dim DiffX As Single
Dim DiffY As Single
Dim MoveIt As Boolean
Dim MyRegion(5) As POINTAPI

Private Sub UserForm_Initialize()
Dim opt As Object
Me.Width = 400
Me.Height = 300
OptionButton1.Move 130, 50, 100, 25
OptionButton2.Move 130, 80, 100, 25
OptionButton3.Move 130, 110, 100, 25
CommandButton1.Move 115, 150, 80, 25
hWnd = FindWindow("ThunderDFrame", Me.Caption)
' MyRegion used to define polygon shape
' Note: Do NOT close the polygon back to the origin
MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 150
MyRegion(1).Y = 30
MyRegion(2).X = 450
MyRegion(2).Y = 150
MyRegion(3).X = 250
MyRegion(3).Y = 380
MyRegion(4).X = 0
MyRegion(4).Y = 300
MyRegion(5).X = 100
MyRegion(5).Y = 275
CommandButton1.Caption = "Exit"
OptionButton1.Caption = "Polygon"
OptionButton2.Caption = "Ellipse1"
OptionButton3.Caption = "Ellipse2"
End Sub

' Used to support captionless drag
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
If Button = xlPrimaryButton And Shift = 1 Then
Call ReleaseCapture
Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&)
End If
End Sub

Private Sub OptionButton1_Click()
DefinedRegion = CreatePolygonRgn&(MyRegion(0), 1 + UBound(MyRegion),
1)
SetWindowRgn hWnd, DefinedRegion, True
DeleteObject DefinedRegion
End Sub

Private Sub OptionButton2_Click()
DefinedRegion = CreateEllipticRgn(20, 75, 400, 300)
SetWindowRgn hWnd, DefinedRegion, True
DeleteObject DefinedRegion
End Sub

Private Sub OptionButton3_Click()
DefinedRegion = CreateEllipticRgn(120, 50, 300, 400)
SetWindowRgn hWnd, DefinedRegion, True
DeleteObject DefinedRegion
End Sub

Private Sub CommandButton1_Click()
DeleteObject DefinedRegion
Unload Me
End Sub
'******************* END OF CODE *******************



"Geoff" wrote in message
...
A form which is not rectangular. The closest I've come to a solution
is
this
link:
http://www.vbaccelerator.com/home/VB...ng/article.asp

But this is in VB6 which I do not have access to and so I cannot
decompile
their solution.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

Can you provide more detail as to what you have in mind by an
"irregular
shaped form"?

Rick


"Geoff" wrote in message
...
Hi
How can I produce an irregular shaped form ie with a mask.

Any help is appreciated.

Geoff

I forgot to mention that I agree with you about implementing the ability to
move the captionless form around... I think it is kind of neat myself. The
ReleaseCapture method I employed is probably the easiest and most compact
method to so.

Rick


"Rick Rothstein (MVP - VB)" wrote in
message ...
I implemented the Shift requirement for moving the UserForm around on
purpose. Doing it that way preserves your ability to implement Click event
code for the UserForm, it stops the user from accidentally moving the form
by a stray click drag, and I kind of thought using the Shift key was a good
memory aid for the user, as in "you press the Shift key to shift the
UserForm around".

Rick


"Geoff" wrote in message
...
Correction:
"xlprimaryButton" is ok - however "If Button and 1 Then" permits me to
move
the form around without the need for Shift. Captionless and moving the
form
are important features.

Geoff

"Geoff" wrote:

Hi Rick
The only thing I've noticed so far is it didn't like "xlprimaryButton"
in
MouseDown so I changed the line to:
"If Button and 1 Then" and it now works as expected.

I presume that defining the region prevents a caption being added to the
shape? If so how would I define a simple rectangle? I have a custom
msgbox
from which I remove the caption but the code is quite longwinded and
yours is
much briefer.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

By the way... one thing I forgot to mention is that those coordinates
for
the polygon (the MyRegion array) are in pixels (I'm pretty sure all
API
window measurements are always in pixels), not Points, with the 0,0
coordinate being in the normal upper, left corner of the UserForm.

Rick


"Rick Rothstein (MVP - VB)"
wrote in
message ...
Okay, here is a different method to create shaped forms for you to
play
around with based on code I developed quite awhile ago in the
compiled VB
newsgroups. It is not as flexible, shape-wise as the method in the
link
you posted, but it was easier for me to develop given I had all the
code
and it is a method I am familiar with. Check back in this thread
later
today or tomorrow to see if I was able to make use of them method
from you
link.

Insert a UserForm into your project and add 3 OptionButtons and a
CommandButton to the UserForm (don't worry about size or location,
the
code will handle that). Copy paste the code below my signature into
the
UserForm's code window and Run it. You will be presented with 3
different
shapes you can make your UserForm via the OptionButtons. Press the
CommandButton to exit. Important... note the Delete Object call in
the
CommandButton's click event... you must delete the Region objects
you
create before exiting your running code, otherwise they will remain
in
memory after your Excel session ends and, if the user runs your code
enough, eventually crash the user's system. Using the API requires
extra
attention to details that working in VBA doesn't, so be warned.

Finally, the polygon method will allow you to create intricately
shaped
UserForms, just change the MyRegion array to contain enough points
to form
the intended shape and set the indicated X,Y coordinates for it.
And, as
noted in the comments, do NOT set the last polygon point equal to
the
first one (that is, do not close the polygon) as the API does that
automatically). Oh, and I have provided a mechanism whereby you can
drag
the captionless form around the screen... just hold down the Shift
key and
left-click (primary) mouse button in a blank area of the UserForm
and drag
the mouse around.

Rick

'******************* START OF CODE *******************
Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function CreatePolygonRgn Lib "gdi32" _
(lpPoint As POINTAPI, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long) _
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 SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw As Long) _
As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) _
As Long

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

' Used to support captionless drag
Private Declare Function ReleaseCapture Lib "user32" () As Long

' Used to support captionless drag
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Dim hWnd As Long
Dim DefinedRegion As Long
Dim DiffX As Single
Dim DiffY As Single
Dim MoveIt As Boolean
Dim MyRegion(5) As POINTAPI

Private Sub UserForm_Initialize()
Dim opt As Object
Me.Width = 400
Me.Height = 300
OptionButton1.Move 130, 50, 100, 25
OptionButton2.Move 130, 80, 100, 25
OptionButton3.Move 130, 110, 100, 25
CommandButton1.Move 115, 150, 80, 25
hWnd = FindWindow("ThunderDFrame", Me.Caption)
' MyRegion used to define polygon shape
' Note: Do NOT close the polygon back to the origin
MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 150
MyRegion(1).Y = 30
MyRegion(2).X = 450
MyRegion(2).Y = 150
MyRegion(3).X = 250
MyRegion(3).Y = 380
MyRegion(4).X = 0
MyRegion(4).Y = 300
MyRegion(5).X = 100
MyRegion(5).Y = 275
CommandButton1.Caption = "Exit"
OptionButton1.Caption = "Polygon"
OptionButton2.Caption = "Ellipse1"
OptionButton3.Caption = "Ellipse2"
End Sub

' Used to support captionless drag
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
If Button = xlPrimaryButton And Shift = 1 Then
Call ReleaseCapture
Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&)
End If
End Sub

Private Sub OptionButton1_Click()
DefinedRegion = CreatePolygonRgn&(MyRegion(0), 1 +
UBound(MyRegion), 1)
SetWindowRgn hWnd, DefinedRegion, True
DeleteObject DefinedRegion
End Sub

Private Sub OptionButton2_Click()
DefinedRegion = CreateEllipticRgn(20, 75, 400, 300)
SetWindowRgn hWnd, DefinedRegion, True
DeleteObject DefinedRegion
End Sub

Private Sub OptionButton3_Click()
DefinedRegion = CreateEllipticRgn(120, 50, 300, 400)
SetWindowRgn hWnd, DefinedRegion, True
DeleteObject DefinedRegion
End Sub

Private Sub CommandButton1_Click()
DeleteObject DefinedRegion
Unload Me
End Sub
'******************* END OF CODE *******************



"Geoff" wrote in message
...
A form which is not rectangular. The closest I've come to a
solution is
this
link:
http://www.vbaccelerator.com/home/VB...ng/article.asp

But this is in VB6 which I do not have access to and so I cannot
decompile
their solution.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

Can you provide more detail as to what you have in mind by an
"irregular
shaped form"?

Rick


"Geoff" wrote in message
...
Hi
How can I produce an irregular shaped form ie with a mask.

Any help is appreciated.

Geoff