Visual Basic 6.0'da hazırlanmış Namaz Vakitleri.

1 2 3 4
23/09/2009, 03:04

ozanakkaya

Paylaşım için teşekkürler maytas.
29/09/2009, 20:18

maytas

(23/09/2009, 02:46)skat yazdı: Teşekkürler .Proje olarak ekleyebilirmisiniz

Yeni HDD aldığım için son bir hafta Windows ve diğer programları bilgisayarıma kurmakla meşguldüm, o yüzden bu isteğe hemen cevap veremedim.
İşte kodlar:

Kod:
Dim Web As Object

Private Sub Combo1_Click()
    ListView1.ListItems.Clear
    Label4.Caption = ""
    Label5.Caption = ""
End Sub

Private Sub Command1_Click()
    Dim Litem As ListItem
    Dim Satir As Integer, Ay As Integer, Sutun As Integer
    On Error GoTo Hata
    If Combo1.Text = Empty Then Exit Sub
    Command1.Enabled = False
    Combo1.Locked = True
    If Not Web Is Nothing Then
        Set Web = CreateObject("InternetExplorer.application")
        Web.Navigate "http://www.diyanet.gov.tr/turkish/namazvakti/vakithes_namazvakti.asp"
        Do While Web.Busy: DoEvents: Loop
        Do While Web.ReadyState <> 4: DoEvents: Loop
    End If
    Screen.MousePointer = vbHourglass
    Web.Document.getElementById("sehirler").Value = Degistir(Combo1.Text)
    Web.Document.getElementById("R1").Value = "AYLIK"
    Web.Document.getElementById("Buton").Click
    Do While Web.Busy: DoEvents: Loop
    Do While Web.ReadyState <> 4: DoEvents: Loop
    With ListView1
        .ColumnHeaders.Clear
        .ListItems.Clear
        .HideColumnHeaders = False
        .View = lvwReport
        .GridLines = True
        .ColumnHeaders.Add , , "Tarih", .Width / 6
        .ColumnHeaders.Add , , "Haft. Günü", .Width / 6
        .ColumnHeaders.Add , , "İmsak", .Width / 9
        .ColumnHeaders.Add , , "Güneş", .Width / 9
        .ColumnHeaders.Add , , "Öğle", .Width / 9
        .ColumnHeaders.Add , , "İkindi", .Width / 9
        .ColumnHeaders.Add , , "Akşam", .Width / 9
        .ColumnHeaders.Add , , "Yatsı", .Width / 9
    '    .ColumnHeaders.Add , , "Kıble Saati", .Width * 7 / 45
    End With
    Do While Web.Busy: DoEvents: Loop
    Do While Web.ReadyState <> 4: DoEvents: Loop
        For Ay = 1 To 31
            Set Litem = ListView1.ListItems.Add
            Litem.Text = Trim(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(0).innertext)
            Litem.SubItems(1) = Format(Trim(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(0).innertext), "dddd")
            For Sutun = 1 To 6
                Litem.SubItems(Sutun + 1) = Replace(Trim(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(Sutun).innertext), " ", ":")
            Next
            If CDate(Trim(Web.Document.All.tags("table").Item(1).Rows(Ay).Cells(0).innertext)) = Date Then
                Litem.Bold = True
                Litem.ForeColor = &H800000
            For Sutun = 1 To 7
                ListView1.ListItems(Ay).ListSubItems(Sutun).Bold = True
                ListView1.ListItems(Ay).ListSubItems(Sutun).ForeColor = &H800000
            Next
            End If
        Next
    Web.Quit
    Screen.MousePointer = vbNormal
    Command1.Enabled = True
    Combo1.Locked = False
    Exit Sub
Hata:
    On Error Resume Next
    Screen.MousePointer = vbNormal
    Command1.Enabled = True
    Combo1.Locked = False
    Web.Quit
End Sub


