Unicode caption for form: not working with classic or non-themed mode

[Elroy]

These are the procedures I've used for quite some time, and they work on both forms and controls. Also, I don't have anything about themes in the manifest of my primary application.

Also, make them public and throw them into a BAS module if you'd like to use them everywhere.

Option Explicit
'
Private Declare Function DefWindowProcW Lib "user32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function SysAllocStringLen Lib "oleaut32.dll" (ByVal OleStr As Long, ByVal bLen As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByRef Ptr As Any, ByRef Value As Any)
'
Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long ' This is +1 (right - left = width)
    Bottom As Long ' This is +1 (bottom - top = height)
End Type

Private Sub Form_Load()


    Dim s As String
    s = ChrW$(1255)
    SetUniCaption Me.hWnd, s



End Sub


Private Sub SetUniCaption(TheHwnd As Long, sUniCaption As String)
    ' Set Unicode string into the caption.
    '
    Dim uRect As RECT
    Const WM_SETTEXT As Long = &HC
    DefWindowProcW TheHwnd, WM_SETTEXT, 0&, ByVal StrPtr(sUniCaption)
    GetClientRect TheHwnd, uRect
    InvalidateRect TheHwnd, uRect, 1&
End Sub

Private Function GetUniCaption(TheHwnd As Long) As String
    ' Get Unicode string from caption.
    '
    Const WM_GETTEXT As Long = &HD
    Const WM_GETTEXTLENGTH As Long = &HE
    Dim lLen As Long
    Dim lPtr As Long
    lLen = DefWindowProcW(TheHwnd, WM_GETTEXTLENGTH, 0&, ByVal 0&)  ' Get length of caption.
    If lLen Then ' Must have length.
        lPtr = SysAllocStringLen(0&, lLen)                          ' Create a BSTR of that length.
        PutMem4 ByVal VarPtr(GetUniCaption), ByVal lPtr             ' Make the property return the BSTR.
        DefWindowProcW TheHwnd, WM_GETTEXT, lLen + 1&, ByVal lPtr   ' Call the default Unicode window procedure to fill the BSTR.
    End If
End Function

Enjoy,
Elroy


EDIT1: And since I'm looking at these things, I decided to rework them into properties. I think it's a bit cleaner that way:

Option Explicit
'
Private Declare Function DefWindowProcW Lib "user32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function SysAllocStringLen Lib "oleaut32.dll" (ByVal OleStr As Long, ByVal bLen As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByRef Ptr As Any, ByRef Value As Any)
'
Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long ' This is +1 (right - left = width)
    Bottom As Long ' This is +1 (bottom - top = height)
End Type

Private Sub Form_Load()


    Dim s As String
    s = ChrW$(1255)
    UniCaption(Me.hWnd) = s



End Sub


Private Property Let UniCaption(TheHwnd As Long, sUniCaption As String)
    ' Set Unicode string into the caption.
    '
    Dim uRect As RECT
    Const WM_SETTEXT As Long = &HC
    DefWindowProcW TheHwnd, WM_SETTEXT, 0&, ByVal StrPtr(sUniCaption)
    GetClientRect TheHwnd, uRect
    InvalidateRect TheHwnd, uRect, 1&
End Property

Private Property Get UniCaption(TheHwnd As Long) As String
    ' Get Unicode string from caption.
    '
    Const WM_GETTEXT As Long = &HD
    Const WM_GETTEXTLENGTH As Long = &HE
    Dim lLen As Long
    Dim lPtr As Long
    lLen = DefWindowProcW(TheHwnd, WM_GETTEXTLENGTH, 0&, ByVal 0&)  ' Get length of caption.
    If lLen Then ' Must have length.
        lPtr = SysAllocStringLen(0&, lLen)                          ' Create a BSTR of that length.
        PutMem4 ByVal VarPtr(UniCaption), ByVal lPtr                ' Make the property return the BSTR.
        DefWindowProcW TheHwnd, WM_GETTEXT, lLen + 1&, ByVal lPtr   ' Call the default Unicode window procedure to fill the BSTR.
    End If
End Property