ExcelBanter - Irregular Shape

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Irregular Shape (https://www.excelbanter.com/excel-programming/412101-irregular-shape.html)

Geoff

Irregular Shape

Hi
How can I produce an irregular shaped form ie with a mask.

Any help is appreciated.

Geoff

Rick Rothstein \(MVP - VB\)[_2062_]

Irregular Shape

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

Geoff

Irregular Shape

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

Rick Rothstein \(MVP - VB\)[_2063_]

Irregular Shape

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

Geoff

Irregular Shape

Hi Rick
Thank you I will take a look at the code you provided and also check in
later as you suggest.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

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

Rick Rothstein \(MVP - VB\)[_2064_]

Irregular Shape

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

Geoff

Irregular Shape

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

Geoff

Irregular Shape

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

Rick Rothstein \(MVP - VB\)[_2065_]

Irregular Shape

I'm not sure I understand what your new question is asking. Are you asking
if you can leave the title bar on the UserForm but remove other parts of it?
If so, yes, by just defining the polygon's top "line" with a Y coordinate of
0. If you are asking how to have a "title" on a form that you removed the
title bar from, then I would just place a Label on the UserForm. If neither
of these is what you are asking, can you give me some additional description
of what you want to do? As for defining a simple rectangle, just define (in
order) the 4 coordinates. For example, modify the code I gave you earlier as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

"Geoff" wrote in message
...
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

Rick Rothstein \(MVP - VB\)[_2066_]

Irregular Shape

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

Rick Rothstein \(MVP - VB\)[_2068_]

Irregular Shape

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

Geoff

Irregular Shape

Thank you. In my rushed experiments I couldn't get the coordinates right for
the rectangle and the form just disappeared leaving nothing. The reason I
asked how to draw a rectangle was simply because the code I've adapted from
Steven Bullen's Form Fun was verbose compared to the method you have
demonstrated.

I appreciate the time you have given so far and I look forward to seeing if
you can make anything of the link I provided as I perceive that as having the
advantage of being able to define any form shape from an image with a mask.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure I understand what your new question is asking. Are you asking
if you can leave the title bar on the UserForm but remove other parts of it?
If so, yes, by just defining the polygon's top "line" with a Y coordinate of
0. If you are asking how to have a "title" on a form that you removed the
title bar from, then I would just place a Label on the UserForm. If neither
of these is what you are asking, can you give me some additional description
of what you want to do? As for defining a simple rectangle, just define (in
order) the 4 coordinates. For example, modify the code I gave you earlier as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

"Geoff" wrote in message
...
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

Rick Rothstein \(MVP - VB\)[_2078_]

Irregular Shape

Okay, I loaded the code from the link, changed all the stuff that needed
changing and finally got it to run without errors. However, it did not make
the form take on the shape of the image. I may have done something wrong, so
I'll need more time to check what happened. Oh, but the code **did**
implement the translucent feature correctly though... looks neat. Another
problem I'm having is something I did recently screwed up my copy of VB6
(compiled version), so at the moment I can't run his source code in order to
trace what is going on in it. Tomorrow, I'll try to reload VB6 and then look
at the source code in its native program environment. Keep checking back to
this thread... eventually I'll either post successful code or a message
saying I can't figure out how to do it this way.

Rick

"Geoff" wrote in message
...
Thank you. In my rushed experiments I couldn't get the coordinates right
for
the rectangle and the form just disappeared leaving nothing. The reason I
asked how to draw a rectangle was simply because the code I've adapted
from
Steven Bullen's Form Fun was verbose compared to the method you have
demonstrated.

I appreciate the time you have given so far and I look forward to seeing
if
you can make anything of the link I provided as I perceive that as having
the
advantage of being able to define any form shape from an image with a
mask.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure I understand what your new question is asking. Are you
asking
if you can leave the title bar on the UserForm but remove other parts of
it?
If so, yes, by just defining the polygon's top "line" with a Y coordinate
of
0. If you are asking how to have a "title" on a form that you removed the
title bar from, then I would just place a Label on the UserForm. If
neither
of these is what you are asking, can you give me some additional
description
of what you want to do? As for defining a simple rectangle, just define
(in
order) the 4 coordinates. For example, modify the code I gave you earlier
as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

"Geoff" wrote in message
...
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

Geoff

Irregular Shape

Hi Rick
I am grateful for your interest, persistance and explanations.

Apart from caption related properties I trust when using the Region method
the form does not lose other properties?
Experimenting with the current project using captionless regular shapes it
seems there would be some advantages in using the Region method.
By defining a rectangular region it removes the caption and the layering,
described below, is not evident and the form seems to draw quicker as well.

FWIW, below is the code I'm using at the moment. Whilst it works it has
some negatives.
In the current project the main form has a picture with a black background.
It seems as if the form is drawn twice and often flickers as it is Shown.
First, the outine is drawn with a
background of white and then the picture is painted over. The larger the
form and the darker the picture the more obvious this becomes.

Can I with confidence abandon this in favour of regions?

I await further developments as you advise.

Geoff

in the form code module:
Option Explicit

'''form changer declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Const WS_CAPTION = &HC00000
Private Const GWL_STYLE = (-16)

'''form move declarations
Dim mOriginX As Double
Dim mOriginY As Double

'''form stop trail declarations
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd
As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As
Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hWnd As Long

Private Sub UserForm_activate()
Dim lngWinIdx As Long
'''stop form trail when moving
hWnd = GetActiveWindow
lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, 255, LWA_ALPHA
End Sub

Private Sub UserForm_Initialize()
Dim lngFormHwnd As Long, lngFormStyle As Long
If Application.Version < 9 Then
lngFormHwnd = FindWindow("THUNDERXFRAME", Me.Caption)
Else
lngFormHwnd = FindWindow("THUNDERDFRAME", Me.Caption)
End If
'''remove form header
lngFormStyle = GetWindowLong(lngFormHwnd, GWL_STYLE)
lngFormStyle = lngFormStyle And Not WS_CAPTION
SetWindowLong lngFormHwnd, GWL_STYLE, lngFormStyle
DrawMenuBar lngFormHwnd
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''store start point
mOriginX = X
mOriginY = Y
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''move form as the mouse moves with left button down
If Button And 1 Then
frmMsgBox.Left = frmMsgBox.Left + (X - mOriginX)
frmMsgBox.Top = frmMsgBox.Top + (Y - mOriginY)
End If
End Sub

in a class module CFormChanger adapted from S. Bullen's Form Fun
Option Explicit

''Declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetSystemMenu Lib "user32" (ByVal hWnd As Long,
ByVal bRevert As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long

'''Window styles
Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_SYSMENU As Long = &H80000

Dim moForm As Object
Dim mhWndForm As Long
Dim mbCaption As Boolean, mbSysMenu As Boolean, mbCloseBtn As Boolean

Private Sub Class_Initialize()
'''* Set class's initial properties to a default userform
mbCaption = True
mbSysMenu = True
mbCloseBtn = True
End Sub

Public Property Set Form(oForm As Object)
'''* Get userform's window handle
If Val(Application.Version) < 9 Then
mhWndForm = FindWindow("ThunderXFrame", oForm.Caption)
Else
mhWndForm = FindWindow("ThunderDFrame", oForm.Caption)
End If
SetFormStyle
End Property

Public Property Let ShowSysMenu(bSysMenu As Boolean)
'''* Get and set form's window styles
mbSysMenu = bSysMenu
SetFormStyle
End Property

Public Property Get ShowSysMenu() As Boolean
ShowSysMenu = mbSysMenu
End Property

Public Property Let ShowCloseBtn(bCloseBtn As Boolean)
mbCloseBtn = bCloseBtn
SetFormStyle
End Property

Public Property Get ShowCloseBtn() As Boolean
ShowCloseBtn = mbCloseBtn
End Property

Private Sub SetFormStyle()
'''* Perform updates
Dim lStyle As Long, hMenu As Long
If mhWndForm = 0 Then Exit Sub
lStyle = GetWindowLong(mhWndForm, GWL_STYLE)
SetBit lStyle, WS_CAPTION, mbCaption
SetBit lStyle, WS_SYSMENU, mbSysMenu
SetWindowLong mhWndForm, GWL_STYLE, lStyle
DrawMenuBar mhWndForm
SetFocus mhWndForm
End Sub

Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As
Boolean)
'''* Set or clear bit from style flag
If bOn Then
lStyle = lStyle Or lBit
Else
lStyle = lStyle And Not lBit
End If
End Sub

"Rick Rothstein (MVP - VB)" wrote:

Okay, I loaded the code from the link, changed all the stuff that needed
changing and finally got it to run without errors. However, it did not make
the form take on the shape of the image. I may have done something wrong, so
I'll need more time to check what happened. Oh, but the code **did**
implement the translucent feature correctly though... looks neat. Another
problem I'm having is something I did recently screwed up my copy of VB6
(compiled version), so at the moment I can't run his source code in order to
trace what is going on in it. Tomorrow, I'll try to reload VB6 and then look
at the source code in its native program environment. Keep checking back to
this thread... eventually I'll either post successful code or a message
saying I can't figure out how to do it this way.

Rick

"Geoff" wrote in message
...
Thank you. In my rushed experiments I couldn't get the coordinates right
for
the rectangle and the form just disappeared leaving nothing. The reason I
asked how to draw a rectangle was simply because the code I've adapted
from
Steven Bullen's Form Fun was verbose compared to the method you have
demonstrated.

I appreciate the time you have given so far and I look forward to seeing
if
you can make anything of the link I provided as I perceive that as having
the
advantage of being able to define any form shape from an image with a
mask.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure I understand what your new question is asking. Are you
asking
if you can leave the title bar on the UserForm but remove other parts of
it?
If so, yes, by just defining the polygon's top "line" with a Y coordinate
of
0. If you are asking how to have a "title" on a form that you removed the
title bar from, then I would just place a Label on the UserForm. If
neither
of these is what you are asking, can you give me some additional
description
of what you want to do? As for defining a simple rectangle, just define
(in
order) the 4 coordinates. For example, modify the code I gave you earlier
as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

"Geoff" wrote in message
...
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:

Geoff

Irregular Shape

Apologies if you have already seen this but I was a little puzzled by the
difficulties you expressed as the example ran without problems for me but as
I've mentioned I cannot decompile the code
http://www.vbaccelerator.com/home/VB...dow_Sample.asp

Geoff

"Rick Rothstein (MVP - VB)" wrote:

Okay, I loaded the code from the link, changed all the stuff that needed
changing and finally got it to run without errors. However, it did not make
the form take on the shape of the image. I may have done something wrong, so
I'll need more time to check what happened. Oh, but the code **did**
implement the translucent feature correctly though... looks neat. Another
problem I'm having is something I did recently screwed up my copy of VB6
(compiled version), so at the moment I can't run his source code in order to
trace what is going on in it. Tomorrow, I'll try to reload VB6 and then look
at the source code in its native program environment. Keep checking back to
this thread... eventually I'll either post successful code or a message
saying I can't figure out how to do it this way.

Rick

"Geoff" wrote in message
...
Thank you. In my rushed experiments I couldn't get the coordinates right
for
the rectangle and the form just disappeared leaving nothing. The reason I
asked how to draw a rectangle was simply because the code I've adapted
from
Steven Bullen's Form Fun was verbose compared to the method you have
demonstrated.

I appreciate the time you have given so far and I look forward to seeing
if
you can make anything of the link I provided as I perceive that as having
the
advantage of being able to define any form shape from an image with a
mask.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure I understand what your new question is asking. Are you
asking
if you can leave the title bar on the UserForm but remove other parts of
it?
If so, yes, by just defining the polygon's top "line" with a Y coordinate
of
0. If you are asking how to have a "title" on a form that you removed the
title bar from, then I would just place a Label on the UserForm. If
neither
of these is what you are asking, can you give me some additional
description
of what you want to do? As for defining a simple rectangle, just define
(in
order) the 4 coordinates. For example, modify the code I gave you earlier
as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

"Geoff" wrote in message
...
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:

Rick Rothstein \(MVP - VB\)[_2080_]

Irregular Shape

I finally got the method from the link working. The problem was I
**thought** I had set the color I was going to use to mask out the form with
to pure red (color value 255) in Photoshop, BUT it turns out I mistyped that
as 254; so, my code was looking for color 255 (red) where there was only
"near red". Stupid me. There is some problem with the method though... it
does not mask out the UserForm's titlebar and borders, so you would still
need to use my code to do that.

The masking out of the UserForm part does work, but with one major (at least
to me) drawback... the invisible part of the UserForm is still really there.
You can click/drag the form around (using my captionless drag routine) by
clicking on a supposedly invisible part of the form! Worse (again, to me) is
that you cannot click-through the invisible part of the form. If your
UserForm were shown modeless (so it could be visible but you could still
edit the worksheet), you would not be able to click on a cell that looked
exposed in order to edit it if that cell were located under the "invisible"
portion of the UserForm!

I hope you don't mind, but I think I'll abandon this avenue of investigation
as being not very useful.

One more thing... you asked "Apart from caption related properties I trust
when using the Region method the form does not lose other properties?" I am
not sure... what properties are you talking about here?

Rick

"Geoff" wrote in message
...
Hi Rick
I am grateful for your interest, persistance and explanations.

Apart from caption related properties I trust when using the Region method
the form does not lose other properties?
Experimenting with the current project using captionless regular shapes it
seems there would be some advantages in using the Region method.
By defining a rectangular region it removes the caption and the layering,
described below, is not evident and the form seems to draw quicker as
well.

FWIW, below is the code I'm using at the moment. Whilst it works it has
some negatives.
In the current project the main form has a picture with a black
background.
It seems as if the form is drawn twice and often flickers as it is Shown.
First, the outine is drawn with a
background of white and then the picture is painted over. The larger the
form and the darker the picture the more obvious this becomes.

Can I with confidence abandon this in favour of regions?

I await further developments as you advise.

Geoff

in the form code module:
Option Explicit

'''form changer declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private Const WS_CAPTION = &HC00000
Private Const GWL_STYLE = (-16)

