Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I display Unicode Text on UserForm.Caption
Hi ,all.
I can display Uniocode Text on UserForm1.Label1.Caption , but cannot UserForm1.Caption ? e.g. s = ChrW(&H7535) & ChrW(&H8BDD) & ChrW(0) Me.Controls("Label1").Caption = s '<- This works correctly. Me.Caption = s '<= This doesn't work. Caption becomes two question marks. Does anybody know how to work around this? I tried to work around this with the followings by myself, but failed. '---------------------------------------------------- Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function BeginPaint Lib "user32.dll" _ (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long Private Declare Function TextOut Lib "gdi32.dll" Alias "TextOutW" _ (ByVal hDC As Long, ByVal nXStart As Long, ByVal nYStart As Long, _ ByVal lpString As Long, ByVal cbString As Long) As Long Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function EndPaint Lib "user32.dll" _ (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Const LF_FACESIZE = 32 Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName As String * LF_FACESIZE End Type Private Type PAINTSTRUCT hDC As Long fErase As Long rcPaint As RECT fRestore As Long fIncUpdate As Long rgbReserved As Byte End Type Private Sub UserForm_Activate() Dim hWnd As Long On Error Resume Next Dim sName As String sName = Me.Controls("Label1").Name If Err Then Me.Controls.Add "Forms.Label.1", "Label1", True End If On Error GoTo 0 Dim s As String s = ChrW(&H7535) & ChrW(&H8BDD) & ChrW(0) Me.Controls("Label1").Caption = s '<- This works correctly. Me.Caption = s '<= This doesn't work. Caption becomes two question marks. 'To display Unicode Text on Me.caption, I wrote the followings. 'But they does not work fine. hWnd = FindWindow(vbNullString, Me.Caption) Dim hDC As Long Dim ps As PAINTSTRUCT hDC = BeginPaint(hWnd, ps) Dim fnt As Long Dim lgFont As LOGFONT With lgFont .lfFaceName = "NSimSun" & Chr(0) .lfCharSet = 136 End With fnt = CreateFontIndirect(lgFont) Dim fntOrig As Long fntOrig = SelectObject(hDC, fnt) TextOut hDC, 0, 0, StrPtr(s), LenB(s) - 2 SelectObject hDC, fntOrig DeleteObject fnt EndPaint hDC, ps End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to display unicode character in Visual Basic script. | Excel Programming | |||
Qn: Display Text in TextBox in Userform | Excel Programming | |||
Display unicode characters in non-English windows | Excel Programming | |||
UserForm Caption | Excel Programming | |||
UserForm - display text message then run code | Excel Programming |