Hiện chữ trên thanh tiêu đề của Form?
- Thread starter NH_DK
- Ngày gửi
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Vào Module thủ tục sau:
Mã:
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub SetUnicodeCaption(ByVal frm As UserForm, ByVal UnicodeString As String)
Dim hWnd&
hWnd = FindWindow("ThunderDFrame", frm.Caption)
DefWindowProc hWnd, 12, 0, StrPtr(UnicodeString)
End SubChép tiếp code trong Form như sau:
PHP:
Private Sub UserForm_Initialize()
SetUnicodeCaption Me, Label1.Caption
End SubNên thoát Form bằng thủ tục Unload Me thay cho End, bởi nếu bạn chắc chắn không chạy bất cứ code gì thì sử dụng End.
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Hiển thị tiếng Việt Unicode trên thanh tiêu đề UserForm chẳng dễ ăn đâu nha
Đầu tiên bạn đặt chuổi tiếng Việt Unicode vào trong 1 Define name rồi dùng code dưới đây
1> Trong module
PHP:
Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function SetBkMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Declare Function TextOut Lib "gdi32.dll" Alias "TextOutW" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpString As Any, ByVal nCount As Long) As Long
Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
PHP:
Public hFont As Long, Old_hFont As Long, ProcOld As Long, hWnd As Long
Public 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(32) As Byte
End Type
Public Type Unicode
H As Byte
L As Byte
End Type
PHP:
Private Sub SetUnicodeTitlebar(Text As String)
Dim NC_hDC As Long, Result As Long, Lf As LOGFONT, NewCaption() As Unicode
Dim FontFace As String, NewFontFace() As Byte, Seed As Integer
NC_hDC = GetWindowDC(hWnd)
Lf.lfWeight = 700
FontFace = "Tahoma"
NewFontFace = StrConv(FontFace, vbFromUnicode)
For Seed = 1 To Len(FontFace)
Lf.lfFaceName(Seed - 1) = NewFontFace(Seed - 1)
Next Seed
hFont = CreateFontIndirect(Lf)
Old_hFont = SelectObject(NC_hDC, hFont)
Result = SetTextColor(NC_hDC, &HFFFFFF): Result = SetBkMode(NC_hDC, 1)
NewCaption = UniStr2BytesArray(Text)
Result = TextOut(NC_hDC, 24, 6, NewCaption(0), UBound(NewCaption))
Result = SelectObject(NC_hDC, Old_hFont): Result = DeleteObject(hFont): Result = ReleaseDC(hWnd, NC_hDC)
End Sub
PHP:
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(ProcOld, hWnd, iMsg, wParam, lParam)
SetUnicodeTitlebar Evaluate("frmCap")
End Function
PHP:
Function UniStr2BytesArray(SrcStr As String) As Unicode()
Dim SrcStrLength As Long, Seed As Long, TmpUnicode() As Unicode
SrcStrLength = LenB(SrcStr)
ReDim TmpUnicode(SrcStrLength / 2)
Do Until Seed >= SrcStrLength / 2
TmpUnicode(Seed).H = CByte(AscB(MidB(SrcStr, Seed * 2 + 1, 1)))
TmpUnicode(Seed).L = CByte(AscB(MidB(SrcStr, Seed * 2 + 2, 1)))
Seed = Seed + 1
Loop
UniStr2BytesArray = TmpUnicode
End Function
PHP:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
PHP:
Private Sub UserForm_Initialize()
hWnd = FindWindow("ThunderDFrame", Me.Caption)
SetWindowText hWnd, ""
ProcOld = SetWindowLong(hWnd, -4, AddressOf WindowProc)
End Sub
PHP:
Private Sub UserForm_Terminate()
SetWindowLong hWnd, -4, ProcOld
End Sub
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Hỏng biết có cao siêu quá không chứ như bài của em (cũng là học hỏi từ diễn đàn) lại đơn giản với 2 dòng API thôi mà Thầy!
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Nói không có bằng chứng, đưa file lên đây tôi mới tin
(Dễ ăn vậy sao???)
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
File đính kèm
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Tôi thì có cái này
E rằng cái này bạn chạy trên Win7 + Excel 2007 hoặc đã chỉnh lại font hệ thống hay sao chứ làm gì có cái cửa đơn giản như vậy
Upvote
0
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
Em đoán Font tiêu đề Windows của Anh Ndu không phải là Unicode.
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Ngược lại, với bài của Thầy, máy em lại không hiển thị bất cứ tiêu đề nào hết mới ghê (trên Win7, X2007)! Đúng là kỳ lạ!
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Dám cá rằng font hệ thống đã bị thay đổi (do cài chương trình nào đó hoặc đổi bằng tay)
- Click phải trên Desktop, chọn Properties
- Chuyển sang tab Appearance, bấm nút Advanced
- Bấm mũi tên xổ xuống của mục Item, chọn Active Title Bar
- Xem khung dưới đang là font gì? Mặc định là font Trebuchet MS
Nếu nó là font Tahoma thì chứng tỏ các bạn đã chỉnh lại font rồi và code đó không phải là cách tổng quát để hiển thị tiếng Việt trên thanh Title
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Với WinXP (máy thử) thì Font là Verdana (có thể trước đó ai đã đặt lại), còn mặc định của Win7 có thể là Verdana vì em chưa biết nó nằm ở đâu nữa để cài đặt trên chính máy tính của em.
Vì vậy đâu là tổng quát thì chưa biết, vì máy em không hiển thị tiêu đề của Form ở File của Thầy, ngược lại máy Thầy nếu không thay đổi Font mặc định cho tiêu đề window thì lại bị lỗi font.
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Verdana là Unicode rồi còn gì
Code của tôi không chỉnh font hệ thống, chỉ tạm thời chỉnh tiêu đề của Active Window thành Tahoma, thoát form lại trả mọi thứ về như cũ
Đương nhiên, nếu font hệ thống là Unicode rồi thì rất dễ, chỉ vài ba đoạn code là xong!
Tôi nghĩ code của tôi mới là tổng quát nhất, vì nó không quan tâm font hệ thống là gì... không hiểu sao bạn lại chạy không được... Nhờ các bạn khác test giúp nhé
Nói thêm: Cái vụ Unicode trên Title bar đã từng bàn rất nhiều, và nó là thứ khó nhai nhất (mà tôi biết) chứ không đơn giản như bạn đã nghĩ đâu
Upvote
0
thanhlanh
Thành viên tích cực
- Tham gia
- 21/2/08
- Bài viết
- 858
- Được thích
- 1,211
Mình thích nguyên tắc này. Nếu dungf nhiều phần mềm tiếng Việt, mà anh nào cũng chỉnh font hệ thống mới đọc được tiêu đề, mỗi anh mỗi loại font, khi thoát chương trình lại không chịu trả về như cũ, nếu đưa chương trình cho người khác dùng, đâu phải ai cũng biết chỉnh.Vậy thà chấp nhận tiêu đề không dấu còn hơn chỉnh font hệ thống (mất rin)...
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
[video=youtube;XwKQ8-EVO8k]http://www.youtube.com/watch?v=XwKQ8-EVO8k[/video]
Đây là test trên máy em đây! Các Thầy xem rồi cho biết tại sao nhé!
Đây là test trên máy em đây! Các Thầy xem rồi cho biết tại sao nhé!
Upvote
0
Bài viết mới nhất
- Question
- Đã giải quyết
- Question
- Đã giải quyết
