yusuf1284
Altın Üye
- Katılım
- 17 Ocak 2015
- Mesajlar
- 234
- Excel Vers. ve Dili
- Office Pro 2016 TR
- Altın Üyelik Bitiş Tarihi
- 09-02-2028
Textbox olaylarını yönettiğim clas var txt_Change olayım sürekli yenileniyor benim istediğim kullanıcı 500 ms boyunca yazmayı bıraktıktan işlemleri yapması araştırmam da bulamadım yardımcı olur musunuz? dosya boyutu yüksek olduğundan örnek dosya atamadım kusuruma bakmayın.
C++:
Public WithEvents txt As MSForms.TextBox
Public mpg As MSForms.MultiPage
Public anahtar As String
Private isProcessing As Boolean
Private Sub txt_Change()
' Uygulama olayları kapalıysa çık
If Application.EnableEvents = False Then Exit Sub
' Statik değişkenle sonsuz döngü önleme
Static isProcessing As Boolean
' Zaten işlem yapılıyorsa çık
If isProcessing Then Exit Sub
anahtar = TabloPrimaryKeyBul(frm_KayitForm.cbmTablolar.Value)
' İşlem bayrağını aktif et
isProcessing = True
' Tüm metni büyük harfe çevir
If InStr(1, txt.Name, "text", vbTextCompare) > 0 Then
If InStr(1, txt.Name, "TC", vbTextCompare) = 0 Then
txt.Value = modOrtakFonk.BuyukHarfYap(txt.Value)
End If
End If
' TC Kimlik No alanı için özel işlemler
If txt.Name = "txt_Text_PER_TC_KIMLIK_NO" Then
' Formdaki tüm textboxları temizle
frm_KayitForm.TumTextBoxlariTemizle
' KeyUp olayını yönet (TC validasyonu için)
OlayYonet "KeyUp", txt.Value, 0
End If
' İşlem bayrağını kapat
isProcessing = False
End Sub
'Private Sub txt_KeyDown(ByVal tusKodu As MSForms.ReturnInteger, ByVal tusDurumu As Integer)
' OlayYonet "KeyDown", tusKodu, 0
'End Sub
Private Sub txt_KeyUp(ByVal tusKodu As MSForms.ReturnInteger, ByVal tusDurumu As Integer)
OlayYonet "KeyUp", tusKodu, 0
End Sub
'Private Sub txt_KeyPress(ByVal krkKodu As MSForms.ReturnInteger)
' ' Uyarı etiketini gizle
' frm_KayitForm.lblUyarilar.Visible = False
' ' KeyPress olayını yönet
' OlayYonet "KeyPress", 0, krkKodu
'End Sub
Private Sub txt_MouseUp(ByVal dugme As Integer, ByVal tusDurumu As Integer, ByVal X As Single, ByVal Y As Single)
OlayYonet "MouseUp", 0, 0
End Sub
Private Sub OlayYonet(ByVal olayTipi As String, ByVal tusKodu As Variant, ByVal krkKodu As Integer)
'SureBekle 300, True
'------------------------------
' ANAHTAR AD ALANI KONTROLÜ
'------------------------------
If InStr(1, txt.Name, anahtar, vbTextCompare) > 0 Then
If txt.text <> "" Then
If modAccssVeriİslemleri.KayitVarMi(frm_KayitForm.cbmTablolar.Value, txt.text, txt.Tag) Then
' Kayıt varsa formu doldur
frm_KayitForm.FormuVeriIleDoldur frm_KayitForm.cbmTablolar.Value, txt.text, txt.Tag
Else
' Kayıt yoksa formu temizle
'frm_KayitForm.TumTextBoxlariTemizle
frm_KayitForm.btnSave.Caption = "YENİ EKLE"
End If
End If
End If
'------------------------------
' TARİH ALANLARI İŞLEMLERİ
'------------------------------
If InStr(1, txt.Name, "date", vbTextCompare) > 0 Then
If olayTipi = "KeyUp" Or olayTipi = "MouseUp" Then
' Takvim formunu çağır ve konumlandır
frm_DatePicker.ChooseDate txt
End If
End If
'------------------------------
' LİSTE ALANLARI İŞLEMLERİ
'------------------------------
If InStr(1, txt.Name, "lst", vbTextCompare) > 0 Then
If olayTipi = "KeyUp" Or olayTipi = "MouseUp" Then
listecagir ' Liste seçim formunu aç
End If
End If
'------------------------------
' ÖZEL AD ALANI KONTROLÜ
'------------------------------
If txt.Name = "txt_Text_AD" And olayTipi = "KeyPress" Then
' Boşluk karakteri engelleme (ASCII 32)
If krkKodu = 32 Then
UyariGoster "İki adın yoksa SOYADINI buraya yazma!"
Exit Sub
End If
End If
'------------------------------
' SAYISAL ALANLAR & TC KİMLİK
'------------------------------
If InStr(1, txt.Name, "number", vbTextCompare) > 0 Or _
InStr(1, txt.Name, "TC", vbTextCompare) > 0 Then
' Karakter bazında filtreleme (sadece sayı ve backspace)
If olayTipi = "KeyPress" Then
If Not (krkKodu >= 48 And krkKodu <= 57) And krkKodu <> 8 Then
krkKodu = 0 ' Geçersiz karakteri engelle
End If
End If
' Yapıştırma sonrası temizleme ve validasyon
If olayTipi = "KeyUp" Then
Dim i As Integer, temizMetin As String
' Sadece sayısal karakterleri koru
For i = 1 To Len(txt.text)
If Mid(txt.text, i, 1) >= "0" And Mid(txt.text, i, 1) <= "9" Then
temizMetin = temizMetin & Mid(txt.text, i, 1)
End If
Next i
' Temizlenmiş metni uygula
If txt.text <> temizMetin Then txt.text = temizMetin
' TC KİMLİK ÖZEL İŞLEMLERİ
If InStr(1, txt.Name, "txt_Text_PER_TC_KIMLIK_NO", vbTextCompare) > 0 Then
' Uzunluk kontrolü
If Len(temizMetin) = 11 Then
' TC algoritma validasyonu
If Not GecerliTCKimlik(temizMetin) Then
UyariGoster "Geçersiz TC Kimlik Numarası!"
Else
' Veritabanında kayıt kontrolü
Dim tckimliknu As String
tckimliknu = CDbl(txt.text)
End If
ElseIf Len(temizMetin) > 11 Then
UyariGoster "Geçersiz TC Kimlik Numarası! 11 Hane Olmalı"
ElseIf Len(temizMetin) <= 11 Then
frm_KayitForm.TumTextBoxlariTemizle
End If
End If
End If
End If
End Sub
Function UyariGoster(mesaj As String)
' Uyarı etiketini ayarla ve göster
modOrtakFonk.UygulamaAyarlariniYap (False)
With frm_KayitForm.lblUyarilar
.Visible = True
.Caption = mesaj
End With
' Yanıp sönen animasyon (3 döngü)
For k = 0 To 2
frm_KayitForm.lblUyarilar.Visible = True
SureBekle 200, True ' 200 ms bekle
frm_KayitForm.lblUyarilar.Visible = False
SureBekle 100, True ' 100 ms bekle
Next k
' Son durumda görünür bırak
frm_KayitForm.lblUyarilar.Visible = True
modOrtakFonk.UygulamaAyarlariniYap (True)
End Function
Private Function GecerliTCKimlik(tc As String) As Boolean
' Temel kontroller
If Len(tc) <> 11 Then Exit Function
If Left(tc, 1) = "0" Then Exit Function
Dim i As Integer, toplam1 As Integer, toplam2 As Integer
' Tek sıradaki haneler (1,3,5,7,9)
For i = 1 To 9 Step 2
toplam1 = toplam1 + Val(Mid(tc, i, 1))
Next
' Çift sıradaki haneler (2,4,6,8)
For i = 2 To 8 Step 2
toplam2 = toplam2 + Val(Mid(tc, i, 1))
Next
' 10. hane hesaplama
Dim hane10 As Integer
hane10 = ((toplam1 * 7) - toplam2) Mod 10
' 11. hane hesaplama
Dim hane11 As Integer
hane11 = (toplam1 + toplam2 + Val(Mid(tc, 10, 1))) Mod 10
' Sonuç kontrolü
GecerliTCKimlik = (Val(Mid(tc, 10, 1)) = hane10) And _
(Val(Mid(tc, 11, 1)) = hane11)
End Function
'*******************************************************
'* LISTECAGIR - Liste Seçim Formunu Açar *
'* Amaç: Tanımlı listeleri liste kutusunda göstermek *
'* İşlem Adımları: *
'* 1. Olayları geçici olarak durdur *
'* 2. Hedef textbox'ı liste formuna ata *
'* 3. İlgili listeyi sayfadan al *
'* 4. Liste formunu göster *
'*******************************************************
Function listecagir()
Application.EnableEvents = False ' Olayları askıya al
' Hedef kontrolü ve listeyi forma ata
Set frm_ListPicker.targetTextBox = txt
frm_ListPicker.gelenListe = modOrtakFonk.ListeyiDiziOlarakGetir(Split(txt.Name, "lst_")(1))
frm_ListPicker.Show ' Liste formunu göster
Application.EnableEvents = True ' Olayları aktif et
End Function