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

[vietnamvodich]

Hi, I've tried most method that I found on the internet but no lucky to set a Unicode title on Window Server. This is how the application look like on Window Server:



VB.NET Code so simply:

  Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Me.Text = ChrW(1088) & ChrW(1089) & ChrW(1090) & ChrW(1091)
    End Sub

VB6 Code - not working for Window Server 2008 or classic or non-themed mode:

Option Explicit
Private Declare Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowLongW Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long) As Long
Private Const GWL_WNDPROC = -4
Private m_Caption As String

Public Property Get CaptionW() As String
CaptionW = m_Caption
End Property

Public Property Let CaptionW(ByRef NewValue As String)
Static WndProc As Long, VBWndProc As Long
m_Caption = NewValue
' get window procedures if we don't have them
If WndProc = 0 Then
' the default Unicode window procedure
WndProc = GetProcAddress(GetModuleHandleW(StrPtr("user32")), "DefWindowProcW")
' window procedure of this form
VBWndProc = GetWindowLongA(hWnd, GWL_WNDPROC)
End If
' ensure we got them
If WndProc <> 0 Then
' replace form's window procedure with the default Unicode one
SetWindowLongW hWnd, GWL_WNDPROC, WndProc
' change form's caption
SetWindowTextW hWnd, StrPtr(m_Caption)
' restore the original window procedure
SetWindowLongA hWnd, GWL_WNDPROC, VBWndProc
Else
' no Unicode for us
Caption = m_Caption
End If
End Property

' usage sample
Private Sub Form_Load()
'??????? ????? ?? ????? ???? ? ??????
CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)
End Sub

Anyone know how to fix this issue? Thank you all a lot

[Schmidt]

The version below is less "noisy" and does it for me (with your Unicode-Input) -
(it's also less risky, by simply avoiding all that WindowProc-Pointer-Swapping):

Option Explicit
 
Private Declare Function DefWindowProcW& Lib "user32" (ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)

Public Property Get CaptionW() As String
  Const WM_GETTEXT = &HD
  CaptionW = Space$(2048)
  CaptionW = Left$(CaptionW, DefWindowProcW(hWnd, WM_GETTEXT, Len(CaptionW), StrPtr(CaptionW)))
End Property
Public Property Let CaptionW(ByVal RHS As String)
  Const WM_SETTEXT = &HC
  DefWindowProcW hWnd, WM_SETTEXT, Len(RHS), StrPtr(RHS)
End Property
 
Private Sub Form_Load()
  CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)
  Debug.Print CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)
End Sub

HTH

Olaf

[vietnamvodich]

The version below is less "noisy" and does it for me (with your Unicode-Input) -
(it's also less risky, by simply avoiding all that WindowProc-Pointer-Swapping):

Option Explicit
 
Private Declare Function DefWindowProcW& Lib "user32" (ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)

Public Property Get CaptionW() As String
  Const WM_GETTEXT = &HD
  CaptionW = Space$(2048)
  CaptionW = Left$(CaptionW, DefWindowProcW(hWnd, WM_GETTEXT, Len(CaptionW), StrPtr(CaptionW)))
End Property
Public Property Let CaptionW(ByVal RHS As String)
  Const WM_SETTEXT = &HC
  DefWindowProcW hWnd, WM_SETTEXT, Len(RHS), StrPtr(RHS)
End Property
 
Private Sub Form_Load()
  CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)
  Debug.Print CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)
End Sub

HTH

Olaf

Hi Schmidt, i've tried it too. Yes it does work on Windows 7/8/10 with theme enabled. But try to run your app on Window Server or switch to Classic Theme (on Windows 7). You will see this:

[Schmidt]

Yes it does work on Windows 7/8/10 with theme enabled. But try to run your app on Window Server or switch to Classic Theme (on Windows 7).

Could reproduce it on an older XP-VM (which did not have a Theme enabled).

But... since the second line in Form-Load (on my old,"classic GUI" XP-Machine):

Debug.Print CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)

...*did* Print out a True, the Form-hWnd in question obviously did receive (and now holds) the correct Unicode-WindowText.

