[es] - Promena boje teksta ili pozadine u input box-u

necca1
Tehnicar za ispitivanje kvarova na
vodovodu
JKP Beogradski vodovod i kanalizacija
Zemun

Član broj: 188739
Poruke: 72
*.dynamic.sbb.rs.

Profil

Re: Promena boje teksta ili pozadine u input box-u

^{18.03.2017. u 23:09 - pre 86 meseci}

Uspeo sam da resim problem.

Pronasao sam kod koji radi i na 64-bitnim verzijama

Evo koda pa ako nekome zatreba

Option Explicit
Public hHook As LongPtr
Public Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
Public Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
Public Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As LongPtr, ByVal uExitCode As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
Public Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

Public Const EM_SETPASSWORDCHAR = &HCC
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public Const HC_ACTION = 0
Here is the code...

Sub testInput64()
Dim test As String
test = InputBoxDK_64("Enter your SAP password.", "SAP Password")
End Sub

Function InputBoxDK_64(Prompt, Title) As String
Dim lngModHwnd As LongPtr, lngThreadID As Long
On Error Resume Next
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc_64, lngModHwnd, lngThreadID)
InputBoxDK_64 = InputBox(Prompt, Title)
UnhookWindowsHookEx hHook
End Function

Public Function NewProc_64(ByVal lngCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Dim RetVal
Dim strClassName As String, lngBuffer As Long
On Error Resume Next
If lngCode < HC_ACTION Then
NewProc_64 = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Ovaj kod se koristi kao modul

Hvala svima

Odgovor na temu