Nhờ chuyển code từ 32 bit lên 64 bit (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

LienDong

Thành viên thường trực
Tham gia
22/11/12
Bài viết
233
Được thích
46
Nghề nghiệp
Ai nói đúng thì làm!
Các bạn giúp mình chuyển code từ 32 bit lên 64 bit như sau:

Option Explicit
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long



Private hHook As Long

' Position
Private msgbox_x As Long
Private msgbox_y As Long

' Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5

' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1 ' Retains the current size
Private Const SWP_NOZORDER = &H4 ' Retains the current Z order





Public Function MsgBoxPos(strPromt As String, _
vbButtons As VbMsgBoxStyle, _
strTitle As String, _
xPos As Long, _
yPos As Long) As VbMsgBoxResult


' Store position
msgbox_x = xPos
msgbox_y = yPos

' Set Hook
hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
0, _
GetCurrentThreadId)

' Run MessageBox
MsgBoxPos = MsgBox(strPromt, vbButtons, strTitle)
End Function

Private Function MsgBoxHookProc(ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
' Change position
SetWindowPos wParam, 0, msgbox_x, msgbox_y, _
0, 0, SWP_NOSIZE + SWP_NOZORDER

' Release the Hook
UnhookWindowsHookEx hHook
End If

MsgBoxHookProc = False
End Function



Code trên nằm ở chủ đề
Làm sao để bảng thông báo Msgbox hiện ở góc phải dưới màn hình!
http://www.giaiphapexcel.com/dienda...-msgbox-hiện-ở-góc-phải-dưới-màn-hình.123386/

Xin cảm ơn!
 
Nhờ các bạn giúp đỡ bài trên.
 
Upvote 0
Bổ sung thêm phần in đậm trong những dòng lệnh là ok

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As LongPtr) As LongPtr


Các bạn giúp mình chuyển code từ 32 bit lên 64 bit như sau:

Option Explicit
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long



Private hHook As Long

' Position
Private msgbox_x As Long
Private msgbox_y As Long

' Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5

' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1 ' Retains the current size
Private Const SWP_NOZORDER = &H4 ' Retains the current Z order





Public Function MsgBoxPos(strPromt As String, _
vbButtons As VbMsgBoxStyle, _
strTitle As String, _
xPos As Long, _
yPos As Long) As VbMsgBoxResult


' Store position
msgbox_x = xPos
msgbox_y = yPos

' Set Hook
hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
0, _
GetCurrentThreadId)

' Run MessageBox
MsgBoxPos = MsgBox(strPromt, vbButtons, strTitle)
End Function

Private Function MsgBoxHookProc(ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
' Change position
SetWindowPos wParam, 0, msgbox_x, msgbox_y, _
0, 0, SWP_NOSIZE + SWP_NOZORDER

' Release the Hook
UnhookWindowsHookEx hHook
End If

MsgBoxHookProc = False
End Function



Code trên nằm ở chủ đề
Làm sao để bảng thông báo Msgbox hiện ở góc phải dưới màn hình!
http://www.giaiphapexcel.com/diendan/threads/làm-sao-để-bảng-thông-báo-msgbox-hiện-ở-góc-phải-dưới-màn-hình.123386/

Xin cảm ơn!
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom