PC Review


Reply
Thread Tools Rate Thread

How do I display Unicode Text on UserForm.Caption

 
 
Zoo
Guest
Posts: n/a
 
      1st Oct 2007
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 With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
UserForm Text Box to display worksheet cell text Wmeyer2 Microsoft Excel Programming 1 25th Mar 2010 08:44 AM
Word 2003 display only a portion of caption text in table of figures MHughes2@gmail.com Microsoft Word Document Management 5 28th Aug 2007 02:38 PM
Access Form's Caption to display info from a text box =?Utf-8?B?TGVvbmFyZCBQZWFjb2Nr?= Microsoft Access Forms 3 29th Mar 2005 07:01 PM
Text display problem after restoring non-unicode language to Engli =?Utf-8?B?YmJnbXA=?= Windows XP Help 2 11th Nov 2004 01:00 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 08:41 PM.