That the Caption is nevertheless rendered with question-marks, has in *this* case nothing to do with ANSIText-Caption-Characters,
but with an inappropriate (different) Font-Selection, which VB6-ANSI-Forms make for their NC-Area-renderings, in case they start up "un-themed".
Edit: the above part (marked in red) was a wrong assumption - the culprit in this case is the ANSI-Default-Handler for WM_NCPAINT, which
in the unthemed-case does use a GetWindowTextA + TextOutA (respectively DrawTextA) on the hWnd in question, whilst in themed mode
does a fallback to GetWindowTextW + uxTheme.DrawText)

There is not much you can do in this case I guess, other than switching to a Form-Engine which works with Unicode throughout (already in the Startup-Phase).

The RC5-FormEngine is fully Unicode-aware and does (like a :NET-Form) show the Caption correctly, also on my old XP-VM:
(in case you want to try it - make sure, that your Project contains a reference to vbRichClient5 and only a *.bas-Module)

Sub Main()
  Dim Form As cWidgetForm
  Set Form = Cairo.WidgetForms.Create(vbSizable)
      Form.Caption = ChrW(1088) & ChrW(1089) & ChrW(1090) & ChrW(1091) '<- this UniCode-Caption works as it should, also on an unthemed XP
      Form.Show
      
  Cairo.WidgetForms.EnterMessageLoop
End Sub

Olaf

[westconn1]

i tested the code in post #2 on xp displayed the unicode

[vietnamvodich]

i tested the code in post #2 on xp displayed the unicode

Hi westconn1 , try this :



It's lucky that this issue does not occur on Windows Server 2012 by default.
But still many people using Windows Server 2008 and it's a bit hurt.

@Schmidt:
Thank you very much for this information. I just take a look at RC5 Form engine. It's seems too much complicated to switch my project to using RC5 form engine just for fix this issue

Anyone have any other ideas? Should I do a patch on VBVM , any idea would be appreciate ...

[LaVolpe]

Isn't that a restriction with DefWindowProcW?

Per Dr. Unicode in this thread

AFAIK DefWindowProcW solution will only work when Windows is Themed.
If you switch to Classic Theme or are using version of Windows that has no Themes then you have to subclass the TitleBar and draw it yourself.

[Krool]

I can remember that for classic theme to support unicode you need to subclass the form and catch WM_NCPAINT and pass it to DefWindowProcW.

[Schmidt]

Isn't that a restriction with DefWindowProcW?

DefWindowProcW is just "a more direct SendMessageW-replacement" (which bypasses the current WinProc-Handler) -
and as already reported, the Unicode-Caption is "landed" just fine per WM_SETTEXT in the hWnd in question
(since it can be successfully retrieved in Unicode-Format per WM_GETTEXT as well).

As Krool was mentioning, it is the WM_NCPaint-message which is finally responsible for the rendering
of that now successfully placed W-String-Caption.

In case of a "themed Desktop", the Default-NCPaint-Handler of an ANSI-Window has no other choice than to feed
the existing Caption-String as a W-String to the uxTheme.dll-routines (which support only WStrings - and have no A-API-exports).

If it is unthemed, then apparently normal "DrawTextA" (GetWindowTextA) will be applied by the default-handler of NCPaint (in an ANSI-Window).

So I guess SubClassing is indeed the only solution for VB6-ANSI-Windows in an un-themed setting
(not sure whether SetWindowTheme(..) would help on the ANSI-hWnd in question, to avoid the SubClassing).

Olaf

[LaVolpe]

DefWindowProcW is just "a more direct SendMessageW-replacement" (which bypasses the current WinProc-Handler) -
and as already reported, the Unicode-Caption is "landed" just fine per WM_SETTEXT in the hWnd in question
(since it can be successfully retrieved in Unicode-Format per WM_GETTEXT as well).

As Krool was mentioning, it is the WM_NCPaint-message which is finally responsible for the rendering
of that now successfully placed W-String-Caption.

Probably could have worded my response so people didn't have to review the thread I linked to, but the gist is rather simple: If themed, DefWindowProcW can be used else DefWindowProcA typically applies for VB forms. And DefWindowProcA doesn't do unicode.

[Schmidt]

Probably could have worded my response so people didn't have to review the thread I linked to, but the gist is rather simple: If themed, DefWindowProcW can be used else DefWindowProcA typically applies for VB forms. And DefWindowProcA doesn't do unicode.

