' A simple TitleBar control for a form with no titlebar.
'
' Possible enhancements:
' 1. More exposed properties and events. More customizeable.
' 2. More buttons other than "exit". Perhaps an enumeration of standard
' titlebar buttons (minimize, maximize, system menu, help, etc.)
' 3. To add to #2, some nifty buttons like always-on-top and minimize-to-
' system-tray.
' 4. All the above buttons represented with icons or text. (+ tooltips).
' 5. An Align property like a picturebox.
' 6. But of course - gradients!
Option Explicit
Private Const HTCAPTION As Long = 2
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Declare Function ReleaseCapture Lib "user32" () 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 Const DEF_CAPTION As String = "Caption"
Private Const DEF_CAPTIONFORECOLOR As Long = vbWindowText
Private Const DEF_CAPTIONBACKCOLOR As Long = vbButtonFace
Private Const DEF_PADDING As Long = 6
Private m_lCaptionForeColor As OLE_COLOR
Private m_lCaptionBackColor As OLE_COLOR
Private m_sCaption As String
Private m_oFont As StdFont
Attribute m_oFont.VB_VarHelpID = -1
Private m_lPadding As Long
Private m_lWidth As Long
Private Sub UserControl_Show()
' Must I wait til here to get this info, or I get a "Client Site Not
' Available" error?
m_lWidth = UserControl.Parent.Width
End Sub
Private Sub UserControl_Terminate()
Set m_oFont = Nothing
End Sub
Private Sub UserControl_InitProperties()
' This sub is called only once, when the control is first placed on a form.
' Subsequently, the UserControl_Paint event is fired.
' Set the default UserControl properties.
m_sCaption = DEF_CAPTION
m_lCaptionForeColor = DEF_CAPTIONFORECOLOR
m_lCaptionBackColor = DEF_CAPTIONBACKCOLOR
m_lPadding = DEF_PADDING
' The default font is the parent's font.
Set m_oFont = Ambient.Font
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim r As Long
' Clicked in caption-area, move parent form.
If X < UserControl.Width - UserControl.TextWidth("X") Then
r = ReleaseCapture()
r = SendMessage(UserControl.Parent.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&)
