Create a Titlebar less form which can be dragged by Mouse

**Mechanic** · 12-07-2011, 10:08 AM

**Mechanic** · 12-07-2011, 10:19 AM

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

Mechanic

**Mechanic** · 12-07-2011, 04:05 PM

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

Mechanic