Pershendetje,
ja nje shembull per Access 2003:
Kodi per Formen ne Access:
Kodi:
Option Compare Database
Option Explicit
Private Sub Form_Load()
On Error GoTo Err_Out:
Dim lTemp As Long
Dim sTemp As String
lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
sTemp = InputBox("Shenoni fjalen kaluese", "Dialogu i fjales kaluese")
If sTemp = vbNullString Then
Err.Raise 1000, "Sheno fjalen kaluese", "Fjalka kaluese eshte e doemosdoshme"
Else
MsgBox sTemp
End If
Exit Sub
Err_Out:
Select Case Err.Number
Case 1000
MsgBox Err.Description, vbCritical + vbOKOnly, Err.Source
Err.Clear
DoCmd.Close acForm, "Form1", acSaveNo
Case Else
Err.Clear
DoCmd.Close acForm, "Form1", acSaveNo
End Select
End Sub
dhe kodin per nje Modul:
Kodi:
Option Compare Database
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
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
Public Declare Function SetTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
lpTimerFunc&)
Private Declare Function KillTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&)
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
Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&
Private Declare Function GetCurrentVbaProject _
Lib "vba332.dll" Alias "EbGetExecutingProj" _
(hProject As Long) As Long
Private Declare Function GetFuncID _
Lib "vba332.dll" Alias "TipGetFunctionId" _
(ByVal hProject As Long, ByVal strFunctionName As String, _
ByRef strFunctionId As String) As Long
Private Declare Function GetAddr _
Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, ByVal strFunctionId As String, _
ByRef lPfn As Long) As Long
Const NO_ERROR = 0
Public Function TimerProc(ByVal lHwnd&, ByVal uMsg&, _
ByVal lIDEvent&, ByVal lDWTime&) As Long
Dim lEditHwnd As Long
lEditHwnd = FindWindowEx(FindWindow("#32770", "Dialogu i fjales kaluese"), 0, "Edit", "")
Call SendMessage(lEditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)
KillTimer lHwnd, lIDEvent
End Function
Public Function MyAddressOf(sFuncName As String) As Long
Dim lResult As Long
Dim lHproject As Long
Dim sFuncID As String
Dim lFuncPtr As Long
Dim sFuncNameUnicode As String
sFuncNameUnicode = StrConv(sFuncName, vbUnicode)
Call GetCurrentVbaProject(lHproject)
If lHproject <> 0 Then
lResult = GetFuncID(lHproject, sFuncNameUnicode, sFuncID)
If lResult = NO_ERROR Then
lResult = GetAddr(lHproject, sFuncID, lFuncPtr)
If lResult = NO_ERROR Then
MyAddressOf = lFuncPtr
End If
End If
End If
End Function
Krijoni Kontakt