Michael Probst, Waty Thierry, and Peter Chamberlin.

This program subclasses to intercept messages that indicate the title bar must be redrawn. It gets the form's device context and draws on it.

The following code shows the new WindowProc that looks for painting messages. When it sees the WM_NCPAINT, WM_NCACTIVATE, WM_SETTEXT, or WM_SYSCOMMAND message, it calls the form's PaintActive or PaintInactive messages to draw the title bar.

Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg _
    As Long, ByVal wParam As Long, ByVal lParam As Long) As _
    Long
Const WM_NCPAINT = &H85
Const WM_ACTIVATE = &H6
Const WM_NCACTIVATE = &H86
Const WM_MDIACTIVATE = &H222
Const WM_SETTEXT = &HC
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&

    ' Assume we will return True.
    NewWindowProc = True

    ' Process messages.
    Select Case msg
        Case WM_NCPAINT
            DefWindowProc hwnd, msg, wParam, lParam
            Form1.PaintActive

        Case WM_NCACTIVATE
            If wParam Then
                ' The form is active.
                DefWindowProc hwnd, msg, wParam, lParam
                Form1.PaintActive
            Else
                ' The form is inactive.
                DefWindowProc hwnd, msg, wParam, lParam
                Form1.PaintInactive
            End If

        Case WM_SETTEXT
            DefWindowProc hwnd, msg, wParam, lParam
            Form1.PaintActive

        Case WM_SYSCOMMAND
            DefWindowProc hwnd, msg, wParam, lParam
            If wParam <> SC_CLOSE Then
                Form1.PaintActive
            End If

        Case Else
            ' Invoke the original WindowProc.
            NewWindowProc = CallWindowProc( _
                OldWindowProc, hwnd, msg, wParam, _
                lParam)
    End Select
End Function

' Paint the title bar for an active form.
Public Sub PaintActive()
Dim window_dc As Long
Dim border_width As Long
Dim border_height As Long
Dim title_button_width As Long
Dim wid As Long
Dim hgt As Long

    window_dc = GetWindowDC(hwnd)
    border_width = GetSystemMetrics(SM_CXFRAME)
    border_height = GetSystemMetrics(SM_CYFRAME)
    title_button_width = GetSystemMetrics(SM_CXSIZE)

    ' Get the width of the area to draw. This is our
    ' width in pixels, minus 2 times the border width,
    ' minus room for the three buttons on the right.
    wid = ScaleX(Width, vbTwips, vbPixels) - _
        2 * border_width - _
        3 * title_button_width

    ' Get the height of the area to draw. This is
    ' the height of a normal caption minus 1 pixel.
    hgt = GetSystemMetrics(SM_CYCAPTION) - 1

    ' Paint the title bar.
    BitBlt window_dc, border_width, border_height, _
        wid, hgt, picActive.hdc, 0, 0, SRCCOPY

    ' Release the window's DC.
    ReleaseDC hwnd, window_dc
End Sub

' Paint the title bar for an inactive form.
Public Sub PaintInactive()
Dim window_dc As Long
Dim border_width As Long
Dim border_height As Long
Dim title_button_width As Long
Dim wid As Long
Dim hgt As Long

    window_dc = GetWindowDC(hwnd)
    border_width = GetSystemMetrics(SM_CXFRAME)
    border_height = GetSystemMetrics(SM_CYFRAME)
    title_button_width = GetSystemMetrics(SM_CXSIZE)

    ' Get the width of the area to draw. This is our
    ' width in pixels, minus 2 times the border width,
    ' minus room for the three buttons on the right.
    wid = ScaleX(Width, vbTwips, vbPixels) - _
        2 * border_width - _
        3 * title_button_width

    ' Get the height of the area to draw. This is
    ' the height of a normal caption minus 1 pixel.
    hgt = GetSystemMetrics(SM_CYCAPTION) - 1

    ' Paint the title bar.
    BitBlt window_dc, border_width, border_height, _
        wid, hgt, picInactive.hdc, 0, 0, SRCCOPY

    ' Release the window's DC.
    ReleaseDC hwnd, window_dc
End Sub