TurkProgrammers.NeT
Ana sayfa Ana Sayfa | Ana sayfanız yapın | Sık kullanılanlara ekle | Rss/Rdf Besleme| JavaScript
Bölümler
Arşiv
paz sa ça cu cum pa
1234
567891011
12131415161718
19202122232425
262728293031

Mailinizi ekleyin
Haberlere abone olun:

anket: Web Programcılığının Geleceğini nasıl görüyorsunuz
Web Programcılığının Geleceğini nasıl görüyorsunuz?
Önü Fazlası ile açık
ilerde yapacak web sitesi kalmayacak
Hazır sistemler işleri iyice bitirecek
Bugünden daha kötü olamaz
Anket sonuçları | Eski Anketler


email Arkadaşınızın maili | print Yazıcı versionu | comment Yanıtlar (0 Gönder)

telefon defteri

by caner kuru on Ağustos 08,2008

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

' DAHA SONRA BUNLARA BU KODLAR EKLENİR

' FORM1.NAME=ana ekran
' form2.name=frmAddEntry
'form3.name=Frmhelp
'olarak ayarlanır ve başlanır


'ANA EKRAN İÇİ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 "ilçesi: ", ,
    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 "ülkesi: ", ,
    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 "Açiklma: ", ,
    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İŞİ İÇİN

Private Sub cmdAdd_Click()
    If txtName = "" Then
        MsgBox "giris de bir sorun çikti", 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 MENÜSÜ İÇİ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 İÇİ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 için =prject - add form - splash screen kullanılır

76 Kere okundu

Bu makaleyi beyendinizmi ?

1 2 3 4 5 Rating: 5.00Rating: 5.00Rating: 5.00Rating: 5.00Rating: 5.00 (Toplam 1 Oylar)
comment Yanıtlar (0 Gönder)
Çok okunanlar
En Çok Yorumlananlar
Yazarlar