CodeItBetter Programming Another VB Programming Blog

'Forms - How to Make your own Custom Title Bar

Option Explicit
 
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Declare Function DrawCaption Lib "User32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As RECT, _
    ByVal un As Long) As Long
Declare Function SetRect Lib "User32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, _
    ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub ReleaseCapture Lib "User32" ()
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
 
'Set form BorderStyle property to 0-None.
'You can add your own Command Buttons to the Title Bar.
'Here you can change the title bar width.
Const TitleWidth = 20
Dim r As RECT
 
Private Sub Form_Load()
    Form1.AutoRedraw = True
    Me.Cls
    Me.ScaleMode = vbPixels
    SetRect r, 0, 0, Me.ScaleWidth, TitleWidth
    'To change the title bar color, replace the two '&H9' below with '&H18' or '&H19' or '&H28'
    DrawCaption Me.hwnd, Me.hdc, r, &H9
End Sub
 
Private Sub Form_Resize()
    SetRect r, 0, 0, Me.ScaleWidth, TitleWidth
    DrawCaption Me.hwnd, Me.hdc, r, &H9
End Sub
 
'The following code allow the user to move the form by pressing on the title bar.
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Y > TitleWidth Then Exit Sub
    Dim lngReturnValue As Long
    If Button = 1 Then
        Call ReleaseCapture
        lngReturnValue = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub