-
Create a Titlebar less form which can be dragged by Mouse
-
By the way I was able to hide the Titlebar via API...
Code:
Option Explicit
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 DrawMenuBar Lib "user32" (ByVal hwnd 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
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const GWL_STYLE As Long = (-16)
Private wHandle As Long
Private Sub UserForm_Initialize()
'HideTitleBar Me
Dim frm As Long, frmstyle As Long
If Val(Application.Version) >= 9 Then
wHandle = FindWindow("ThunderDFrame", Me.Caption)
Else
wHandle = FindWindow("ThunderXFrame", Me.Caption)
End If
If wHandle = 0 Then Exit Sub
frm = GetWindowLong(wHandle, GWL_STYLE)
frm = frm Or &HC00000
SetWindowLong wHandle, -16, frmstyle
DrawMenuBar wHandle
End Sub
:notagain:
Mechanic
-
Well Well Well... I've got the solution for this (Yes thanks to Kris)
So In order to have a Form with hidden titlebar and have a fake one on top instead (in order to have a more glossy titlebar :o). This is what you need to do.
1. Add a new Module and rename it to FormLoad. then add the following code to the module.
Code:
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
Declare Sub ReleaseCapture Lib "user32" ()
Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function SetLayeredWindowAttributes _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) _
As Long
Public Declare Function GetWindowRect Lib "user32" ( _
ByVal hwnd As Long, _
lpRect As RECT) As Long
Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_STYLE = (-16)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_CAPTION = &HC00000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H10000
Public Const WS_SYSMENU = &H80000
Public Const WS_POPUP As Long = &H80000000
Public Const WS_EX_APPWINDOW = &H40000
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Const ULW_COLORKEY = &H1
Public Const ULW_ALPHA = &H2
Public Const ULW_OPAQUE = &H4
Public Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Declare Function FindWindowA _
Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_NOCOPYBITS = &H100
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOOWNERZORDER = &H200
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const HWND_NOTOPMOST = -2
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public lResult As Long
Public frmHdl As Long
Public blnTitleVisible As Boolean
Public blnCtrlShow As Boolean
Public lFrmHdl As Long
Public Function ShowTitleBar(ByVal bState As Boolean)
Dim lStyle As Long
Dim tR As RECT
GetWindowRect lFrmHdl, tR
lStyle = GetWindowLong(lFrmHdl, GWL_STYLE)
'
If Not bState Then
lStyle = lStyle And Not WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle And Not WS_CAPTION
blnTitleVisible = True
Else
lStyle = lStyle Or WS_SYSMENU
lStyle = lStyle Or WS_MAXIMIZEBOX
lStyle = lStyle Or WS_MINIMIZEBOX
lStyle = lStyle Or WS_CAPTION
blnTitleVisible = False
End If
SetWindowLong lFrmHdl, GWL_STYLE, lStyle
SetWindowPos lFrmHdl, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
End Function
Public Sub FadeIn(Fin As Long)
Dim X As Long
X = 0
Do Until X = Fin
DoEvents
X = X + 1
MakeTransparent X / 2
Loop
End Sub
Public Function FadeOut(Fin As Long)
Dim Y As Long
Y = Fin '1000
Do Until Y = 0
DoEvents
Y = Y - 1
Call MakeTransparent(Y / 2)
Loop
End Function
Public Function MakeTransparent(lIndex As Long) As Long
On Error Resume Next
If lIndex < 0 Or lIndex > 255 Then
MakeTransparent = 0 '1
Else
lResult = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
lResult = lResult Or WS_EX_LAYERED
SetWindowLong lFrmHdl, GWL_EXSTYLE, lResult
SetLayeredWindowAttributes lFrmHdl, 0, lIndex, LWA_ALPHA
MakeTransparent = 0
End If
If Err Then MakeTransparent = 2
End Function
2. Then insert a new Form then add a fake Title bar using a image control with name 'imgTopBar' then goto Form's code window and add the following code to it.
Code:
Public Sub UserForm_Initialize()
lFrmHdl = FindWindowA(vbNullString, Me.Caption)
ShowTitleBar False
End Sub
imgTopBar is your fake bar on the From (This also goes to the Form's code):
Code:
Private Sub imgTopBar_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
lFrmHdl = FindWindowA(vbNullString, Me.Caption)
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
ReleaseCapture
SendMessage lFrmHdl, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
And thats it... :o
Your all welcome in advance.. :o
:cowboy:Mechanic
-
Mechanic
You may find this of use - it allows you to resize your userform
Anchor controls and resizing userfrom
Have Fun
Rasm
