İLK OLARAK 3 FORM VEBİRDE SPLASH SCREN EKLENİR

' DAHA SONRA BUNLARA BU KODLAR EKLENİR

Kod:
' FORM1.NAME=ana ekran ' form2.name=frmAddEntry 'form3.name=Frmhelp 'olarak ayarlanır ve başlanır 'ANA EKRAN İCİN Private Sub about_Click(Index As Integer) frmSplash.Show End Sub Private Sub addentry_Click(Index As Integer) frmAddEntry.Show End Sub Private Sub cmdAddEntry_Click() frmAddEntry.Show Form1.Hide End Sub Private Sub cmdClear_Click() txtSearch.Text = "" End Sub Private Sub cmdDelete_Click() If lstNames.ListIndex = -1 Then If MsgBox("yanlıs secim ", vbExclamation) = vbOK Then Exit Sub End If If MsgBox("silmek istediginizden emin misiniz?", vbQuestion + vbYesNo) = vbNo Then Exit Sub Dim a As Integer a = lstNames.ListIndex lstNames.RemoveItem a lstaddress.RemoveItem a lstSuburb.RemoveItem a lstState.RemoveItem a lstPostCode.RemoveItem a lstCountry.RemoveItem a lstNumbers.RemoveItem a lstNumbers2.RemoveItem a lstFax.RemoveItem a lstMobile.RemoveItem a lstWork.RemoveItem a lstWorkNo.RemoveItem a lstCoFax.RemoveItem a lstEmail.RemoveItem a lstWebSite.RemoveItem a lstComments.RemoveItem a If a = lstNames.ListCount Then lstNames.ListIndex = a - 1 Else lstNames.ListIndex = a End If Call lstNames_Click Call Save_It End Sub Private Sub cmdExit_Click() End End Sub Private Sub cmdHelp_Click() Frmhelp.Show End Sub Private Sub cmdPrint_Click() If Form1.lstNames.ListIndex = -1 Then If MsgBox("Warning: You Do Not Have An Entry Selected. If You Continue, Blank Fields Will Be Printed.", vbCritical) = vbOK Then End If End If If MsgBox("yazdırma islemine hazir misiniz?", vbYesNo) = vbYes Then Call Print_it End Sub Private Sub Print_it() Printer.Font = "Impact" Printer.FontSize = 16 Printer.FontBold = True Printer.ForeColor = QBColor(3) Printer.FontUnderline = True Printer.Print "ZAFER ASLAN TELEFON DEFTERI" Printer.Print "" Printer.FontUnderline = True Printer.Font = "comic sans MS" Printer.FontUnderline = False Printer.FontSize = 12 Printer.Print "adi: ", , Printer.FontBold = False Printer.Print Form1.lblName.Text Printer.FontBold = True Printer.Print "adresi: ", , Printer.FontBold = False Printer.Print Form1.lblAddress.Text Printer.FontBold = True Printer.Print "ilcesi: ", , Printer.FontBold = False Printer.Print Form1.lblState.Text Printer.FontBold = True Printer.Print "Post kodu: ", , Printer.FontBold = False Printer.Print Form1.lblPostCode.Text Printer.FontBold = True Printer.Print "ulkesi: ", , Printer.FontBold = False Printer.Print Form1.lblCountry.Text Printer.FontBold = True Printer.Print "tel nosu: ", Printer.FontBold = False Printer.Print Form1.lblPhNo.Text Printer.FontBold = True Printer.Print "Tel no 2: ", Printer.FontBold = False Printer.Print Form1.lblPhNo2.Text Printer.FontBold = True Printer.Print "Fax no: ", Printer.FontBold = False Printer.Print Form1.lblFax.Text Printer.FontBold = True Printer.Print "Mobile no: ", Printer.FontBold = False Printer.Print Form1.lblMobile.Text Printer.FontBold = True Printer.Print "Company adi: ", Printer.FontBold = False Printer.Print Form1.lblWork.Text Printer.FontBold = True Printer.Print "Company Ph. No.: ", Printer.FontBold = False Printer.Print Form1.lblWorkNo.Text Printer.FontBold = True Printer.Print "Company Fax Number: ", Printer.FontBold = False Printer.Print Form1.lblCoFax.Text Printer.FontBold = True Printer.Print "Email: ", , Printer.FontBold = False Printer.Print Form1.lblEmail.Text Printer.FontBold = True Printer.Print "Web Site: ", , Printer.FontBold = False Printer.Print Form1.lblWebSite.Text Printer.FontBold = True Printer.Print "Aciklma: ", , Printer.FontBold = False Printer.Print Form1.lblComments.Text Printer.EndDoc End Sub Private Sub cmdSave_Click() If MsgBox("kaydetmek istediginize emin misiniz?", vbQuestion + vbYesNo) = vbNo Then Exit Sub Call Save_It End Sub Private Sub Save_It() Open "Numbers.dat" For Output As 1 For i = 0 To lstNames.ListCount - 1 Print #1, lstNames.List(i) Print #1, lstaddress.List(i) Print #1, lstSuburb.List(i) Print #1, lstState.List(i) Print #1, lstPostCode.List(i) Print #1, lstCountry.List(i) Print #1, lstNumbers.List(i) Print #1, lstNumbers2.List(i) Print #1, lstFax.List(i) Print #1, lstMobile.List(i) Print #1, lstWork.List(i) Print #1, lstWorkNo.List(i) Print #1, lstCoFax.List(i) Print #1, lstEmail.List(i) Print #1, lstWebSite.List(i) Print #1, lstComments.List(i) Next i Close #1 End Sub Private Sub Delete_Click(Index As Integer) Call cmdDelete_Click End Sub Private Sub Exit_Click(Index As Integer) End End Sub Private Sub SwapList(lst As ListBox, a As Integer, b As Integer) Dim temp As String temp = lst.List(a) lst.List(a) = lst.List(b) lst.List(b) = temp End Sub Private Sub SwapPeople(a As Integer, b As Integer) ' used by the sort to swap two values Call SwapList(lstNames, a, b) Call SwapList(lstaddress, a, b) Call SwapList(lstSuburb, a, b) Call SwapList(lstState, a, b) Call SwapList(lstPostCode, a, b) Call SwapList(lstCountry, a, b) Call SwapList(lstNumbers, a, b) Call SwapList(lstNumbers2, a, b) Call SwapList(lstFax, a, b) Call SwapList(lstMobile, a, b) Call SwapList(lstWork, a, b) Call SwapList(lstWorkNo, a, b) Call SwapList(lstCoFax, a, b) Call SwapList(lstEmail, a, b) Call SwapList(lstWebSite, a, b) Call SwapList(lstComments, a, b) End Sub Private Sub Sort_it() ' sort them alphabetically ' uses a bubble sort Dim a As Integer, b As Integer For a = 0 To lstNames.ListCount - 2 For b = a + 1 To lstNames.ListCount - 1 ' compare and swap if necessary If lstNames.List(b) < lstNames.List(a) Then Call SwapPeople(a, b) End If Next b Next a Call lstNames_Click ' show it all up now again End Sub Private Sub cmdSort_Click() Call Sort_it End Sub Private Sub Command1_Click() frmSplash.Show Form1.Hide End Sub Private Sub Form_Load() On Error GoTo ErrorHandler Dim TempName As String, TempNumber As String Open "Numbers.dat" For Input As 1 On Error Resume Next Do Until EOF(1) Line Input #1, TempName lstNames.AddItem TempName Line Input #1, TempAddress lstaddress.AddItem TempAddress Line Input #1, TempSuburb lstSuburb.AddItem TempSuburb Line Input #1, tempstate lstState.AddItem tempstate Line Input #1, TempPostCode lstPostCode.AddItem TempPostCode Line Input #1, TempCountry lstCountry.AddItem TempCountry Line Input #1, TempNumber lstNumbers.AddItem TempNumber Line Input #1, TempNumber2 lstNumbers2.AddItem TempNumber2 Line Input #1, TempFax lstFax.AddItem TempFax Line Input #1, TempMobile lstMobile.AddItem TempMobile Line Input #1, TempWork lstWork.AddItem TempWork Line Input #1, TempWorkNo lstWorkNo.AddItem TempWorkNo Line Input #1, TempCoFax lstCoFax.AddItem TempCoFax Line Input #1, TempEmail lstEmail.AddItem TempEmail Line Input #1, TempWebSite lstWebSite.AddItem TempWebSite Line Input #1, TempComments lstComments.AddItem TempComments Loop Close #1 lstNames.ListIndex = 0 Call Sort_it ErrorHandler: Select Case Err.Number Case 53 Call Save_It End Select End Sub Private Sub help2_Click(Index As Integer) Frmhelp.Show End Sub Private Sub lblComments_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then KeyAscii = 0 End If End Sub Private Sub lblCountry_LostFocus() If lstNames.ListCount > 0 Then lstCountry.List(lstNumbers.ListIndex) = lblCountry.Text End If End Sub Private Sub lblSuburb_LostFocus() If lstNames.ListCount > 0 Then lstSuburb.List(lstNumbers.ListIndex) = lblSuburb.Text End If End Sub Private Sub lblState_LostFocus() If lstNames.ListCount > 0 Then lblState.Text = UCase(lblState.Text) lstState.List(lstNumbers.ListIndex) = lblState.Text End If End Sub Private Sub lblPostCode_LostFocus() If lstNames.ListCount > 0 Then lstPostCode.List(lstNumbers.ListIndex) = lblPostCode.Text End If End Sub Private Sub lblCoFax_LostFocus() If lstNames.ListCount > 0 Then lstCoFax.List(lstNumbers.ListIndex) = lblCoFax.Text End If End Sub Private Sub lblFax_LostFocus() If lstNames.ListCount > 0 Then lstFax.List(lstNumbers.ListIndex) = lblFax.Text End If End Sub Private Sub lblMobile_LostFocus() If lstNames.ListCount > 0 Then lstMobile.List(lstNumbers.ListIndex) = lblMobile.Text End If End Sub Private Sub lblEmail_LostFocus() If lstNames.ListCount > 0 Then lstEmail.List(lstNumbers.ListIndex) = lblEmail.Text End If End Sub Private Sub lblName_LostFocus() If lstNames.ListCount > 0 Then lstNames.List(lstNumbers.ListIndex) = lblName.Text End If End Sub Private Sub lblPhNo_LostFocus() If lstNames.ListCount > 0 Then lstNumbers.List(lstNumbers.ListIndex) = lblPhNo.Text End If End Sub Private Sub lblPhNo2_LostFocus() If lstNames.ListCount > 0 Then lstNumbers2.List(lstNumbers.ListIndex) = lblPhNo2.Text End If End Sub Private Sub lblWebSite_LostFocus() If lstNames.ListCount > 0 Then lstWebSite.List(lstNumbers.ListIndex) = lblWebSite.Text End If End Sub Private Sub lblWork_LostFocus() If lstNames.ListCount > 0 Then lstWork.List(lstNumbers.ListIndex) = lblWork.Text End If End Sub Private Sub lblWorkNo_LostFocus() If lstNames.ListCount > 0 Then lstWorkNo.List(lstNumbers.ListIndex) = lblWorkNo.Text End If End Sub Private Sub lblAddress_LostFocus() If lstNames.ListCount > 0 Then lstaddress.List(lstNumbers.ListIndex) = lblAddress.Text End If End Sub Private Sub lblComments_LostFocus() If lstNames.ListCount > 0 Then lstComments.List(lstNumbers.ListIndex) = lblComments.Text End If End Sub Private Sub lstNames_Click() 'On Error GoTo lstNamesErr lstNumbers.ListIndex = lstNames.ListIndex lstNumbers2.ListIndex = lstNames.ListIndex lstFax.ListIndex = lstNames.ListIndex lstMobile.ListIndex = lstNames.ListIndex lstEmail.ListIndex = lstNames.ListIndex lstWork.ListIndex = lstNames.ListIndex lstWorkNo.ListIndex = lstNames.ListIndex lstCoFax.ListIndex = lstNames.ListIndex lstWebSite.ListIndex = lstNames.ListIndex lstaddress.ListIndex = lstNames.ListIndex lstComments.ListIndex = lstNames.ListIndex lstState.ListIndex = lstNames.ListIndex lstCountry.ListIndex = lstNames.ListIndex lstPostCode.ListIndex = lstNames.ListIndex lblName.Text = lstNames.Text lblPhNo.Text = lstNumbers.Text lblPhNo2.Text = lstNumbers2.Text lblFax.Text = lstFax.Text lblMobile.Text = lstMobile.Text lblEmail.Text = lstEmail.Text lblWork.Text = lstWork.Text lblWorkNo.Text = lstWorkNo.Text lblCoFax.Text = lstCoFax.Text lblWebSite.Text = lstWebSite.Text lblAddress.Text = lstaddress.Text lblComments.Text = lstComments.Text lblState.Text = lstState.Text lblCountry.Text = lstCountry.Text lblPostCode.Text = lstPostCode.Text lblState.Text = UCase(lblState.Text) 'lstNamesErr: ' Exit Sub End Sub Private Sub NoEntries_Click() MsgBox "You Have: " & lstNames.ListCount & " Entries." End Sub Private Sub print_Click(Index As Integer) Call cmdPrint_Click End Sub Private Sub SaveData_Click(Index As Integer) If MsgBox("Are You Sure You Want to save?", vbQuestion + vbYesNo) = vbNo Then Exit Sub Call Save_It End Sub Private Sub sort_Click() Call Sort_it End Sub Private Sub Timer1_Timer() Form1.Caption = Right(Form1.Caption, 1) & _ Left(Form1.Caption, Len(Form1.Caption) - 1) End Sub Private Sub Timer2_Timer() Line (800, 800)-(800, 800 + a), Int(Rnd * 65000) Line (2000, 800)-(2000, 800 + a), Int(Rnd * 65000) Line (3000, 800)-(3000, 800 + a), Int(Rnd * 65000) Line (4000, 800)-(4000, 800 + a), Int(Rnd * 65000) Line (5000, 800)-(5000, 800 + a), Int(Rnd * 65000) Line (6000, 800)-(6000, 800 + a), Int(Rnd * 65000) Line (7000, 800)-(7000, 800 + a), Int(Rnd * 65000) Line (8000, 800)-(8000, 800 + a), Int(Rnd * 65000) Line (9000, 800)-(9000, 800 + a), Int(Rnd * 65000) Line (10000, 800)-(10000, 800 + a), Int(Rnd * 65000) Line (11000, 800)-(11000, 800 + a), Int(Rnd * 65000) Line (12000, 800)-(12000, 800 + a), Int(Rnd * 65000) Line (13000, 800)-(13000, 800 + a), Int(Rnd * 65000) Line (14000, 800)-(14000, 800 + a), Int(Rnd * 65000) Line (15000, 800)-(15000, 800 + a), Int(Rnd * 65000) Line (800, 800)-(800 + a, 800), Int(Rnd * 65000) Line (800, 2000)-(800 + a, 2000), Int(Rnd * 65000) Line (800, 3000)-(800 + a, 3000), Int(Rnd * 65000) Line (800, 4000)-(800 + a, 4000), Int(Rnd * 65000) Line (800, 5000)-(800 + a, 5000), Int(Rnd * 65000) Line (800, 6000)-(800 + a, 6000), Int(Rnd * 65000) Line (800, 7000)-(800 + a, 7000), Int(Rnd * 65000) Line (800, 8000)-(800 + a, 8000), Int(Rnd * 65000) Line (800, 9000)-(800 + a, 9000), Int(Rnd * 65000) Line (800, 10000)-(800 + a, 10000), Int(Rnd * 65000) Line (800, 11000)-(800 + a, 11000), Int(Rnd * 65000) a = a + 50 End Sub Private Sub txtSearch_Change() Dim MatchFound As Boolean Dim Last As Integer, J As Integer lblName.Text = "" lblPhNo.Text = "" lblPhNo2.Text = "" lblFax.Text = "" lblMobile.Text = "" lblEmail.Text = "" lblWork.Text = "" lblWorkNo.Text = "" lblCoFax.Text = "" lblWebSite.Text = "" lblAddress.Text = "" lblComments.Text = "" lblState.Text = "" lblPostCode.Text = "" lblCountry.Text = "" Last = lstNames.ListCount - 1 J = 0 MatchFound = False Do If InStr(1, lstNames.List(J), txtSearch.Text, 1) > 0 Then MatchFound = True lstNames.ListIndex = J End If J = J + 1 Loop Until J > Last Or MatchFound If Not MatchFound Then lstNames.ListIndex = -1 End If Call lstNames_Click End Sub 'YENİ BİLGİ GİRİŞİ İCİN Private Sub cmdAdd_Click() If txtName = "" Then MsgBox "giris de bir sorun cikti", vbExclamation, "telefon defteri" Else Form1.lstNames.AddItem txtName.Text Form1.lstNumbers.AddItem txtPhNo.Text Form1.lstNumbers2.AddItem txtPhNo2.Text Form1.lstFax.AddItem txtFax.Text Form1.lstMobile.AddItem txtMobile.Text Form1.lstEmail.AddItem txtEmail.Text Form1.lstWork.AddItem txtWork.Text Form1.lstWorkNo.AddItem txtWorkNo.Text Form1.lstCoFax.AddItem txtCoFax.Text Form1.lstWebSite.AddItem txtWebSite.Text Form1.lstaddress.AddItem txtAddress.Text Form1.lstComments.AddItem txtComments.Text Form1.lstState.AddItem txtState.Text Form1.lstPostCode.AddItem txtPostCode.Text Form1.lstCountry.AddItem txtCountry.Text txtName.Text = "" txtPhNo.Text = "" txtPhNo2.Text = "" txtFax.Text = "" txtMobile.Text = "" txtEmail.Text = "" txtWork.Text = "" txtWorkNo.Text = "" txtCoFax.Text = "" txtWebSite.Text = "" txtAddress.Text = "" txtComments.Text = "" txtState.Text = "" txtPostCode.Text = "" txtCountry.Text = "" Open "Numbers.dat" For Output As 1 For i = 0 To Form1.lstNames.ListCount - 1 Print #1, Form1.lstNames.List(i) Print #1, Form1.lstaddress.List(i) Print #1, Form1.lstSuburb.List(i) Print #1, Form1.lstState.List(i) Print #1, Form1.lstPostCode.List(i) Print #1, Form1.lstCountry.List(i) Print #1, Form1.lstNumbers.List(i) Print #1, Form1.lstNumbers2.List(i) Print #1, Form1.lstFax.List(i) Print #1, Form1.lstMobile.List(i) Print #1, Form1.lstWork.List(i) Print #1, Form1.lstWorkNo.List(i) Print #1, Form1.lstCoFax.List(i) Print #1, Form1.lstEmail.List(i) Print #1, Form1.lstWebSite.List(i) Print #1, Form1.lstComments.List(i) Next i Close #1 MsgBox "islem basarıyla tamamlandı", vbInformation, "telefon defteri" End If End Sub Private Sub Command1_Click() Form1.Show frmAddEntry.Hide End Sub Private Sub Timer1_Timer() frmAddEntry.Caption = Right(frmAddEntry.Caption, 1) & _ Left(frmAddEntry.Caption, Len(frmAddEntry.Caption) - 1) End Sub Private Sub txtName_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtAddress_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtSuburb_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtState_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtPostCode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtCountry_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtPhNo_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtPhNo2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtFax_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtMobile_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtWork_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtWorkNo_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtCoFax_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtEmail_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtWebSite_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtComments_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdAdd_Click End If End Sub Private Sub txtState_LostFocus() txtState.Text = UCase(txtState.Text) End Sub 'YARDIM MENUSU İCİN Private Sub Form_Load() On Error GoTo ErrorHandler Dim TempKeyword As String, TempText As String Open "help.dat" For Input As 1 On Error Resume Next Do Until EOF(1) Line Input #1, TempKeyword lstKeywords.AddItem TempKeyword Line Input #1, TempText lstText.AddItem TempText Loop Close #1 lstKeywords.ListIndex = -1 ErrorHandler: Select Case Err.Number Case 53 lblText.Caption = "Your Help File Could Not Be Found, Please Re-Install PhoneBook Or Locate The Help File On Your Computer and Make Sure That It Is Named 'help.dat' and is in the same folder as PhoneBook.exe." End Select End Sub Private Sub lstKeywords_Click() If lstKeywords.ListIndex > -1 Then lstText.ListIndex = lstKeywords.ListIndex lblText.Caption = lstText.Text End If End Sub Private Sub txtSearch_Change() Dim MatchFound As Boolean Dim Last As Integer, J As Integer lblText.Caption = "" Last = lstKeywords.ListCount - 1 J = 0 MatchFound = False Do If InStr(1, lstKeywords.List(J), txtSearch.Text, 1) > 0 Then MatchFound = True lstKeywords.ListIndex = J End If J = J + 1 Loop Until J > Last Or MatchFound If Not MatchFound Then lstKeywords.ListIndex = -1 End If Call lstKeywords_Click End Sub 'SPLASH SCREN İCİN Option Explicit Private Sub Form_KeyPress(KeyAscii As Integer) Unload Me End Sub Private Sub Form_Load() lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision lblProductName.Caption = App.Title End Sub Private Sub Frame1_Click() Unload Me Form1.Show End Sub


'splash screen eklemek icin =prject - add form - splash screen kullanılır
__________________