Can a User Form shape be changed?

[Noir]

I use my User Forms for Splash screens but, they all have the same basic square shape. Can you change the User Form to round, oval, etc?

Thx,
Noir

 

[Ivan F Moala]

On 2002-06-01 21:15, Noir wrote:
I use my User Forms for Splash screens but, they all have the same basic square shape. Can you change the User Form to round, oval, etc?

Thx,
Noir

Yes you can....Through API calls....
If you are interested...then ..

<pre/>
Option Explicit

' Region API functins Requires Windows NT 3.1 or later; Requires Windows 95 or later
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 CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, _
ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, _
ByVal Y3 As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT) 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 FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' modify the shape of a window
'
' This routine supports three values for SHAPE
' 0 = circle/ellipse, 1 = rounded rect, 2 = rhomb
'
' NOTES: You get best effects using borderless forms
' Remember to provide alternative commands for
' closing and moving the form
'
' MODIFIED: Ivan F Moala 2/6/2002
'

Const msg As String = "Click on the From to see the shape change!"
Const msg2 As String = "Double click on the Form to Close"

Dim FrmWndh As Long
Dim Shp As Long

Sub SetWindowShape(ByVal hWnd As Long, ByVal Shape As Long)
Dim lpRect As RECT
Dim lFrmWidth As Long, lFrmHeight As Long
Dim hRgn As Long

' get the bounding rectangle's size
GetWindowRect hWnd, lpRect
lFrmWidth = lpRect.Right - lpRect.Left
lFrmHeight = lpRect.Bottom - lpRect.Top

' create a region
Select Case Shape
Case 0 ' circle/ellipse
hRgn = CreateEllipticRgn(0, 0, lFrmWidth, lFrmHeight)
Case 1 ' rounded rectangle
hRgn = CreateRoundRectRgn(0, 0, lFrmWidth, lFrmHeight, 40, 40)
Case 2 ' rhomb
Dim lpPoints(3) As POINTAPI
lpPoints(0).X = lFrmWidth 2
lpPoints(0).Y = 0
lpPoints(1).X = 0
lpPoints(1).Y = lFrmHeight 2
lpPoints(2).X = lFrmWidth 2
lpPoints(2).Y = lFrmHeight
lpPoints(3).X = lFrmWidth
lpPoints(3).Y = lFrmHeight 2
hRgn = CreatePolygonRgn(lpPoints(0), 4, 1)
End Select

' trim the window to the region
SetWindowRgn hWnd, hRgn, True
DeleteObject hRgn

End Sub

Private Sub UserForm_Click()
'// Changes the shape when Form is Clicked
Shp = Shp + 1
If Shp > 3 Then Shp = 0
SetWindowShape FrmWndh, Shp
End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'// Leave this here as your backdoor, incase you have NO CLOSE BUTTON
Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
'// Get Forms window handle set Variable NOW!
FrmWndh = FindWindow("ThunderDFrame", Me.Caption)
'// Leave Frm as STD
SetWindowShape FrmWndh, 3

MsgBox msg & vbCr & msg2, vbInformation + vbSystemModal

End Sub
</pre>

 

[Noir]

Ivan,
Thanks for your reply.

Where do i place all of this code?

Thx,
Noir

 

[Ivan F Moala]

On 2002-06-02 07:52, Noir wrote:
Ivan,
Thanks for your reply.

Where do i place all of this code?

Thx,
Noir

In the userforms Code Module

 

[Noir]

Ivan,
Do i just add all of the code "as is" or do i need to remove some of your codes verbiage first? The reason i ask is because i am getting, "Only comments may appear after End Sub...." error messages.

Thx,
Noir

 

[Mark O'Brien]

Nice code Ivan, I can see that rhombus shaped userform being usefull.

Actually, I had a bit of a problem with these lines of code:<pre>
Dim lpPoints(3) As POINTAPI
lpPoints(0).X = lFrmWidth 2
lpPoints(0).Y = 0
lpPoints(1).X = 0
lpPoints(1).Y = lFrmHeight 2
lpPoints(2).X = lFrmWidth 2
lpPoints(2).Y = lFrmHeight
lpPoints(3).X = lFrmWidth
lpPoints(3).Y = lFrmHeight 2</pre>

...because the board put two slashes in. Apart from that, the code ran fine for me.

EDIT:: Yup two slashes, just like it put in for me there. It should only be one slash.
_________________<font color = green> Mark O'Brien
This message was edited by Mark O'Brien on 2002-06-02 16:13

 

[Noir]

Mark,
You say you got the code to work, how? I copied all code starting with the "Option Explicit" line on down. I also removed the extra slashes as you mentioned. Not working.

Maybe it's the way i'm trying to use the code. What is my first step after copying the code to my user form module??

Noir

 

[James]

Hi,

Look at your code. What do you have after End Sub? You shouldn't have any code after End Sub

Regards,
James

 

[Ivan F Moala]

On 2002-06-02 15:20, Noir wrote:
Ivan,
Do i just add all of the code "as is" or do i need to remove some of your codes verbiage first? The reason i ask is because i am getting, "Only comments may appear after End Sub...." error messages.

Thx,
Noir

Hi Noir
If you started with a New Userform, then in the module code, the code should look exacly as posted, without the extra "" ie One and NOT Two path seperators or forward slashes.

good luck

 

[Noir]

Ivan,
OK.How do i get to the point where i select or create the shape of my User Form?

Noir