What my reply was meant to say is, that DefWindowProcA (in case of WM_NCPAINT) apparently *does* handle Unicode
for that specific message (when themed), as long as the Window-Caption was placed on the hWnd as a W-String beforehand
(no matter if that "W-Caption-placement" happened per DefWindowProcW or SendMessageW or SetWindowTextW).

The problem has "two stages" (two hurdles to take) - solving the first one successfully is not sufficient for the "second stage" (in an un-themed OS-setting).

Olaf

[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

[LaVolpe]

@Elroy. Your code is nearly identical to Olaf's posted back in #2 above, which did not work in a specific case.

Regarding themes, this topic has nothing to do with manifesting for theming controls, but rather the Windows option to use window themes, i.e., aero, lumina, etc vs unthemed (classic). Note. Not sure you can opt for classic themes after Win7.

[Elroy]

@LaVolpe: Hmmm, ok. And yeah, I saw that Olaf had posted similar code. I also noticed that mine had a call to InvalidateRect in it. I truly don't remember why that's there, but I'm certain it's needed in certain circumstances or I wouldn't have placed it there. I'm wondering if that'll make a difference for the "classic theme" that you're struggling with, as I've certainly been using this code on machines using OS's before Win7 (i.e., Vista and even XP). It would be difficult for me to test at this point (as I've got no readily accessible computers with OS's earlier than Win7).

@vietnamvodich: Good Luck.

Elroy

[dilettante]

As far as I can tell InvalidateRect() does nothing outside of the window's client area anyway.

[Elroy]

Hmmm, yeah, I just read the MSDN article on it. I just have a vague memory of struggling to get what I wanted from those procedures (as it's been a few years back). It may have had to do with controls (such as option buttons or others) where the caption is part of the client area. If that's the case, then that certainly won't help with the "classic themes" problem.

[dilettante]

That the Caption is nevertheless rendered with question-marks, has in *this* case nothing to do with ANSIText-Caption-Characters, but with an inappropriate (different) Font-Selection, which VB6-ANSI-Forms make for their NC-Area-renderings, in case they start up "un-themed".

I doubt this is a factor since the caption font is a system-level setting. See NONCLIENTMETRICS.

[Schmidt]

I doubt this is a factor since the caption font is a system-level setting. See NONCLIENTMETRICS.

Yep - ANSI-Forms do not select different Fonts at creation- (or upstart-) time
(should have edited my comment after Krool hinted at the Default-ANSI-WM_NCPAINT - Handler,
which does a GetWindowTextW on the hWnd in question *only* in case it wants to render using Exports from uxTheme.dll).

Olaf

[vietnamvodich]

Hi there!
Thank you all for reply on my thread.
I've spent a day to struggling for this issue. I can now create a vb6 form with unicode title by register my own Unicode class with RegisterClassW and hook/patch the MSVBVM60.dll to use the class I registered. But all event on the form seems not firing ( I clicked on the button and nothing happen).

Here is how I do it. First create my own class using RegisterClassW (i just copied an example from the internet) :

Option Explicit
               
Declare Function LoadIconW Lib "user32.dll" _
        (ByVal a As Long, ByVal b As Long) As Long
Declare Function LoadCursorW Lib "user32.dll" _
        (ByVal a As Long, ByVal b As Long) As Long
Declare Function GetStockObject Lib "gdi32.dll" _
        (ByVal a As Long) As Long
Declare Function RegisterClassW Lib "user32.dll" (ByVal a As Long) As Long
Declare Function CreateWindowExW Lib "user32.dll" _
        (ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, _
        ByVal e As Long, ByVal f As Long, ByVal g As Long, ByVal h As Long, _
        ByVal i As Long, ByVal j As Long, ByVal k As Long, ByVal l As Long) _
        As Long
Declare Function ShowWindow Lib "user32.dll" _
        (ByVal a As Long, ByVal b As Long) As Long
Declare Function UpdateWindow Lib "user32.dll" (ByVal a As Long) As Long
Declare Function GetMessageW Lib "user32.dll" _
        (ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long) _
        As Long
Declare Function TranslateMessage Lib "user32.dll" (ByVal a As Long) As Long
Declare Function DispatchMessageW Lib "user32.dll" (ByVal a As Long) As Long
Declare Function PostQuitMessage Lib "user32.dll" (ByVal a As Long) As Long
Declare Function DefWindowProcW Lib "user32.dll" _
        (ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long) _
        As Long
Declare Function MoveWindow Lib "user32.dll" _
        (ByVal a As Long, ByVal b As Long, ByVal c As Long, _
        ByVal d As Long, ByVal e As Long, ByVal f As Long) As Long
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
        (ByVal dst As Long, ByVal src As Long, ByVal length As Long)
               
Type WNDCLASSW
    style As Long
    lpfnWndProc As Long
    cbClsExtra As Long
    cbWndExtra As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As Long
    lpszClassName As Long
End Type
               
Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt_x As Long
    pt_y As Long
End Type
               
Type POINTS
    x As Integer
    y As Integer
End Type
               
Public strClassName As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Program starts here
               
Function GetAddr(ByVal a As Long) As Long
    GetAddr = a
End Function
               
Function MakePOINTS(ByVal l As Long) As POINTS
    CopyMemory VarPtr(MakePOINTS), VarPtr(l), 4
End Function
               
Public Function WndProc(ByVal hwnd As Long, ByVal message As Long, _
                        ByVal wParam As Long, ByVal lParam As Long) As Long
    Static hEdit As Long
    Select Case message
    Case 5 ' WM_SIZE
        Dim ps As POINTS
        ps = MakePOINTS(lParam)
        MoveWindow hEdit, 10, 10, ps.x - 20, ps.y - 20, 1
        WndProc = 0
    Case 2 ' WM_DESTROY
        PostQuitMessage 0
        WndProc = 0
    Case Else
        WndProc = DefWindowProcW(hwnd, message, wParam, lParam)
    End Select
End Function
               
Sub Main()
strClassName = "MyVbClass"
Dim retn As Long
    Dim wc As WNDCLASSW
    wc.style = 3 ' CS_HREDRAW | CS_VREDRAW
    wc.lpfnWndProc = GetAddr(AddressOf WndProc)
    wc.hIcon = LoadIconW(0, 32512)  'IDI_APPLICATION
    wc.hCursor = LoadCursorW(0, 32512) ' IDC_ARROW
    wc.hbrBackground = GetStockObject(0) ' WHITE_BRUSH
    wc.lpszClassName = StrPtr(strClassName)
  retn = RegisterClassW(VarPtr(wc))
MsgBox Hex(StrPtr(strClassName))  '  WE GOT THE UNICODE STRING POINER HERE FOR THE NEXT STEP
Form1.Show
End Sub

Now compile the App and debug with OllyDBG. Press F9 to Run. You will see a messagebox like this

---------------------------
Project1
---------------------------
588B74
---------------------------
OK
---------------------------

Press Ctrl+G to goto address 6605A65B ( 66000000 is the base address of MSVBVM60.dll on my computer so you need to change it depend on your computer) . Put a break point at 6605A65B .

6605A640   50               PUSH EAX
6605A641   FF75 FC          PUSH DWORD PTR SS:[EBP-4]
6605A644   FF75 E8          PUSH DWORD PTR SS:[EBP-18]
6605A647   FF75 EC          PUSH DWORD PTR SS:[EBP-14]
6605A64A   FF75 F8          PUSH DWORD PTR SS:[EBP-8]
6605A64D   53               PUSH EBX
6605A64E   FF75 08          PUSH DWORD PTR SS:[EBP+8]
6605A651   FFB6 84000000    PUSH DWORD PTR DS:[ESI+84]
6605A657   57               PUSH EDI
6605A658   FF75 F4          PUSH DWORD PTR SS:[EBP-C]
6605A65B   FF15 F0140066    CALL DWORD PTR DS:[<&USER32.CreateWindowExA>]                                        ; call 763C2D10
-> patch here to convert to CreateWindowExW

Press Ok and the app pause at the breakpoint.
Edit the code at 6605A65B to make it become : Call CreateWindowExW
Edit the stack variables:
Edit 0019F968 and 0019F96C to 00588B74 ( 00588B74 is the pointer we got from the message box - it's point to "MyVbClass" ). So here is the final parameters it passed to CreateWindowExW:

0019F964   00040000  |ExtStyle = WS_EX_APPWINDOW
0019F968   00588B74  |Class = "MyVbClass"
0019F96C   00588B74  |WindowName = "MyVbClass"
0019F970   02CF0000  |Style = WS_OVERLAPPED|WS_MINIMIZEBOX|WS_MAXIMIZEBOX|WS_CLIPCHILDREN|WS_SYSMENU|WS_THICKFRAME|WS_CAPTION
0019F974   80000000  |X = 80000000 (-2147483648.)
0019F978   80000000  |Y = 80000000 (-2147483648.)
0019F97C   00000148  |Width = 148 (328.)
0019F980   000000F8  |Height = F8 (248.)
0019F984   00B52346  |hParent = 00B52346 ('Project1',class='ThunderRT6Main')
0019F988   00000000  |hMenu = NULL
0019F98C   00000000  |hInst = NULL
0019F990   00000000  \lParam = NULL

Now press F9 again and you will see the form, it's now able to create a Unicode title because it's created by RegisterClassW and CreateWindowExW . But I don't know why the button not working

[Krool]

Overkill..

Just subclass the form. Catch WM_NCPAINT and pass to DefWindowProcW. Solved.

Of course you need the other tips of placing a W-String via WM_SETTEXT.

[vietnamvodich]

Overkill..

Just subclass the form. Catch WM_NCPAINT and pass to DefWindowProcW. Solved.

Of course you need the other tips of placing a W-String via WM_SETTEXT.

Hi Krool, i can't make it work. Could you please tell me what I'm wrong? Here is my subclass :

Private Sub WndProc(ByVal bBefore As Boolean, _
       ByRef bHandled As Boolean, _
       ByRef lReturn As Long, _
       ByVal hwnd As Long, _
       ByVal uMsg As Long, _
       ByVal wParam As Long, _
       ByVal lParam As Long, _
       ByRef lParamUser As Long)

If uMsg = WM_NCPAINT Then
 bHandled = True
 lReturn = DefWindowProcW(hwnd, uMsg, wParam, lParam)
 Exit Sub
    End If

End Sub

Private Sub Form_Load()
 Dim s As String
    s = ChrW$(1255)
    UniCaption(Me.hwnd) = s

    Set cSubClass = New ClsSubclass

    If cSubClass.ssc_Subclass(Form1.hwnd, , , Me) Then
       cSubClass.ssc_AddMsg Form1.hwnd, WM_NCPAINT, MSG_BEFORE
    End If    
End Sub

[vietnamvodich]

@Elroy: Thank you very much but your code not working too on classical theme.

[Krool]

Here is a solution without even subclassing. It turns the window from ANSI to Unicode via SetWindowLongW and GWL_WNDPROC.

'**************************************
' Name: UniCaption - unicode caption for your forms
' Description:By a request here, I was fooling around with different ways of changing a form's caption to Unicode. I've seen commercial controls that take over the drawing routine with some heavy subclassing and other similar poor attempts, which have then broken, if not when theme changes, then by when Vista got released.
I started off by figuring out a way to create a custom Unicode window and then make an existing form a child of it, but this got pretty messy and I wasn't very happy with the complexity. However, I had a bug during this process that I by mistake used a non-Unicode version of DefWindowProc, which prevented the caption to be Unicode. And it didn't take me long to figure out that by temporarily changing a window's window procedure any window caption can be made Unicode.
So here it is: a very short and clean way to have an Unicode caption in your forms! The code can be pasted directly to your form.
' By: Vesa Piittinen (from psc cd)
'**************************************

Option Explicit
Private Declare Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowLongW Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long) As Long
Private Const GWL_WNDPROC = -4
Private m_Caption As String
Public Property Get CaptionW() As String
CaptionW = m_Caption
End Property
Public Property Let CaptionW(ByRef NewValue As String)
Static WndProc As Long, VBWndProc As Long
m_Caption = NewValue
' get window procedures if we don't have them
If WndProc = 0 Then
' the default Unicode window procedure
WndProc = GetProcAddress(GetModuleHandleW(StrPtr("user32")), "DefWindowProcW")
' window procedure of this form
VBWndProc = GetWindowLongA(hWnd, GWL_WNDPROC)
End If
' ensure we got them
If WndProc <> 0 Then
' replace form's window procedure with the default Unicode one
SetWindowLongW hWnd, GWL_WNDPROC, WndProc
' change form's caption
SetWindowTextW hWnd, StrPtr(m_Caption)
' restore the original window procedure
SetWindowLongA hWnd, GWL_WNDPROC, VBWndProc
Else
' no Unicode for us
Caption = m_Caption
End If
End Property
' usage sample
Private Sub Form_Load()
' some hiragana (you need Japanese fonts installed to see them)
CaptionW = ChrW$(&H3042) & ChrW$(&H3044) & ChrW$(&H3046) & ChrW$(&H3048) & ChrW$(&H304A) & " ovat japanilaisia hiragana-merkkej�."
End Sub

[vietnamvodich]

Here is a solution without even subclassing. It turns the window from ANSI to Unicode via SetWindowLongW and GWL_WNDPROC.

'**************************************
' Name: UniCaption - unicode caption for your forms
' Description:By a request here, I was fooling around with different ways of changing a form's caption to Unicode. I've seen commercial controls that take over the drawing routine with some heavy subclassing and other similar poor attempts, which have then broken, if not when theme changes, then by when Vista got released.
I started off by figuring out a way to create a custom Unicode window and then make an existing form a child of it, but this got pretty messy and I wasn't very happy with the complexity. However, I had a bug during this process that I by mistake used a non-Unicode version of DefWindowProc, which prevented the caption to be Unicode. And it didn't take me long to figure out that by temporarily changing a window's window procedure any window caption can be made Unicode.
So here it is: a very short and clean way to have an Unicode caption in your forms! The code can be pasted directly to your form.
' By: Vesa Piittinen (from psc cd)
'**************************************

Option Explicit
Private Declare Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowLongW Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long) As Long
Private Const GWL_WNDPROC = -4
Private m_Caption As String
Public Property Get CaptionW() As String
CaptionW = m_Caption
End Property
Public Property Let CaptionW(ByRef NewValue As String)
Static WndProc As Long, VBWndProc As Long
m_Caption = NewValue
' get window procedures if we don't have them
If WndProc = 0 Then
' the default Unicode window procedure
WndProc = GetProcAddress(GetModuleHandleW(StrPtr("user32")), "DefWindowProcW")
' window procedure of this form
VBWndProc = GetWindowLongA(hWnd, GWL_WNDPROC)
End If
' ensure we got them
If WndProc <> 0 Then
' replace form's window procedure with the default Unicode one
SetWindowLongW hWnd, GWL_WNDPROC, WndProc
' change form's caption
SetWindowTextW hWnd, StrPtr(m_Caption)
' restore the original window procedure
SetWindowLongA hWnd, GWL_WNDPROC, VBWndProc
Else
' no Unicode for us
Caption = m_Caption
End If
End Property
' usage sample
Private Sub Form_Load()
' some hiragana (you need Japanese fonts installed to see them)
CaptionW = ChrW$(&H3042) & ChrW$(&H3044) & ChrW$(&H3046) & ChrW$(&H3048) & ChrW$(&H304A) & " ovat japanilaisia hiragana-merkkej�."
End Sub

Hi, I just tried on Windows Server 2008 R2 and not working too :

[vietnamvodich]

I think that the problem is in classical theme, Windows will look at the property of the windows to see if it was created by CreateWindowExA or CreateWindowExW (also must go with RegisterClassA/RegisterClassW) . If it's the Unicode ( W ) version it will look for the BSTR , else look for the ANSI string. By default, VB6 create the Window using CreateWindowExA and RegisterClassA so it's the problem.

[Schmidt]

Here is a solution without even subclassing. It turns the window from ANSI to Unicode via SetWindowLongW and GWL_WNDPROC.

That's what the OP started with (and which I've tried to condense somewhat in #2) -
It still only solves part1 (the placement of a W-caption). The NCPaint problem remains (when unthemed).

Olaf

[Krool]

Normally the WM_NCPAINT subclass should do the Job.

Did you also try both, SetWindowLongW turning (code I just previously posted) and the WM_NCPAINT subclass?

[Krool]

Also how does your subclasser work? Any ANSI API's involved there what could break something?

[Schmidt]

Normally the WM_NCPAINT subclass should do the Job.

Did you also try both, SetWindowLongW turning (code I just previously posted) and the WM_NCPAINT subclass?

As said, the "SetWindowLongW turning-code" was, what the OP originally started with -
and it does that "turning" only for a very short moment (followed by a restore of the original ANSI-HandlerProc) -
so the better alternative to that is, to call DefWindowProcW directly (completely avoiding that swapping).

An NCPaint-SubClassing-approach (which delegates the Handling of WM_NCPAINT to DefWindowProcW) will have to take into account,
that the NCPaint-rendering-section inside DefWindowProcW internally has to perform a lookup for the current Caption-String of that Window -
which will result in an internally called SendMessageW (with WM_GETTEXT) to the hWnd in question.

And to rule out, that this WM_GETTEXT-request is answered by the ANSI-default-HandlerProc, that message has to be included in the Subclassing as well:
Below is a solution that shows the Minimum-Efforts needed for Unicode-Caption with SubClassing (please exchange the RC5-SubClasser to the one of your choice):

Option Explicit
 
Private Const WM_SETTEXT& = &HC, WM_GETTEXT = &HD, WM_NCPAINT = &H85
Private Declare Function DefWindowProcW& Lib "user32" (ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)

Private WithEvents SC As vbRichClient5.cSubClass
 
Private Sub Form_Load()
  Set SC = New_c.SubClass: SC.Hook hWnd
  CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)
