Telefon Rehberi v1.2

mayhemious · Mesaj gönderen **mayhemious** » 05 Oca 2008, 20:01

Konu burada

http://forumsordum.com/forum/viewtopic.php?t=27259

Projede 5 form bulunmakta, 1 adet de modül. ilk form:

Option Explicit

Private Sub Command1_Click() 'Sonraki Kayıt'
On Error GoTo hata
Label2.Caption = ""
Data1.Recordset.MoveNext
hata:
Select Case Err.Number
Case 3021: Label2.Caption = "Kayıt Yok!" '3021 hatası kayıt yok'
End Select
Resume Next
End Sub

Private Sub Command10_Click() 'arama formuna geçis'
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = False
Command8.Enabled = False
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Form3.Show
End Sub

Private Sub Command2_Click() 'önceki kayıt'
On Error GoTo hata
Label2.Caption = ""
Data1.Recordset.MovePrevious
hata:
Select Case Err.Number
Case 3021: Label2.Caption = "Kayıt Yok!"
End Select
Resume Next
End Sub

Private Sub Command3_Click() 'ilk Kayıt'
On Error GoTo hata
Label2.Caption = ""
Data1.Recordset.MoveFirst
hata:
Select Case Err.Number
Case 3021: Label2.Caption = "Kayıt Yok!"
End Select
Resume Next
End Sub

Private Sub Command4_Click() 'Son Kayıt'
On Error GoTo hata
Label2.Caption = ""
Data1.Recordset.MoveLast
hata:
Select Case Err.Number
Case 3021: Label2.Caption = "Kayıt Yok!"
End Select
Resume Next
End Sub

Private Sub Command5_Click() 'kayıt silme'
If MsgBox("Kayıt Silinsinmi?", vbYesNo, "Dikkat") = vbNo Then GoTo iptal
On Error GoTo hata
Label2.Caption = ""
Data1.Recordset.Delete
Data1.Recordset.MoveFirst
Exit Sub
hata:
Select Case Err.Number
Case 3021: Label2.Caption = "Kayıt Yok!"
End Select
Resume Next
iptal:
MsgBox "iptal edildi"
End Sub

Private Sub Command6_Click() 'yeni Kayıt Ekleme'
Data1.Recordset.AddNew
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = True
Command8.Enabled = True
Text1.Locked = False
Text2.Locked = False
Text3.Locked = False
Text4.Locked = False
End Sub

Private Sub Command7_Click() 'kaydet'
On Error GoTo hata
Data1.Recordset.AddNew
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = False
Command8.Enabled = False
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Data1.Recordset.MoveLast
Label2.Caption = "Kaydedildi!"
Exit Sub
hata:
Select Case Err.Number
Case 3426: MsgBox "Bu Kayıt Mevcut !!"
End Select
Data1.Recordset.CancelUpdate
Data1.Recordset.MoveLast
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = False
Command8.Enabled = False

End Sub

Private Sub Command8_Click() 'iptal'
On Error GoTo hata
Data1.Recordset.CancelUpdate
Data1.Recordset.MoveFirst
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = False
Command8.Enabled = False
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Label2.Caption = "İptal Edildi"
hata:
Select Case Err.Number
Case 3021: MsgBox "Kayıt Yok !!"
End Select
Resume Next

End Sub

Private Sub Command9_Click() 'Tüm kayıtları göster formuna geçis'

Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = False
Command8.Enabled = False
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Form2.Show
End Sub

Private Sub Data1_Reposition() 'Kayıt numarasını göster'
Text5.Text = Data1.Recordset.AbsolutePosition
End Sub

Private Sub Form_Load() 'Form yüklenirken textler kilit, giris ve iptal deaktif'
Command7.Enabled = False
Command8.Enabled = False
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Sag tık menu'
If Button = 2 Then
Form1.PopupMenu mnuMenu
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 'Form kapanırken hata mesajı çıkıyor'
If MsgBox("Program Kapatılıyor", vbInformation + vbOKCancel, "Çıkıs") = vbCancel Then
Cancel = 1
End If
End Sub

Private Sub mnuDestek_Click() 'destekleyenler formuna geçis'
Form4.Show
End Sub

Private Sub mnuExit_Click() 'çıkıs butonu'
Unload Me
End Sub