Private Sub Form_Load()
    Screen.MousePointer = vbHourglass
    Combo1.AddItem "ADANA"
    Combo1.AddItem "ADIYAMAN"
    Combo1.AddItem "AFYON"
    Combo1.AddItem "AĞRI"
    Combo1.AddItem "AKSARAY"
    Combo1.AddItem "AMASYA"
    Combo1.AddItem "ANKARA"
    Combo1.AddItem "ANTALYA"
    Combo1.AddItem "ARDAHAN"
    Combo1.AddItem "ARTVİN"
    Combo1.AddItem "AYDIN"
    Combo1.AddItem "BALIKESİR"
    Combo1.AddItem "BARTIN"
    Combo1.AddItem "BATMAN"
    Combo1.AddItem "BAYBURT"
    Combo1.AddItem "BİLECİK"
    Combo1.AddItem "BİNGÖL"
    Combo1.AddItem "BİTLİS"
    Combo1.AddItem "BOLU"
    Combo1.AddItem "BURDUR"
    Combo1.AddItem "BURSA"
    Combo1.AddItem "ÇANAKKALE"
    Combo1.AddItem "ÇANKIRI"
    Combo1.AddItem "ÇORUM"
    Combo1.AddItem "DENİZLİ"
    Combo1.AddItem "DİYARBAKIR"
    Combo1.AddItem "DÜZCE"
    Combo1.AddItem "EDİRNE"
    Combo1.AddItem "ELAZIĞ"
    Combo1.AddItem "ERZİNCAN"
    Combo1.AddItem "ERZURUM"
    Combo1.AddItem "ESKİŞEHİR"
    Combo1.AddItem "GAZİANTEP"
    Combo1.AddItem "GİRESUN"
    Combo1.AddItem "GÜMÜŞHANE"
    Combo1.AddItem "HAKKARİ"
    Combo1.AddItem "HATAY"
    Combo1.AddItem "IĞDIR"
    Combo1.AddItem "ISPARTA"
    Combo1.AddItem "İSTANBUL"
    Combo1.AddItem "İZMİR"
    Combo1.AddItem "KAHRAMANMARAŞ"
    Combo1.AddItem "KARABÜK"
    Combo1.AddItem "KARAMAN"
    Combo1.AddItem "KARS"
    Combo1.AddItem "KASTAMONU"
    Combo1.AddItem "KAYSERİ"
    Combo1.AddItem "KIRIKKALE"
    Combo1.AddItem "KIRKLARELİ"
    Combo1.AddItem "KIRŞEHİR"
    Combo1.AddItem "KİLİS"
    Combo1.AddItem "KOCAELİ"
    Combo1.AddItem "KONYA"
    Combo1.AddItem "KÜTAHYA"
    Combo1.AddItem "MALATYA"
    Combo1.AddItem "MANİSA"
    Combo1.AddItem "MARDİN"
    Combo1.AddItem "MERSİN"
    Combo1.AddItem "MUĞLA"
    Combo1.AddItem "MUŞ"
    Combo1.AddItem "NEVŞEHİR"
    Combo1.AddItem "NİĞDE"
    Combo1.AddItem "ORDU"
    Combo1.AddItem "OSMANİYE"
    Combo1.AddItem "RİZE"
    Combo1.AddItem "SAKARYA"
    Combo1.AddItem "SAMSUN"
    Combo1.AddItem "SİİRT"
    Combo1.AddItem "SİNOP"
    Combo1.AddItem "SİVAS"
    Combo1.AddItem "Ş.URFA"
    Combo1.AddItem "ŞIRNAK"
    Combo1.AddItem "TEKİRDAĞ"
    Combo1.AddItem "TOKAT"
    Combo1.AddItem "TRABZON"
    Combo1.AddItem "TUNCELİ"
    Combo1.AddItem "UŞAK"
    Combo1.AddItem "VAN"
    Combo1.AddItem "YALOVA"
    Combo1.AddItem "YOZGAT"
    Combo1.AddItem "ZONGULDAK"
    Combo1.Text = "BURSA"
    Set Web = CreateObject("InternetExplorer.application")
    Web.Navigate "http://www.diyanet.gov.tr/turkish/namazvakti/vakithes_namazvakti.asp"
    Screen.MousePointer = vbNormal
End Sub


