| |
Хотите использовать стандартный InputBox
для ввода информации, скрытой звездочками? Нет
проблем, сказал один из программистов, и создал
для вас этот пример. В этом примере вам
понадобится дополнительный модуль
'КОД ФОРМЫ
Private Sub Command1_Click()
Dim ret As String
ret = InputBoxEx("Наберите пароль:",
"Программа...")
Label1 = ret
End Sub
'КОД МОДУЛЯ
Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As
String, ByVal lpsz2 As String) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIDEvent As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long)
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 SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private m_lMsgHandle As Long
Private m_lhHook As Long
Private Const ES_CENTER = &H1&
Private Function GetMessageBoxHandle(ByVal lMsg As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
m_lMsgHandle = wParam
UnhookWindowsHookEx m_lhHook
m_lhHook = 0
End If
GetMessageBoxHandle = False
End Function
Private Sub InputBoxTimerUpdateEvent(hWnd As Long, uiMsg As Long, idEvent As Long, dwTime
As Long)
Dim res As Long
If m_lMsgHandle = 0 Then Exit Sub
res = FindWindowEx(m_lMsgHandle, 0, "Edit", "")
SendMessage res, 1052, 42, ByVal 0&
SendMessage res, &H441, ES_CENTER, ByVal 0&
End Sub
Public Function InputBoxEx(sMsgText As String, Optional sTitle As String = "Secured
InputBox") As String
Dim lTimerUpdate As Long
m_lhHook = SetWindowsHookEx(WH_CBT, AddressOf GetMessageBoxHandle, App.hInstance,
GetCurrentThreadId())
lTimerUpdate = SetTimer(0, 0, 0, AddressOf InputBoxTimerUpdateEvent)
InputBoxEx = InputBox(sMsgText, sTitle)
KillTimer 0, lTimerUpdate
End Function
|
|