Private Sub mnuHakk_Click() 'hakkında butonu'
If MsgBox("mayhemious tarafından Visual Basic Dilinde Yapılmıstır... Web Sitemizi ziyaret etmek ve XPSPEED'i denemek ister misiniz?", vbYesNo, "Hakkında") = vbYes Then GoTo site
Exit Sub
site:
form5.Show
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer) 'telefon hanesine sadece rakam girme'
If IsNumeric(Chr(KeyAscii)) = False Then KeyAscii = MsgBox("Sadece rakam girebilirsiniz", vbCritical + vbOKOnly)
End Sub

Private Sub Timer1_Timer() 'Yanıp sönen yazı için gerekli timer'
Timer3.Enabled = True
End Sub

Private Sub Timer2_Timer() 'yanıp sönen yazı için gerekli timer'
Timer1.Enabled = True
Timer3.Enabled = False
Label2.Caption = ""
End Sub

Private Sub Timer3_Timer() 'yanıp sönen yazı timer ı'
If Label2.Visible = True Then
Label2.Visible = False
Else
Label2.Visible = True
End If
End Sub

mayhemious · Mesaj gönderen **mayhemious** » 05 Oca 2008, 20:05

ikinci form da sadece datagrid bulunmakta (Tüm Kayıtları göster)

üçüncü form kayıt arama formu

Option Explicit

Private Sub Command1_Click() 'Ad a göre arama'
On Error Resume Next
Data1.Recordset.MoveFirst
Data1.ReadOnly = True
Do While Data1.Recordset.EOF = False
If Data1.Recordset.ad = Text1.Text Then
Label1.Caption = Data1.Recordset.Fields("soyad")
Label2.Caption = Data1.Recordset.Fields("telefon")
Exit Do
Else
Data1.Recordset.MoveNext
Label1.Caption = "Kayıt Bulunamadı"
Label2.Caption = "Kayıt Bulunamadı"
End If
Loop
End Sub

Private Sub Command2_Click() 'iptal'
Unload Me
End Sub

dördüncü form destekleyenler formu. üzerinde 3 adet label bulunmakta

besinci form web sitemizi acan mini bir web browser formu

Private Sub Form_Load()
WebBrowser1.Navigate ("index.php")

End Sub

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
Form3.Caption = Form3.Caption + WebBrowser1.LocationURL
End Sub

son olarak modül kullandıgım dll ve ocx leri manual olarak kaydettirmek için (gerek yokmus bknz vb optimizasyon)

Option Explicit

Sub Main() 'kullandıgın dll ve ocx leri kayıt ettir'
Shell "regsvr32 /s msvbvm60.dll", vbHide
Shell "regsvr32 /sMSJET35.DLL", vbHide
Shell "regsvr32 /sDAO350.DLL", vbHide
Shell "regsvr32 /soleaut32.dll", vbHide
Shell "regsvr32 /sDBGRID32.OCX", vbHide
Shell "regsvr32 /sMSREPL35.DLL", vbHide
Shell "regsvr32 /sMSRDO20.DLL", vbHide
Shell "regsvr32 /sexpsrv.dll", vbHide
Shell "regsvr32 /sMSVCRT40.DLL", vbHide
Shell "regsvr32 /sMSDATGRD.OCX", vbHide
Shell "regsvr32 /sMSRD2X35.DLL", vbHide
Shell "regsvr32 /sMSJINT35.DLL", vbHide
Shell "regsvr32 /sMSSTDFMT.DLL", vbHide
Shell "regsvr32 /sVB6STKIT.DLL", vbHide
Shell "regsvr32 /sVB5DB.DLL", vbHide
Shell "regsvr32 /solepro32.dll", vbHide
Shell "regsvr32 /svbajet32.dll", vbHide
Shell "regsvr32 /sMSJTER35.DLL", vbHide
Shell "regsvr32 /sCOMCAT.DLL", vbHide
Shell "regsvr32 /swmp.DLL", vbHide
Shell "regsvr32 /sasycfilt.dll", vbHide
Form1.Show
End Sub

Mesaj gönderen **hsnclk** » 14 Haz 2008, 13:15

Bide Ekran Görüntüsü verirmisin programın..
(telefon rehberi dedigin telefonları saklayabilecegimiz bi rehber mi)