Private Sub Timer1_Timer()
    Dim Say As Byte, Tarih As Date, Saat As Date, Saat_Seri_No As Double, Vakit As Double, Sahur As Double
    On Error Resume Next
    If Format(Now, "hh:mm:ss") = "00:00:00" Then Call Command1_Click
    Label3.Caption = Format(Now, "dddd dd.mm.yyyy hh:mm:ss")
    If ListView1.ListItems.Count > 0 Then
        For Say = 1 To ListView1.ListItems.Count
            Tarih = ListView1.ListItems(Say)
            Saat = Format(Now, "hh:mm:ss")
            Saat_Seri_No = CDbl(Tarih) + CDbl(TimeSerial(Hour(Saat), Minute(Saat), Second(Saat)))
            If Tarih = Date Then
                For Sutun = 2 To 7
                    Vakit = CDbl(Tarih) + CDbl(CDate(ListView1.ListItems(Say).SubItems(Sutun)))
                    If Saat_Seri_No < Vakit Then
                        Label5.Caption = "İmsak'a kalan süre:"
                        Label4.Caption = Format(Vakit - CDbl(Now), "hh:mm:ss")
                        For i = 2 To 7
                            If ListView1.ListItems(Say).ListSubItems(i).ForeColor <> &H800000 Then
                                ListView1.ListItems(Say).ListSubItems(i).ForeColor = &H800000
                                ListView1.ListItems(Say).ListSubItems(i).Bold = True
                                ListView1.Refresh
                            End If
                        Next i
                        GoTo Bitir
                    Else:
                        If Sutun = 7 Then
                            Vakit1 = CDbl(Tarih + 1) + CDbl(CDate(ListView1.ListItems(Say + 1).SubItems(2)))
                        Else: Vakit1 = CDbl(Tarih) + CDbl(CDate(ListView1.ListItems(Say).SubItems(Sutun + 1)))
                        End If
                        If Saat_Seri_No >= Vakit And Saat_Seri_No < Vakit1 Then
                            If Sutun = 7 Then
                                Label5.Caption = "İmsak'a kalan süre:"
                                Label4.Caption = Format(Vakit1 - CDbl(Now), "hh:mm:ss")
                            Else
                                Label5.Caption = Ekle(ListView1.ColumnHeaders(Sutun + 2)) & " kalan süre:"
                                Label4.Caption = Format(Vakit1 - CDbl(Now), "hh:mm:ss")
                            End If
                            Satir = 1
                            Do
                                Satir = Satir + 1
                                If Satir < Sutun Then
                                    If ListView1.ListItems(Say).ListSubItems(Satir).ForeColor <> &HFF8080 Then
                                        ListView1.ListItems(Say).ListSubItems(Satir).ForeColor = &HFF8080
                                        ListView1.ListItems(Say).ListSubItems(Satir).Bold = False
                                        ListView1.Refresh
                                    End If
                                Else:
                                    If Satir = Sutun Then
                                        If ListView1.ListItems(Say).ListSubItems(Sutun).ForeColor <> vbRed Then ListView1.ListItems(Say).ListSubItems(Sutun).ForeColor = vbRed: ListView1.Refresh
                                    Else
                                        If ListView1.ListItems(Say).ListSubItems(Satir).ForeColor <> &H800000 Then
                                            ListView1.ListItems(Say).ListSubItems(Satir).ForeColor = &H800000
                                            ListView1.ListItems(Say).ListSubItems(Satir).Bold = True
                                            ListView1.Refresh
                                        End If
                                    End If
                                End If
                            Loop Until Satir = 7
                          
                           Vakit1 = CDbl(Tarih) + CDbl(CDate(ListView1.ListItems(Say).SubItems(7)))
                           GoTo Bitir
                        End If
                    End If
                Next Sutun
            End If
        Next
    End If
Bitir:
If Not (ListView1.SelectedItem Is Nothing) Then ListView1.SelectedItem.Selected = False
End Sub

Private Function Degistir(Kelime As String)
    Dim DiziA, DiziB
    Dim i As Integer
    DiziA = Array("Ğ", "Ü", "Ş", "Ç", "Ö", "İ", "ğ", "ü", "ş", "ç", "ö", "ı")
    DiziB = Array("G", "U", "S", "C", "O", "I", "g", "u", "s", "c", "o", "i")
    For i = 0 To UBound(DiziA)
    If InStr(Kelime, DiziA(i)) > 0 Then
        Kelime = Replace(Kelime, DiziA(i), DiziB(i))
    End If
    Next
    Degistir = Kelime
End Function

Private Function Ekle(Kelime As String)
    If Kelime = "İmsak" Then
        Ekle = "İmsak'a"
    ElseIf Kelime = "Güneş" Then
        Ekle = "Güneş'e"
    ElseIf Kelime = "Öğle" Then
        Ekle = "Öğle'ye"
    ElseIf Kelime = "İkindi" Then
        Ekle = "İkindi'ye"
    ElseIf Kelime = "Akşam" Then
        Ekle = "Akşam'a"
    ElseIf Kelime = "Yatsı" Then
        Ekle = "Yatsı'ya"
    End If
End Function
29/09/2009, 20:40

malidolu

teşekkürler arkadaş Allah razı olsun
Kolay gelsin
12/01/2010, 02:20

skat

Sayın maytas
İlginize çok teşekkür ederim
17/03/2010, 12:03

Yakut

tesekkürler

bunu baska ülkenin takvimine yapmak istersek hangi kodu degistirmemiz lazim....


saygilar
15/04/2010, 22:07

emrevzr

çok güzel yapmışsın bunun kodları sende varsa bana yollarmısın ?(cevab bekliyorum)
1 2 3 4