'''form move declarations
Dim mOriginX As Double
Dim mOriginY As Double

'''form stop trail declarations
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal
hWnd
As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As
Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hWnd As Long

Private Sub UserForm_activate()
Dim lngWinIdx As Long
'''stop form trail when moving
hWnd = GetActiveWindow
lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, 255, LWA_ALPHA
End Sub

Private Sub UserForm_Initialize()
Dim lngFormHwnd As Long, lngFormStyle As Long
If Application.Version < 9 Then
lngFormHwnd = FindWindow("THUNDERXFRAME", Me.Caption)
Else
lngFormHwnd = FindWindow("THUNDERDFRAME", Me.Caption)
End If
'''remove form header
lngFormStyle = GetWindowLong(lngFormHwnd, GWL_STYLE)
lngFormStyle = lngFormStyle And Not WS_CAPTION
SetWindowLong lngFormHwnd, GWL_STYLE, lngFormStyle
DrawMenuBar lngFormHwnd
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''store start point
mOriginX = X
mOriginY = Y
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''move form as the mouse moves with left button down
If Button And 1 Then
frmMsgBox.Left = frmMsgBox.Left + (X - mOriginX)
frmMsgBox.Top = frmMsgBox.Top + (Y - mOriginY)
End If
End Sub

in a class module CFormChanger adapted from S. Bullen's Form Fun
Option Explicit

''Declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetSystemMenu Lib "user32" (ByVal hWnd As Long,
ByVal bRevert As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As
Long

'''Window styles
Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_SYSMENU As Long = &H80000

Dim moForm As Object
Dim mhWndForm As Long
Dim mbCaption As Boolean, mbSysMenu As Boolean, mbCloseBtn As Boolean

Private Sub Class_Initialize()
'''* Set class's initial properties to a default userform
mbCaption = True
mbSysMenu = True
mbCloseBtn = True
End Sub

Public Property Set Form(oForm As Object)
'''* Get userform's window handle
If Val(Application.Version) < 9 Then
mhWndForm = FindWindow("ThunderXFrame", oForm.Caption)
Else
mhWndForm = FindWindow("ThunderDFrame", oForm.Caption)
End If
SetFormStyle
End Property

Public Property Let ShowSysMenu(bSysMenu As Boolean)
'''* Get and set form's window styles
mbSysMenu = bSysMenu
SetFormStyle
End Property

Public Property Get ShowSysMenu() As Boolean
ShowSysMenu = mbSysMenu
End Property

Public Property Let ShowCloseBtn(bCloseBtn As Boolean)
mbCloseBtn = bCloseBtn
SetFormStyle
End Property

Public Property Get ShowCloseBtn() As Boolean
ShowCloseBtn = mbCloseBtn
End Property

Private Sub SetFormStyle()
'''* Perform updates
Dim lStyle As Long, hMenu As Long
If mhWndForm = 0 Then Exit Sub
lStyle = GetWindowLong(mhWndForm, GWL_STYLE)
SetBit lStyle, WS_CAPTION, mbCaption
SetBit lStyle, WS_SYSMENU, mbSysMenu
SetWindowLong mhWndForm, GWL_STYLE, lStyle
DrawMenuBar mhWndForm
SetFocus mhWndForm
End Sub

Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As
Boolean)
'''* Set or clear bit from style flag
If bOn Then
lStyle = lStyle Or lBit
Else
lStyle = lStyle And Not lBit
End If
End Sub

"Rick Rothstein (MVP - VB)" wrote:

Okay, I loaded the code from the link, changed all the stuff that needed
changing and finally got it to run without errors. However, it did not
make
the form take on the shape of the image. I may have done something wrong,
so
I'll need more time to check what happened. Oh, but the code **did**
implement the translucent feature correctly though... looks neat. Another
problem I'm having is something I did recently screwed up my copy of VB6
(compiled version), so at the moment I can't run his source code in order
to
trace what is going on in it. Tomorrow, I'll try to reload VB6 and then
look
at the source code in its native program environment. Keep checking back
to
this thread... eventually I'll either post successful code or a message
saying I can't figure out how to do it this way.

Rick

"Geoff" wrote in message
...
Thank you. In my rushed experiments I couldn't get the coordinates
right
for
the rectangle and the form just disappeared leaving nothing. The
reason I
asked how to draw a rectangle was simply because the code I've adapted
from
Steven Bullen's Form Fun was verbose compared to the method you have
demonstrated.

I appreciate the time you have given so far and I look forward to
seeing
if
you can make anything of the link I provided as I perceive that as
having
the
advantage of being able to define any form shape from an image with a
mask.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure I understand what your new question is asking. Are you
asking
if you can leave the title bar on the UserForm but remove other parts
of
it?
If so, yes, by just defining the polygon's top "line" with a Y
coordinate
of
0. If you are asking how to have a "title" on a form that you removed
the
title bar from, then I would just place a Label on the UserForm. If
neither
of these is what you are asking, can you give me some additional
description
of what you want to do? As for defining a simple rectangle, just
define
(in
order) the 4 coordinates. For example, modify the code I gave you
earlier
as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

"Geoff" wrote in message
...
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:

Geoff

Irregular Shape

One of the functions of the form I'm currently working on is to enable the
user to select columns. Each selection is then shown on pairs of controls
which show the selected column letter and sample data. As the form has,
proportionally, large areas of black then masking that colour would produce a
number of holes which may tempt the user to as you say click-through. It
seems then that 'holes' are to be avoided by using other colours and the use
of this code is then confined to the form edges.

With the present method you can perceive a flicker as the form is drawn in 2
stages. First the form's border is drawn with a white background then it is
overlaid with the picture. The darker the picture and the bigger the form,
the more noticeable the flicker becomes. Now, by employing a rectangular
Region, I can draw the form without a caption, without a border, without a
flicker and much quicker too. That has got to be a win.

Re other properties, I was taking note of your warning about working with
VB6 functions. I was meaning things like focus, hide, modal etc. But I can
experiment with those.

Thank you for the work you have done. I'm grateful for the advice.

Geoff
"Rick Rothstein (MVP - VB)" wrote:

I finally got the method from the link working. The problem was I
**thought** I had set the color I was going to use to mask out the form with
to pure red (color value 255) in Photoshop, BUT it turns out I mistyped that
as 254; so, my code was looking for color 255 (red) where there was only
"near red". Stupid me. There is some problem with the method though... it
does not mask out the UserForm's titlebar and borders, so you would still
need to use my code to do that.

The masking out of the UserForm part does work, but with one major (at least
to me) drawback... the invisible part of the UserForm is still really there.
You can click/drag the form around (using my captionless drag routine) by
clicking on a supposedly invisible part of the form! Worse (again, to me) is
that you cannot click-through the invisible part of the form. If your
UserForm were shown modeless (so it could be visible but you could still
edit the worksheet), you would not be able to click on a cell that looked
exposed in order to edit it if that cell were located under the "invisible"
portion of the UserForm!

I hope you don't mind, but I think I'll abandon this avenue of investigation
as being not very useful.

One more thing... you asked "Apart from caption related properties I trust
when using the Region method the form does not lose other properties?" I am
not sure... what properties are you talking about here?

Rick

"Geoff" wrote in message
...
Hi Rick
I am grateful for your interest, persistance and explanations.

Apart from caption related properties I trust when using the Region method
the form does not lose other properties?
Experimenting with the current project using captionless regular shapes it
seems there would be some advantages in using the Region method.
By defining a rectangular region it removes the caption and the layering,
described below, is not evident and the form seems to draw quicker as
well.

FWIW, below is the code I'm using at the moment. Whilst it works it has
some negatives.
In the current project the main form has a picture with a black
background.
It seems as if the form is drawn twice and often flickers as it is Shown.
First, the outine is drawn with a
background of white and then the picture is painted over. The larger the
form and the darker the picture the more obvious this becomes.

Can I with confidence abandon this in favour of regions?

I await further developments as you advise.

Geoff

in the form code module:
Option Explicit

'''form changer declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private Const WS_CAPTION = &HC00000
Private Const GWL_STYLE = (-16)

'''form move declarations
Dim mOriginX As Double
Dim mOriginY As Double

'''form stop trail declarations
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal
hWnd
As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As
Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hWnd As Long

Private Sub UserForm_activate()
Dim lngWinIdx As Long
'''stop form trail when moving
hWnd = GetActiveWindow
lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, 255, LWA_ALPHA
End Sub

Private Sub UserForm_Initialize()
Dim lngFormHwnd As Long, lngFormStyle As Long
If Application.Version < 9 Then
lngFormHwnd = FindWindow("THUNDERXFRAME", Me.Caption)
Else
lngFormHwnd = FindWindow("THUNDERDFRAME", Me.Caption)
End If
'''remove form header
lngFormStyle = GetWindowLong(lngFormHwnd, GWL_STYLE)
lngFormStyle = lngFormStyle And Not WS_CAPTION
SetWindowLong lngFormHwnd, GWL_STYLE, lngFormStyle
DrawMenuBar lngFormHwnd
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''store start point
mOriginX = X
mOriginY = Y
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''move form as the mouse moves with left button down
If Button And 1 Then
frmMsgBox.Left = frmMsgBox.Left + (X - mOriginX)
frmMsgBox.Top = frmMsgBox.Top + (Y - mOriginY)
End If
End Sub

in a class module CFormChanger adapted from S. Bullen's Form Fun
Option Explicit

''Declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetSystemMenu Lib "user32" (ByVal hWnd As Long,
ByVal bRevert As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As
Long

'''Window styles
Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_SYSMENU As Long = &H80000

Dim moForm As Object
Dim mhWndForm As Long
Dim mbCaption As Boolean, mbSysMenu As Boolean, mbCloseBtn As Boolean

Private Sub Class_Initialize()
'''* Set class's initial properties to a default userform
mbCaption = True
mbSysMenu = True
mbCloseBtn = True
End Sub

Public Property Set Form(oForm As Object)
'''* Get userform's window handle
If Val(Application.Version) < 9 Then
mhWndForm = FindWindow("ThunderXFrame", oForm.Caption)
Else
mhWndForm = FindWindow("ThunderDFrame", oForm.Caption)
End If
SetFormStyle
End Property

Public Property Let ShowSysMenu(bSysMenu As Boolean)
'''* Get and set form's window styles
mbSysMenu = bSysMenu
SetFormStyle
End Property

Public Property Get ShowSysMenu() As Boolean
ShowSysMenu = mbSysMenu
End Property

Public Property Let ShowCloseBtn(bCloseBtn As Boolean)
mbCloseBtn = bCloseBtn
SetFormStyle
End Property

Public Property Get ShowCloseBtn() As Boolean
ShowCloseBtn = mbCloseBtn
End Property

Private Sub SetFormStyle()
'''* Perform updates
Dim lStyle As Long, hMenu As Long
If mhWndForm = 0 Then Exit Sub
lStyle = GetWindowLong(mhWndForm, GWL_STYLE)
SetBit lStyle, WS_CAPTION, mbCaption
SetBit lStyle, WS_SYSMENU, mbSysMenu
SetWindowLong mhWndForm, GWL_STYLE, lStyle
DrawMenuBar mhWndForm
SetFocus mhWndForm
End Sub

Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As
Boolean)
'''* Set or clear bit from style flag
If bOn Then
lStyle = lStyle Or lBit
Else
lStyle = lStyle And Not lBit
End If
End Sub

"Rick Rothstein (MVP - VB)" wrote:

Okay, I loaded the code from the link, changed all the stuff that needed
changing and finally got it to run without errors. However, it did not
make
the form take on the shape of the image. I may have done something wrong,
so
I'll need more time to check what happened. Oh, but the code **did**
implement the translucent feature correctly though... looks neat. Another
problem I'm having is something I did recently screwed up my copy of VB6
(compiled version), so at the moment I can't run his source code in order
to
trace what is going on in it. Tomorrow, I'll try to reload VB6 and then
look
at the source code in its native program environment. Keep checking back
to
this thread... eventually I'll either post successful code or a message
saying I can't figure out how to do it this way.

Rick

"Geoff" wrote in message
...
Thank you. In my rushed experiments I couldn't get the coordinates
right
for
the rectangle and the form just disappeared leaving nothing. The
reason I
asked how to draw a rectangle was simply because the code I've adapted
from
Steven Bullen's Form Fun was verbose compared to the method you have
demonstrated.

I appreciate the time you have given so far and I look forward to
seeing
if
you can make anything of the link I provided as I perceive that as
having
the
advantage of being able to define any form shape from an image with a
mask.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure I understand what your new question is asking. Are you
asking
if you can leave the title bar on the UserForm but remove other parts
of
it?
If so, yes, by just defining the polygon's top "line" with a Y
coordinate
of
0. If you are asking how to have a "title" on a form that you removed
the
title bar from, then I would just place a Label on the UserForm. If
neither
of these is what you are asking, can you give me some additional
description
of what you want to do? As for defining a simple rectangle, just
define
(in
order) the 4 coordinates. For example, modify the code I gave you
earlier
as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

Rick Rothstein \(MVP - VB\)[_2086_]

Irregular Shape

Just to point out the obvious for those still following this thread... you
can approximate, to a high degree of **apparent** accuracy, any shape via
the polygon method shown in the code I posted at the beginning of this
thread (visually, an approximate near shape would suffice to the eye in
place of an exactly accurate shape)... the array holding the coordinates of
the shape can have a huge number of elements if necessary (but a near shape
would go far to keep the number of elements low).

Rick

"Geoff" wrote in message
...
One of the functions of the form I'm currently working on is to enable the
user to select columns. Each selection is then shown on pairs of controls
which show the selected column letter and sample data. As the form has,
proportionally, large areas of black then masking that colour would
produce a
number of holes which may tempt the user to as you say click-through. It
seems then that 'holes' are to be avoided by using other colours and the
use
of this code is then confined to the form edges.

With the present method you can perceive a flicker as the form is drawn in
2
stages. First the form's border is drawn with a white background then it
is
overlaid with the picture. The darker the picture and the bigger the
form,
the more noticeable the flicker becomes. Now, by employing a rectangular
Region, I can draw the form without a caption, without a border, without a
flicker and much quicker too. That has got to be a win.

Re other properties, I was taking note of your warning about working with
VB6 functions. I was meaning things like focus, hide, modal etc. But I
can
experiment with those.

Thank you for the work you have done. I'm grateful for the advice.

Geoff
"Rick Rothstein (MVP - VB)" wrote:

I finally got the method from the link working. The problem was I
**thought** I had set the color I was going to use to mask out the form
with
to pure red (color value 255) in Photoshop, BUT it turns out I mistyped
that
as 254; so, my code was looking for color 255 (red) where there was only
"near red". Stupid me. There is some problem with the method though... it
does not mask out the UserForm's titlebar and borders, so you would still
need to use my code to do that.

The masking out of the UserForm part does work, but with one major (at
least
to me) drawback... the invisible part of the UserForm is still really
there.
You can click/drag the form around (using my captionless drag routine) by
clicking on a supposedly invisible part of the form! Worse (again, to me)
is
that you cannot click-through the invisible part of the form. If your
UserForm were shown modeless (so it could be visible but you could still
edit the worksheet), you would not be able to click on a cell that looked
exposed in order to edit it if that cell were located under the
"invisible"
portion of the UserForm!

I hope you don't mind, but I think I'll abandon this avenue of
investigation
as being not very useful.

One more thing... you asked "Apart from caption related properties I
trust
when using the Region method the form does not lose other properties?" I
am
not sure... what properties are you talking about here?

Rick

"Geoff" wrote in message
...
Hi Rick
I am grateful for your interest, persistance and explanations.

Apart from caption related properties I trust when using the Region
method
the form does not lose other properties?
Experimenting with the current project using captionless regular shapes
it
seems there would be some advantages in using the Region method.
By defining a rectangular region it removes the caption and the
layering,
described below, is not evident and the form seems to draw quicker as
well.

FWIW, below is the code I'm using at the moment. Whilst it works it
has
some negatives.
In the current project the main form has a picture with a black
background.
It seems as if the form is drawn twice and often flickers as it is
Shown.
First, the outine is drawn with a
background of white and then the picture is painted over. The larger
the
form and the darker the picture the more obvious this becomes.

Can I with confidence abandon this in favour of regions?

I await further developments as you advise.

Geoff

in the form code module:
Option Explicit

'''form changer declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" Alias
"GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long)
As
Long
Private Const WS_CAPTION = &HC00000
Private Const GWL_STYLE = (-16)