End Sub

Public Property Get CaptionW() As String
  CaptionW = Space$(2048)
  CaptionW = Left$(CaptionW, DefWindowProcW(hWnd, WM_GETTEXT, Len(CaptionW), StrPtr(CaptionW)))
End Property
Public Property Let CaptionW(ByVal RHS As String)
  DefWindowProcW hWnd, WM_SETTEXT, Len(RHS), StrPtr(RHS)
End Property

Private Sub SC_WindowProc(Result As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
  Select Case Msg
    Case WM_NCPAINT, WM_GETTEXT '<- include WM_GETTEXT as being handled by the W-version as well
      Result = DefWindowProcW(hWnd, Msg, wParam, lParam)
    Case Else
      Result = SC.CallWindowProc(Msg, wParam, lParam)
  End Select
End Sub

Olaf

[vietnamvodich]

As said, the "SetWindowLongW turning-code" was, what the OP originally started with -
and it does that "turning" only for a very short moment (followed by a restore of the original ANSI-HandlerProc) -
so the better alternative to that is, to call DefWindowProcW directly (completely avoiding that swapping).

An NCPaint-SubClassing-approach (which delegates the Handling of WM_NCPAINT to DefWindowProcW) will have to take into account,
that the NCPaint-rendering-section inside DefWindowProcW internally has to perform a lookup for the current Caption-String of that Window -
which will result in an internally called SendMessageW (with WM_GETTEXT) to the hWnd in question.

And to rule out, that this WM_GETTEXT-request is answered by the ANSI-default-HandlerProc, that message has to be included in the Subclassing as well:
Below is a solution that shows the Minimum-Efforts needed for Unicode-Caption with SubClassing (please exchange the RC5-SubClasser to the one of your choice):

Option Explicit
 
Private Const WM_SETTEXT& = &HC, WM_GETTEXT = &HD, WM_NCPAINT = &H85
Private Declare Function DefWindowProcW& Lib "user32" (ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)

Private WithEvents SC As vbRichClient5.cSubClass
 
Private Sub Form_Load()
  Set SC = New_c.SubClass: SC.Hook hWnd
  CaptionW = ChrW$(1088) & ChrW$(1089) & ChrW$(1090) & ChrW$(1091)
End Sub

Public Property Get CaptionW() As String
  CaptionW = Space$(2048)
  CaptionW = Left$(CaptionW, DefWindowProcW(hWnd, WM_GETTEXT, Len(CaptionW), StrPtr(CaptionW)))
End Property
Public Property Let CaptionW(ByVal RHS As String)
  DefWindowProcW hWnd, WM_SETTEXT, Len(RHS), StrPtr(RHS)
End Property

Private Sub SC_WindowProc(Result As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
  Select Case Msg
    Case WM_NCPAINT, WM_GETTEXT '<- include WM_GETTEXT as being handled by the W-version as well
      Result = DefWindowProcW(hWnd, Msg, wParam, lParam)
    Case Else
      Result = SC.CallWindowProc(Msg, wParam, lParam)
  End Select
End Sub

Olaf

AMAZING! THIS CODE ABSOLUTELY WORKING ! THANK YOU VERY VERY VERY MUCH SCHMIDT!!

I also tested and It's can also work without WM_NCPAINT

 Case WM_GETTEXT '<- no need WM_NCPAINT here
      Result = DefWindowProcW(hWnd, Msg, wParam, lParam)

Thank everyone for your support , really amazing forum, I wish everybody here all super long life and living forever !! Happy new year in advance.

[DEXWERX]

so full the solution was not only calling DefWindowProcW to set the text, but also subclassing WM_GETTEXT.

Thanks Krool, Schmidt. This should be added to the Unicode FAQ.


@Schmidt. If you're calling a custom constructor / class factory, you could include parameters.

Set SC = New_c.SubClass(hWnd)

[Elroy]

I definitely believe that it works (although I can't test on these older OSs), but it's puzzling to me as to why.

We certainly know that nothing has changed about VB6 through the years (other than the service packs). So, why does circumventing the internal VB6 subclassing for a WM_GETTEXT fix the problem on some OSs and isn't needed on others? This would suggest that VB6 code is behaving differently (i.e., converting to ANSI) on Windows XP & Vista, whereas it's not on Win7 and beyond.

Happy New Year,
Elroy

[DEXWERX]

Runtimes are updated and patched for each OS, starting with Vista. That means msvcrt40 and msvbvm60 are hopefully not the original runtimes, but ones that came with the O/S.

edit: this is why we keep recommending on here not to redist the runtime. Later Windows versions do seem smart enough to block installers from replacing the updated runtimes with older versions.

[Elroy]

Hi Dex,

Yeah, I was thinking (wondering about) that too. It would seem that that's almost got to be the answer.

Best Regards,
Elroy

[LaVolpe]

Or just maybe, this is a pleasant result of Windows redirecting some API functions, much like it does for other APIs, like DPI-related ones?

[Krool]

I also tested and It's can also work without WM_NCPAINT

 Case WM_GETTEXT '<- no need WM_NCPAINT here
      Result = DefWindowProcW(hWnd, Msg, wParam, lParam)

I would keep WM_NCPAINT to be on secure side. Even it is unecessary it does not harm.

@ Schmidt,
I just found the snippet in quick and didn't realize that the SetWindowLongW "turning" is just temporary to set the W-String in place. Of course the DefWindowProcW set text is the way to go, I just miss-interpreted the snippet just found.

So yes, in order to support full unicode, even on classic theme, a "small" subclass is needed.

[dilettante]

Looks good.

Here is a version that has no extra dependency, though that means the subclassing can be IDE-fragile of course (be wary when debugging):







Nothing original here. It just repackages the ideas posted above.

[Schmidt]

I would keep WM_NCPAINT to be on secure side. Even it is unecessary it does not harm.

Yep, I was going to suggest keeping that in the DefWindowProcW-branch as well
(why leave it to chance, what the next "CallWindowProc" in the chain might do or not do).

@Dex

  Set SC = New_c.SubClass(hWnd)

Yep, duly noted - there is also several other (still "naked") cConstructor-HandOuts, which could profit from an extension in that regard
(as e.g. New_c.Stream(SomeInitialByteArray) or New_c.SVG(SomeUTF8SvgBytes) + a few others...).

Will wait with these for RC6 - not wanting to risk breaking BinComp or ClassIDs on RC5 at this point.

Olaf

[vietnamvodich]

Looks good.

Here is a version that has no extra dependency, though that means the subclassing can be IDE-fragile of course (be wary when debugging):







Nothing original here. It just repackages the ideas posted above.

Hi dilettante ! Thank you a lot for your contribution. This subclass work great but I realized that it crash when use the End command to exit the program. Is there any better version?

[dilettante]

Programs should never have an End statement.

In any case the only easy IDE-safe way to handle subclassing is to use a separately compiled DLL that can unsubclass when the class it houses terminates. You could rewrite the subclassing logic as a class in your own DLL or use one provided by somebody else.