InputBox Fonksiyonu

            FONKSİYONLAR

Bilgi Alma Fonksiyonları
InputBox() Fonksiyonu

MS Access'in Yerleşik Fonksiyonları içerisinde yer alan ve kullanıcıdan bilgi alan InputBox fonksiyonunu nasıl kullanacağımızı öğreneceğiz. Ayrıca Özel InputBox kutusu oluşturmayı da öğreneceğiz. 

Açıklama

InputBox () fonksiyonu, Ms Access üzerinden kullanıcı tarafından herhangi bir bilgi alınmak isteniyorsa kullanabiliriz. Mesela anket formlarında, soru cevap formlarında şifre girişlerinde vs bolca kullanılmaktadır.

Söz Dizimi

InputBox(mesaj,başlık,geçerli,x,y,yardımdosyası,numara)

PARAMETRELER

• mesaj: pencere içinde görüntülenecek metin
• başlık: pencere başlığı
• geçerli: varsayılan yanıtınız varsa yazabilirsiniz.
• x: kutunun ekrandaki yerini belirten x koordinatı
• y: kutunun ekrandaki yerini belirten y koordinatı
• yardımdosyası: yardım dosyasını tanımlayan string ifade
• numara: yardım dosyası varsa buna karşılık gelen sayısal ifade

NOT: 1.Parametre hariç diğer parametreler isteğe bağlıdır.

Örnekler

Örnek-1

cevap = InputBox("25'in karekökü kaç yapar","Soru")

VBA Kullanımı ve Sonucu

Now() fonksiyonu ile sistem tarih ve saatini yan yana alabileceğimizi artık biliyoruz.

Gelecek makalemizde Tarih/Saat Yerleşik Fonksiyonların anlatımına devam edeceğiz. Yorumlarınızı ve eleştirilerinizi bekliyorum.

------------------------------------------------------------------------------------------------------------

InputBox() Kutusunıun Özelleştirilmesi

InputBox() kutusunu bir API ekleyerek özelleştirebiliriz. Bu makalemde InputBox kutusuna özellikle password uygulamalarında daha uygun olan girilen karakterleri "*" karakterine çevirerek görünmemesini sağlayacağız. Öncelikle uygulamanızda bir modül oluşturup aşağıdaki kodu yerleştirin.

' accessapplication.blogspot.com

' 2021

    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, _

        ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias _

        "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr

    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

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

    Private 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

    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _

        (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

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

Private Const EM_SETPASSWORDCHAR = &HCC

Private Const WH_CBT = 5

Private Const HCBT_ACTIVATE = 5

Private Const HC_ACTION = 0

#If VBA7 Then

    Private hHook As LongPtr

#Else

    Private hHook As Long

#End If

'******************************************************

'----------------------------------

'Özel İnputBox Kutusu (YILDIZLI)

'----------------------------------

#If VBA7 Then

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr

#Else

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

#End If

    Dim RetVal

    Dim strClassName As String, lngBuffer As Long

    If lngCode < HC_ACTION Then

        NewProc = 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

            'Girilen karakterleri Yıldız karakterine çevir.

                        

        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0

        End If

    End If

    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

'********************************************

Function InputBoxPW(Prompt, Title) As String

#If VBA7 Then

    Dim lngModHwnd As LongPtr

#Else

    Dim lngModHwnd As Long

#End If

    Dim lngThreadID As Long

    lngThreadID = GetCurrentThreadId

    lngModHwnd = GetModuleHandle(vbNullString)

    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

    InputBoxPW = InputBox(Prompt, Title)

    UnhookWindowsHookEx hHook

End Function

Şimdi de bu fonksiyonu nasıl kullanacağımıza gelelim. Bu fonksiyonu aynı InputBox fonksiyonu gibi uygulamanızın her yerinden çağırarak kullanabilirsiniz. InputBox yerine InputBoxPW(parametreler)

Hepsi bu! Örnek alt yordam aşağıdadır.

'********************************************************************

Sub InputBoxParola()

Dim cevap As String

cevap = InputBoxPW("Şifrenizi Giriniz:", "Yıldızlı İnputBox Kutusu")

If cevap = "access" Then

MsgBox "accessapplication.blogspot.com", vbQuestion + vbOKOnly

MsgBox "Şifre Doğru"

Exit Sub

Else

MsgBox "Geçersiz şifre lütfen tekrar deneyiniz."

End If

End Sub

'********************************************************************

Şimdilik,
Hoşcakalın...