G
Geoff
Hi
How can I produce an irregular shaped form ie with a mask.
Any help is appreciated.
Geoff
How can I produce an irregular shaped form ie with a mask.
Any help is appreciated.
Geoff
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
R
Rick Rothstein \(MVP - VB\)
Can you provide more detail as to what you have in mind by an "irregular
shaped form"?
Rick
shaped form"?
Rick
G
Geoff
A form which is not rectangular. The closest I've come to a solution is this
link:
http://www.vbaccelerator.com/home/V...apes/Window_Shapes_Using_Layering/article.asp
But this is in VB6 which I do not have access to and so I cannot decompile
their solution.
Geoff
link:
http://www.vbaccelerator.com/home/V...apes/Window_Shapes_Using_Layering/article.asp
But this is in VB6 which I do not have access to and so I cannot decompile
their solution.
Geoff
R
Rick Rothstein \(MVP - VB\)
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 *******************
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 *******************
G
Geoff
Hi Rick
Thank you I will take a look at the code you provided and also check in
later as you suggest.
Geoff
Thank you I will take a look at the code you provided and also check in
later as you suggest.
Geoff
R
Rick Rothstein \(MVP - VB\)
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
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
G
Geoff
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
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
G
Geoff
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
"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
R
Rick Rothstein \(MVP - VB\)
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
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
R
Rick Rothstein \(MVP - VB\)
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
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
R
Rick Rothstein \(MVP - VB\)
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
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
G
Geoff
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
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
R
Rick Rothstein \(MVP - VB\)
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
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
G
Geoff
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
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
G
Geoff
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/V...ing_Layering/Simple_Layered_Window_Sample.asp
Geoff
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/V...ing_Layering/Simple_Layered_Window_Sample.asp
Geoff
R
Rick Rothstein \(MVP - VB\)
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
**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
G
Geoff
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
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
R
Rick Rothstein \(MVP - VB\)
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
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
Ask a Question
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.