'''form move declarations
Dim mOriginX As Double
Dim mOriginY As Double

'''form stop trail declarations
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal
hWnd
As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags
As
Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hWnd As Long

Private Sub UserForm_activate()
Dim lngWinIdx As Long
'''stop form trail when moving
hWnd = GetActiveWindow
lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, 255, LWA_ALPHA
End Sub

Private Sub UserForm_Initialize()
Dim lngFormHwnd As Long, lngFormStyle As Long
If Application.Version < 9 Then
lngFormHwnd = FindWindow("THUNDERXFRAME", Me.Caption)
Else
lngFormHwnd = FindWindow("THUNDERDFRAME", Me.Caption)
End If
'''remove form header
lngFormStyle = GetWindowLong(lngFormHwnd, GWL_STYLE)
lngFormStyle = lngFormStyle And Not WS_CAPTION
SetWindowLong lngFormHwnd, GWL_STYLE, lngFormStyle
DrawMenuBar lngFormHwnd
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''store start point
mOriginX = X
mOriginY = Y
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'''move form as the mouse moves with left button down
If Button And 1 Then
frmMsgBox.Left = frmMsgBox.Left + (X - mOriginX)
frmMsgBox.Top = frmMsgBox.Top + (Y - mOriginY)
End If
End Sub

in a class module CFormChanger adapted from S. Bullen's Form Fun
Option Explicit

''Declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) 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 GetSystemMenu Lib "user32" (ByVal hWnd As
Long,
ByVal bRevert As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long)
As
Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As
Long

'''Window styles
Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_SYSMENU As Long = &H80000

