Bài viết: UniMsgBoxPos với Unicode

Liên hệ QC

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,649
Được thích
10,138
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
UniMsgBoxPos với Unicode

+ Hook đúng cửa sổ MsgBox
+ Hỗ trợ Unicode
+ Giải phóng việc Hook trước đó an toàn.

MsgBoxUnicode.JPG


Bổ sung thêm 3 hàm Windows API

Mã:
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long


  • Hàm GetClassName để kiểm tra loại của sổ.
  • Hàm MessageBox để thay thế MsgBox trong VBA-->Gải pháp cho Unicode.
  • Hàm GetActiveWindow để nhận điều khiển (Handle) của cửa sổ hiện thời.

Viết lại hàm MsgBoxHookProc
Mã:
Private Function MsgBoxHookProc(ByVal lMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
   
If lMsg = HCBT_ACTIVATE Then 'Kiểm tra cửa sổ hoạt động
       
'Modified by Nguyen Duy Tuan
        'Begin checking class for MsgBox Window
        'wParam is the handle of Window

        Dim cClsName As String 'Nhận tên Class của cửa sổ
        Dim x As Long 'Xác định số ký tự của chỗi
       
        cClsName = Space(32)
        x = GetClassName(wParam, cClsName, 32)
        cClsName = Left(cClsName, x) 'string convertion
       
        If cClsName = "#32770" Then 'Kiểm tra Class có phải của cửa sổ MsgBox không
          
' Change position
           SetWindowPos wParam, 0, msgbox_x, msgbox_y, _
                        0, 0, SWP_NOSIZE + SWP_NOZORDER
   
' Release the Hook
           UnhookWindowsHookEx hHook
           hHook = 0
           MsgBoxHookProc = True
        End If
    End If
 
    MsgBoxHookProc = False
End Function
 

File đính kèm

  • UniMsgBoxPos.zip
    12.2 KB · Đọc: 12
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Web KT
Back
Top Bottom