Alarmli Konusan Saat programi
Program herzaman üstte(always on top),ses dosyalarinin sirayla çalinmasi, sag tik menüsü özellikleri içeriyor.
'Module1 in kodlari ----------------------------
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public alarm As Boolean
Public saatbasi As Boolean
Public alarmsaati As String
Public alarmdakikasi As String
'Ses dosyalari
'Programin bulundugu dizinin altinda "Sesler"
'adinda bir dizin olmali
'Sesler dizininin altindaki dosyalar :
'Dosya adi: Içerigi :
'---------- --------
'00.wav --- "SIFIR"
'10.wav --- "ON"
'20.wav --- "YIRMI"
'30.wav --- "OTUZ"
'40.wav --- "KIRK"
'50.wav --- "ELLI"
'Alarm.wav - Alarm zil sesi
'Bosluk.wav - Çok kisa bir bosluk
'Saat.wav - "SAAT"
'saat01.wav - "BIR"
'saat02.wav - "IKI"
'saat03.wav - "ÜÇ"
'saat04.wav - "DÖRT"
'saat05.wav - "BES"
'saat06.wav - "ALTI"
'saat07.wav - "YEDI"
'saat08.wav - "SEKIZ"
'saat09.wav - "DOKUZ"
'saat10.wav - "ON"
'saat11.wav - "ONBIR"
'saat12.wav - "ONIKI"
'-----------------------------------------------
'Form1 : Ana form
'Form1 in nesneleri:
'Label1 : Saatin yazilacagi etiket
'Label2 : am. pm. yazacak olan etiket
'MMControl1 : Ses dosyalarini çalmak için
'Microsoft multimedia control
'MCI32.OCX dosyasi
'Timer1 :
'Enabled = True
'Interval = 500
'Timer2 :
'Enabled = False
'Interval = 10
'Timer3 :
'Enabled = False
'Interval = 1000
'Form1 in kodlari ------------------------------
Dim yol(3) As String
Dim arttir As Byte
Dim yer As String
Dim alarmsesi As String
Dim bosluk As String
Dim alarmçaldi As Boolean
Dim alarm1 As Boolean
Dim alarmsusturuldu As Boolean
Dim saatisoyledi As Boolean
Dim kayit As String
Private Sub Form_Load()
yer = App.Path + "\sesler\"
alarmsesi = yer + "Alarm.wav"
bosluk = yer + "Bosluk.wav"
SetWindowPos hwnd, -1, 0, 0, 0, 0, &H1 Or &H2
If GetSetting("Konusansaat", "Ayarlar", "Devrede") = "1" Then alarm = "1" Else alarm = "0"
If GetSetting("Konusansaat", "Ayarlar", "Hsb") = "1" Then saatbasi = "1" Else saatbasi = "0"
alarmsaati = GetSetting("Konusansaat", "Ayarlar", "Saat")
alarmdakikasi = GetSetting("Konusansaat", "Ayarlar", "Dakika")
alarm1 = "1"
alarmsusturuldu = "0"
saatisoyledi = "0"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Label1_DblClick()
saatioku
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
Call form2.PopupMenu(form2.Saat)
End If
End Sub
Private Sub Timer1_Timer()
Dim fark As Integer
If Val(Left(Time, 2)) > 12 Then
fark = Val(Left(Time, 2)) - 12
Label2 = "pm."
If fark < 10 Then
Label1 = "0" + Right(Str(fark), 1) + Right(Time, 6)
Else
Label1 = Right(Str(fark), 2) + Right(Time, 6)
End If
Else
If Left(Time, 2) = "00" Then Label1 = "12" + Right(Time, 6) Else Label1 = Time
Label2 = "am."
End If
If alarm = "1" And alarm1 = "1" Then alarmkontrol
If saatbasi = "1" Then saatbasikontrol
End Sub
Private Sub Timer2_Timer()
If MMControl1.Mode = 526 Then Exit Sub
arttir = arttir + 1
If arttir = 4 Then Timer2.Enabled = "0": MMControl1.Command = "close": Exit Sub
MMControl1.Command = "close"
MMControl1.FileName = yol(arttir)
MMControl1.Command = "open"
MMControl1.Command = "play"
End Sub
Public Sub saatioku()
If alarm1 = "0" And alarmsusturuldu = "0" Then
MMControl1.Command = "stop"
MMControl1.Command = "close"
alarmsusturuldu = "1"
Exit Sub
End If
If MMControl1.Mode = 526 Then Exit Sub
yol(0) = yer + "saat.wav"
yol(1) = yer + "saat" & Left(Label1, 2) & ".wav"
yol(2) = yer + Mid(Label1, 4, 1) & "0.wav"
If Mid(Label1, 4, 2) = "00" Then yol(2) = bosluk
yol(3) = yer + "saat0" & Mid(Label1, 5, 1) & ".wav"
arttir = 0
MMControl1.Command = "close"
MMControl1.FileName = yol(0)
MMControl1.Command = "open"
MMControl1.Command = "play"
Timer2.Enabled = "1"
End Sub
Public Sub alarmkontrol()
If Left(Label1, 2) = alarmsaati And Mid(Label1, 4, 2) = alarmdakikasi Then
If MMControl1.Mode = 526 Or alarm1 = "0" Then Exit Sub
MMControl1.Command = "close"
MMControl1.FileName = alarmsesi
MMControl1.Command = "open"
MMControl1.Command = "play"
alarm1 = "0"
saatbasi = "0"
kayit = Left(Time, 5)
Timer3.Enabled = "1"
End If
End Sub
Private Sub Timer3_Timer()
If kayit <> Left(Time, 5) Then
alarm1 = "1"
alarmsusturuldu = "0"
If GetSetting("Konusansaat", "Ayarlar", "Hsb") = "1" Then saatbasi = "1" Else saatbasi = "0"
Timer3.Enabled = "0"
End If
End Sub
Public Sub saatbasikontrol()
If Mid(Label1, 4, 2) = "00" And saatisoyledi = "0" Then
saatioku
saatisoyledi = "1"
End If
If Mid(Label1, 4, 2) <> "00" Then saatisoyledi = "0"
End Sub
'-----------------------------------------------
'Form2 : Sag tik menüsü
'Form2 nin nesneleri:
'Menü
'Caption = Saat
'Name = Saat
'Alt menü :
'1 : Caption = Ayarlar
' Name = ayarlar
'2 : Caption = Konus
' Name = konus
'3 : Caption = Çikis
' Name = cikis
'Form2 nin kodlari -----------------------------
Private Sub ayarlar_Click()
Form3.Show
End Sub
Private Sub konus_Click()
Form1.saatioku
End Sub
Private Sub cikis_Click()
End
End Sub
'-----------------------------------------------
'Form3 : Alarm ayarlarinin yapildigi form
'Form3 ün nesneleri :
'Command1(0) : Tamam
'Command1(1) : Iptal
'Command1(2) : Uygula
'Command2(0) : Alarm saatini 1 arttirmak için
'Caption = +1
'Command2(1) : Alarm saatini 1 eksiltmek için
'Caption = -1
'Command3(0) : Alarm dakikasini 10 arttirmak için
'Caption = +10
'Command3(1) : Alarm dakikasini 10 eksiltmek için
'Caption = -10
'Command3(2) : Alarm dakikasini 1 arttirmak için
'Caption = +1
'Command3(3) : Alarm dakikasini 1 eksiltmek için
'Caption = -1
'Label1(0) : Sadece Yazi
'Caption = Saat
'Label1(1) : Sadece Yazi
'Caption = Dakika
'Label2 : Alarm saatinin yazilacagi etiket
'Label3 : Alarm dakikasinin yazilacagi etiket
'Option1 : am.
'Option2 : pm.
'Check1 : Alarm devrede
'Check2 : Her saat basi otomatik konus
'Form3 ün kodlari ------------------------------
Dim Saat As Integer
Dim dakika As Integer
Private Sub Command1_Click(Index As Integer)
If Index = 0 Then uygula: Unload Me
If Index = 1 Then Unload Me
If Index = 2 Then uygula
End Sub
Private Sub Command2_Click(Index As Integer)
Select Case Index
Case 0
Saat = Saat + 1
If Saat > 12 Then Saat = 12
If Saat < 10 Then
Label2 = "0" + Right(Str(Saat), 1)
Else
Label2 = Right(Str(Saat), 2)
End If
Case 1
Saat = Saat - 1
If Saat < 1 Then Saat = 1
If Saat < 10 Then
Label2 = "0" + Right(Str(Saat), 1)
Else
Label2 = Right(Str(Saat), 2)
End If
End Select
End Sub
Private Sub Command3_Click(Index As Integer)
Select Case Index
Case 0
dakika = dakika + 10
If dakika > 59 Then dakika = 59
If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If
Case 1
dakika = dakika - 10
If dakika < 0 Then dakika = 0
If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If
Case 2
dakika = dakika + 1
If dakika > 59 Then dakika = 59
If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If
Case 3
dakika = dakika - 1
If dakika < 0 Then dakika = 0
If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If
End Select
End Sub
Private Sub Form_Load()
On Error Resume Next
If GetSetting("Konusansaat", "Ayarlar", "am-pm") = "0" Then Option1.Value = "1": Option2.Value = "0" Else Option1.Value = "0": Option2.Value = "1"
If GetSetting("Konusansaat", "Ayarlar", "Devrede") = "1" Then Check1.Value = 1 Else Check1.Value = 0
If GetSetting("Konusansaat", "Ayarlar", "Hsb") = "1" Then Check2.Value = 1 Else Check2.Value = 0
Label2.Caption = GetSetting("Konusansaat", "Ayarlar", "Saat")
Label3.Caption = GetSetting("Konusansaat", "Ayarlar", "Dakika")
Saat = Val(GetSetting("Konusansaat", "Ayarlar", "Saat"))
dakika = Val(GetSetting("Konusansaat", "Ayarlar", "Dakika"))
End Sub
Public Sub uygula()
If Option1.Value = "1" Then SaveSetting "Konusansaat", "Ayarlar", "am-pm", "0" Else SaveSetting "Konusansaat", "Ayarlar", "am-pm", "1"
If Check1.Value = 1 Then
SaveSetting "Konusansaat", "Ayarlar", "Devrede", "1"
alarm = "1"
alarmsaati = Label2.Caption
alarmdakikasi = Label3.Caption
Else
SaveSetting "Konusansaat", "Ayarlar", "Devrede", "0"
alarm = "0"
End If
If Check2.Value = 1 Then SaveSetting "Konusansaat", "Ayarlar", "Hsb", "1": saatbasi = "1" Else SaveSetting "Konusansaat", "Ayarlar", "Hsb", "0":: saatbasi = "0"
SaveSetting "Konusansaat", "Ayarlar", "Saat", Label2.Caption
SaveSetting "Konusansaat", "Ayarlar", "Dakika", Label3.Caption
End Sub