Dim moForm As Object
Dim mhWndForm As Long
Dim mbCaption As Boolean, mbSysMenu As Boolean, mbCloseBtn As Boolean

Private Sub Class_Initialize()
'''* Set class's initial properties to a default userform
mbCaption = True
mbSysMenu = True
mbCloseBtn = True
End Sub

Public Property Set Form(oForm As Object)
'''* Get userform's window handle
If Val(Application.Version) < 9 Then
mhWndForm = FindWindow("ThunderXFrame", oForm.Caption)
Else
mhWndForm = FindWindow("ThunderDFrame", oForm.Caption)
End If
SetFormStyle
End Property

Public Property Let ShowSysMenu(bSysMenu As Boolean)
'''* Get and set form's window styles
mbSysMenu = bSysMenu
SetFormStyle
End Property

Public Property Get ShowSysMenu() As Boolean
ShowSysMenu = mbSysMenu
End Property

Public Property Let ShowCloseBtn(bCloseBtn As Boolean)
mbCloseBtn = bCloseBtn
SetFormStyle
End Property

Public Property Get ShowCloseBtn() As Boolean
ShowCloseBtn = mbCloseBtn
End Property

Private Sub SetFormStyle()
'''* Perform updates
Dim lStyle As Long, hMenu As Long
If mhWndForm = 0 Then Exit Sub
lStyle = GetWindowLong(mhWndForm, GWL_STYLE)
SetBit lStyle, WS_CAPTION, mbCaption
SetBit lStyle, WS_SYSMENU, mbSysMenu
SetWindowLong mhWndForm, GWL_STYLE, lStyle
DrawMenuBar mhWndForm
SetFocus mhWndForm
End Sub

Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn
As
Boolean)
'''* Set or clear bit from style flag
If bOn Then
lStyle = lStyle Or lBit
Else
lStyle = lStyle And Not lBit
End If
End Sub

"Rick Rothstein (MVP - VB)" wrote:

Okay, I loaded the code from the link, changed all the stuff that
needed
changing and finally got it to run without errors. However, it did not
make
the form take on the shape of the image. I may have done something
wrong,
so
I'll need more time to check what happened. Oh, but the code **did**
implement the translucent feature correctly though... looks neat.
Another
problem I'm having is something I did recently screwed up my copy of
VB6
(compiled version), so at the moment I can't run his source code in
order
to
trace what is going on in it. Tomorrow, I'll try to reload VB6 and
then
look
at the source code in its native program environment. Keep checking
back
to
this thread... eventually I'll either post successful code or a
message
saying I can't figure out how to do it this way.

Rick

"Geoff" wrote in message
...
Thank you. In my rushed experiments I couldn't get the coordinates
right
for
the rectangle and the form just disappeared leaving nothing. The
reason I
asked how to draw a rectangle was simply because the code I've
adapted
from
Steven Bullen's Form Fun was verbose compared to the method you have
demonstrated.

I appreciate the time you have given so far and I look forward to
seeing
if
you can make anything of the link I provided as I perceive that as
having
the
advantage of being able to define any form shape from an image with
a
mask.

Geoff

"Rick Rothstein (MVP - VB)" wrote:

I'm not sure I understand what your new question is asking. Are you
asking
if you can leave the title bar on the UserForm but remove other
parts
of
it?
If so, yes, by just defining the polygon's top "line" with a Y
coordinate
of
0. If you are asking how to have a "title" on a form that you
removed
the
title bar from, then I would just place a Label on the UserForm. If
neither
of these is what you are asking, can you give me some additional
description
of what you want to do? As for defining a simple rectangle, just
define
(in
order) the 4 coordinates. For example, modify the code I gave you
earlier
as
follows. Change the declaration for MyRegion to this...

Dim MyRegion(3) As POINTAPI

and replace the coordinate assignments for MyRegion to this...

MyRegion(0).X = 50
MyRegion(0).Y = 80
MyRegion(1).X = 350
MyRegion(1).Y = 80
MyRegion(2).X = 350
MyRegion(2).Y = 380
MyRegion(3).X = 50
MyRegion(3).Y = 380

Rick

All times are GMT +1. The time now is 06:39 AM.