VB6: Source Code Bell Otomatis

Sejak di upload pada tanggal 29 Oktober 2009 melalui artikel Bell Otomatis Untuk Sekolah (Gratis) , Alhamdulilah 1.139 kompasianer yang mendownloadnya, baik meminta ijin terlebih dahulu ataupun langsung comot, artinya paling sedikit ada 1139 sekolah di negeri ini yang menggunakan Software ini.

Secara pribadi saya sangat merasa senang dan bangga karena hasil karya bisa dimanfaatkan oleh sekolah, semoga software ini dapat sedikit membantu pekerjaan TU di sekolah yang kadang telat untuk memukul lonceng pergantian jam pelajaran, sehingga bisa terpokus pada pekerjaan lain yang tentunya lebih penting dari memukul lonceng. Antusias dari dari pengguna Bell Otomatis ini cukup besar terbukti dengan permintaan untuk menyempurnakan bel otomatos ini hingga mencapai update yang ke -3, dan ada juga beberapa Kompasianer yang meminta source code nya untuk dipelajari atau untuk dikembangkan dan meminta untuk mengirimnya ke E-mailnya, saya pribadi tidak keberatan untuk membagi Source codenya, tapi dengan catatan bukan hanya mengganti nama programmer dengan namanya sendiri dan mengakui software ini hasil karyanya. Software Bell otomatis ini tidak menggunakan VB-6 Standar, tetapi menggunakan beberapa Active-X diluar VB-6 diantaranya Perfect Text (PT) yang saya buat sendiri bisa di baca dan dowonload disini, dan Code Jocke, yang tidak bisa saya berikan softwarenya karena program ini berbayar sehingga tidak etis bila saya berikan bajakannya, Active X yang berasal dari Code Jocke yaitu Pushbutton yang bisa diganti dengan Commandbutton, dan Message yang saya berinama Pesan yang bisa diganti dengan Message Box biasa bawaan dari VB6 itu sendiri, Jadi walaupun tidak mempunyai Code Jocke, bukan menjadi halangan untuk mempelajarinya atau mengembangkannya. Pertama pasang Active-X/Object pada Form dengan Properties sebagai berikut : Picture1 Height = 1215 Left = 0 Top = 0 Width = 9795 Label2 Left = 6120 Top = 900 Width = 60

Image2

Height = 1320 Left = 60 Top = -120 Width = 9105

RadioButton1

Height = 195 Index = 0 Left = 8400 Top = 5640 Width = 1155 Caption = "Normal"

Timer3

Interval = 100 Left = 4320 Top = 2880

PushButton10

Height = 315 Left = 4020 Top = 5700 Width = 855 Caption = "Set" Appearance = 6

Combo3

Height = 315 Left = 3120 Style = 2 'Dropdown List Top = 5700 Width = 675

Combo2

Height = 315 Left = 2160 Style = 2 'Dropdown List TabIndex = 25 Top = 5700 Width = 675

Text3

Height = 315 Left = 4320 TabIndex = 20 Text = "Text3" Top = 1140 Visible = 0 'False Width = 1635

Slider1

Height = 255 Left = 60 Top = 5580 Visible = 0 'False Width = 1575

Timer2

Enabled = 0 'False Interval = 1000 Left = 720 Top = 120

Timer1

Interval = 1000 Left = 4920 Top = 4620

SysInfo

Name = Info Left = 4380 Top = 2640 PushButton2 Height = 375 Left = 1200 Top = 5220 Width = 1080 Caption = "Ubah" Enabled = 0 'False

Text2

Height = 375 Left = -420 Text = "Text1" Top = 5880 Visible = 0 'False Width = 1335

Text1

Height = 375 Left = 3180 Text = "Text1" Top = 4800 Visible = 0 'False Width = 1335

PushButton1

Height = 375 Left = 120 Top = 5220 Width = 1080 Caption = "Tambah"

ListView1

Height = 2655 Left = 60 Top = 2580 Width = 6495 LabelWrap = -1 'True HideSelection = -1 'True FullRowSelect = -1 'True GridLines = -1 'True

File1

Height = 3990 Left = 6600 Pattern = "*.wav" TabIndex = 0 Top = 1260 Width = 3195

MaskEdBox

Name = ME1 Height = 315 Left = 960 Top = 1920 Width = 615 Enabled = 0 'False MaxLength = 5 Mask = "##:##" PromptChar = "_" PT1 Height = 315 Left = 960 Top = 1620 Width = 5535

PT2

Height = 315 Left = 960 Top = 2220 Width = 5475

Combo1

Height = 315 Left = 960 Top = 1320 Width = 1335 Locked = -1 'True Style = 2 UseVisualStyle = 0 'False Text = "ComboBox1"

PushButton3

Height = 375 Left = 3360 Top = 5220 Width = 1080 Caption = "Hapus" Enabled = 0 'False

PushButton4

Height = 375 Left = 4440 Top = 5220 Width = 1080 Caption = "Parkir"

PushButton5

Height = 375 Left = 5520 Top = 5220 Width = 1082 Caption = "Keluar"

PushButton6

Height = 375 Left = 7200 Top = 5220 Width = 2055 Caption = "Tes Suara" Appearance = 6

PushButton7

Height = 375 Left = 2280 Top = 5220 Width = 1080 Caption = "Batal" Enabled = 0 'False

PushButton8

Height = 375 Left = 6600 Top = 5220 Width = 615 Caption = "A" Appearance = 6

PushButton9

Height = 375 Left = 9240 Top = 5220 Width = 615 Caption = "B" Appearance = 6

RadioButton1

Height = 195 Left = 8400 Top = 5940 Width = 1155 Caption = "Khusus"

Label1

AutoSize = -1 'True Caption = "Auto Shut Down" Weight = 700 Underline = 0 'False Height = 195 Index = 4 Left = 720 Top = 5760 Width = 1395

Label6

AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Auto Shut Down Tidak Aktip" Height = 195 Left = 5100 TabIndex = 30 Top = 5760 Width = 2490

Label5

Caption = "X" Height = 315 Left = -60 Top = 5460 Visible = 0 'False

Label4

AutoSize = -1 'True BackStyle = 0 'Transparent Caption = ":" BeginProperty Font Height = 345 Left = 2940 TabIndex = 27 Top = 5685 Width = 75

Label3

Caption = "Label3" Height = 315 Left = 120 Top = 5280 Visible = 0 'False Width = 1035

TaskDialog

Left = 5040 Top = 1200

TrayIcon1

Left = 3900 Top = 1080 Text = "Bell Otomatis"

Label1(0)

AutoSize = -1 'True Caption = "Suara" Height = 195 Left = 300 Top = 2280 Width = 420

Label1(1)

AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Jam" Height = 195 Left = 300 Top = 1980 Width = 285

Label1(2)

AutoSize = -1 'True Caption = "Uraian" Height = 195 Left = 300 Top = 1680 Width = 465

Label1(3)

AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Hari" Height = 195 Index = 0 Left = 300 Top = 1380 Width = 285 Buat Modul dan tulis kodenya seperti berikut

Private Type LUID

UsedPart As Long IgnoredForNowHigh32BitPart As Long End Type

Private Type TOKEN_PRIVILEGES

PrivilegeCount As Long TheLuid As LUID Attributes As Long End Type

Private Const EWX_SHUTDOWN As Long = 1

Private Const EWX_FORCE As Long = 4 Private Const EWX_REBOOT = 2

Private Declare Function ExitWindowsEx Lib "user32" (ByVal _

dwOptions As Long, ByVal dwReserved As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function OpenProcessToken Lib "advapi32" (ByVal _ ProcessHandle As Long, _ ByVal DesiredAccess As Long, TokenHandle As Long) As Long Private Declare Function LookupPrivilegeValue Lib "advapi32" _ Alias "LookupPrivilegeValueA" _ (ByVal lpSystemName As String, ByVal lpName As String, lpLuid _ As LUID) As Long Private Declare Function AdjustTokenPrivileges Lib "advapi32" _ (ByVal TokenHandle As Long, _ ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES _ , ByVal BufferLength As Long, _ PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long Private Sub AdjustToken() Const TOKEN_ADJUST_PRIVILEGES = &H20 Const TOKEN_QUERY = &H8 Const SE_PRIVILEGE_ENABLED = &H2 Dim hdlProcessHandle As Long Dim hdlTokenHandle As Long Dim tmpLuid As LUID Dim tkp As TOKEN_PRIVILEGES Dim tkpNewButIgnored As TOKEN_PRIVILEGES Dim lBufferNeeded As Long

hdlProcessHandle = GetCurrentProcess()

OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _ TOKEN_QUERY), hdlTokenHandle

' Get the LUID for shutdown privilege.

LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

tkp.PrivilegeCount = 1 ' One privilege to set

tkp.TheLuid = tmpLuid tkp.Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this process.

AdjustTokenPrivileges hdlTokenHandle, False, _ tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded

End Sub

Public Sub ShutDown() AdjustToken ExitWindowsEx (EWX_SHUTDOWN), &HFFFF End Sub

Public Sub ReStart()

AdjustToken ExitWindowsEx (EWX_FORCE), &HFFFF

End Sub

Public Sub ReBooT() AdjustToken ExitWindowsEx (EWX_REBOOT), &HFFFF End Sub Source Code Bell Otomatis Update Ke-3

Dim db As Connection

Dim Con1, Con2 As Recordset Dim List As Variant Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long Dim wHandler As Long Dim fShortName As String, TrackLength As String * 60 Dim a As Integer, cou As Integer Dim tt As Boolean Option Explicit

Public Function GetShortName(ByVal sLongFileName As String) As String

Dim lRetVal As Long Dim sShortPathName As String Dim iLen As Integer 'Set up buffer area for API function cal ' l return sShortPathName = Space(255) iLen = Len(sShortPathName) 'Call the function lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen) 'Strip away unwanted characters. GetShortName = Left(sShortPathName, lRetVal) End Function

Sub Pesan()

TaskDialog.Reset TaskDialog.CommonButtons = 0 TaskDialog.WindowTitle = "Informasi" TaskDialog.MainIcon = xtpTaskIconInformation TaskDialog.MessageBoxStyle = True TaskDialog.EnableCommandLinks = True TaskDialog.FooterText = "Programmer Wawan Supriadi" & Chr(13) & "Wulansoft° Soft Computindo" & Chr(13) & "Tahun 2010" TaskDialog.FooterIcon = xtpTaskIconShield

End Sub

Sub Buka()

Combo1.Locked = False PT1.Locked = False PT2.Locked = False ME1.Enabled = True

End Sub

Sub Tutup() Combo1.Locked = True PT1.Locked = True PT2.Locked = True ME1.Enabled = False

End Sub

Sub Bersih()

Combo1.Text = " " PT1.Text = "" PT2.Text = "" ME1.Text = "__:__"

End Sub

Sub LoadData()

ListView1.ListItems.Clear

ListView1.ColumnHeaders.Clear ListView1.ColumnHeaders.Add , , "Hari", 1000 ListView1.ColumnHeaders.Add , , "Uraian", 2000 ListView1.ColumnHeaders.Add , , "Jam", 800 ListView1.ColumnHeaders.Add , , "Suara", 4000 Set Con1 = New Recordset Con1.Open "SELECT * from data ORDER BY urt,jam;", db, adOpenStatic, adLockOptimistic If Con1.RecordCount > 0 Then Con1.MoveFirst Do While Not Con1.EOF

Set List = ListView1.ListItems.Add(, , Con1!hari)

List.SubItems(1) = Con1!uraian List.SubItems(2) = Con1!Jam List.SubItems(3) = Con1!suara

Con1.MoveNext

Loop End If End Sub Private Sub Combo1_Click() PT1.SetFocus

End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then PT1.SetFocus End If

End Sub

Private Sub Command1_Click()

End Sub

Private Sub File1_Click()

If PT2.Locked = False Then PT2.Text = File1.FileName PT2.SetFocus

End If

End Sub

Private Sub Form_Load()

Dim Pilih, DtB, Pilih2, Jam, Menit, Tombol As String Dim i As Integer

Pilih = GetSetting(App.Title, "Settings", "Pilih")

If Pilih = "" Then SaveSetting App.Title, "Settings", "Pilih", "True" End If Pilih = GetSetting(App.Title, "Settings", "Pilih") If Pilih = "True" Then Pilih2 = "False" Else Pilih2 = "True" RadioButton1(0).Value = Pilih RadioButton1(1).Value = Pilih2

File1.Pattern = "*.wav;*.mp3;*.mid"

Picture1.BackColor = RGB(1, 90, 148)

Me.BackColor = RGB(241, 243, 242) Me.Top = (Info.WorkAreaHeight - Me.Height) / 2 Me.Left = (Info.WorkAreaWidth - Me.Width) / 2

Set db = New Connection

db.CursorLocation = adUseClient If RadioButton1(0).Value = True Then db.Open "PROVIDER=MSDASQL;dsn=wulansoft;uid=;pwd=;" Else db.Open "PROVIDER=MSDASQL;dsn=anggi;uid=;pwd=;" End If

Combo1.AddItem "Senin"

Combo1.AddItem "Selasa" Combo1.AddItem "Rabu" Combo1.AddItem "Kamis" Combo1.AddItem "Jumat" Combo1.AddItem "Sabtu" Combo1.AddItem "Minggu" Combo1.AddItem " "

Combo2.AddItem "00"

Combo2.AddItem "01" Combo2.AddItem "02" Combo2.AddItem "03" Combo2.AddItem "04" Combo2.AddItem "05" Combo2.AddItem "06" Combo2.AddItem "07" Combo2.AddItem "08" Combo2.AddItem "09" For i = 10 To 23 Combo2.AddItem i Next i Jam = GetSetting(App.Title, "Settings", "Jam") If Jam = "" Then SaveSetting App.Title, "Settings", "Jam", "14" End If Jam = GetSetting(App.Title, "Settings", "Jam") Combo2.Text = Jam

Combo3.AddItem "00"

Combo3.AddItem "01" Combo3.AddItem "02" Combo3.AddItem "03" Combo3.AddItem "04" Combo3.AddItem "05" Combo3.AddItem "06" Combo3.AddItem "07" Combo3.AddItem "08" Combo3.AddItem "09" For i = 10 To 59 Combo3.AddItem i Next i Menit = GetSetting(App.Title, "Settings", "Menit") If Menit = "" Then SaveSetting App.Title, "Settings", "Menit", "00" End If Menit = GetSetting(App.Title, "Settings", "Menit") Combo3.Text = Menit

File1.Path = App.Path

Tombol = GetSetting(App.Title, "Settings", "Tombol")

If Tombol = "" Then SaveSetting App.Title, "Settings", "Tombol", "Set" End If Tombol = GetSetting(App.Title, "Settings", "Tombol")

If Tombol = "Reset" Then

PushButton10.Caption = "Reset" Label5.Caption = Combo2.Text & ":" & Combo3.Text Label6.Caption = "Auto Shot Down pada jam : " & Label5.Caption Else Label5.Caption = "X" Label6.Caption = "Auto Shut Down Tidak Aktip" PushButton10.Caption = "Set" End If

Text1.Text = Format(Date, "dddd")

LoadData

End Sub

Private Sub Label3_Click()

If Label3.Caption = Label5.Caption Then ShutDown

End If

End Sub

Private Sub ListView1_Click()

Dim i As Integer On Error Resume Next

If PushButton1.Caption = "Simpan" Then Exit Sub

If PushButton2.Caption = "Simpan" Then Exit Sub

If ListView1.ListItems.Count > 0 Then

i = ListView1.SelectedItem.Index

Combo1.Text = ListView1.ListItems.Item(i).Text PT1.Text = ListView1.SelectedItem.ListSubItems.Item(1).Text ME1.Text = ListView1.SelectedItem.ListSubItems.Item(2).Text PT2.Text = ListView1.SelectedItem.ListSubItems.Item(3).Text PushButton2.Enabled = True End If End Sub

Private Sub ME1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then PT2.SetFocus End If

End Sub

Private Sub PT2_Change()

If PT2.Text = "" Or PT2.Text = "-" Then PushButton2.Enabled = False PushButton3.Enabled = False Else PushButton2.Enabled = True PushButton3.Enabled = True End If

End Sub

Private Sub PT2_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then If PushButton1.Caption = "Simpan" Then PushButton1_Click If PushButton2.Caption = "Simpan" Then PushButton2_Click End If

End Sub

Private Sub PushButton1_Click()

Dim Urutan As String If PushButton1.Caption = "Tambah" Then PushButton1.Caption = "Simpan" PushButton7.Enabled = True

Buka

Bersih Combo1.SetFocus

Else

Pesan

TaskDialog.MainInstructionText = "INPUT DATA" TaskDialog.ContentText = "Hari : " & Combo1.Text & Chr(13) & "Uraian : " & PT1.Text & Chr(13) & "Jam : " & ME1.Text & Chr(13) & "Suara : " & PT2.Text & Chr(13) & Chr(13) & "Input Data Sudah Benar ?" TaskDialog.AddButton "Sudah Benar, Tambah Data Lagi", 102 TaskDialog.AddButton "Sudah Benar, Selesai", 103 TaskDialog.AddButton "Belum Benar", 999 TaskDialog.ShowDialog

End If

End Sub

Private Sub PushButton10_Click()

SaveSetting App.Title, "Settings", "Jam", Combo2.Text SaveSetting App.Title, "Settings", "Menit", Combo3.Text

If PushButton10.Caption = "Set" Then

PushButton10.Caption = "Reset" Label5.Caption = Combo2.Text & ":" & Combo3.Text Label6.Caption = "Auto Shot Down pada jam : " & Label5.Caption SaveSetting App.Title, "Settings", "Tombol", "Reset"

Else

Label5.Caption = "X" Label6.Caption = "Auto Shut Down Tidak Aktip" PushButton10.Caption = "Set" SaveSetting App.Title, "Settings", "Tombol", "Set"

End If

End Sub

Private Sub PushButton2_Click()

If PushButton2.Caption = "Ubah" Then PushButton2.Caption = "Simpan" PushButton7.Enabled = True

Buka

Combo1.Locked = True PT1.Locked = True ME1.SetFocus

Else

Pesan

TaskDialog.MainInstructionText = "PERUBAHAN DATA" TaskDialog.ContentText = "Hari : " & Combo1.Text & Chr(13) & "Uraian : " & PT1.Text & Chr(13) & "Jam : " & ME1.Text & Chr(13) & "Suara : " & PT2.Text & Chr(13) & Chr(13) & "Perubahan Data Sudah Benar ?" TaskDialog.AddButton "Ya, Sudah Benar", 104 TaskDialog.AddButton "Belum Benar", 999 TaskDialog.ShowDialog

End If

End Sub

Private Sub PushButton3_Click()

Pesan TaskDialog.MainInstructionText = "HAPUS DATA" TaskDialog.ContentText = "Hari : " & Combo1.Text & Chr(13) & "Uraian : " & PT1.Text & Chr(13) & "Jam : " & ME1.Text & Chr(13) & "Suara : " & PT2.Text & Chr(13) & Chr(13) & "Anda Yakin Data Ini Akan Dihapus ?" TaskDialog.AddButton "Ya, Hapus", 105 TaskDialog.AddButton "Jangan", 99 TaskDialog.ShowDialog

End Sub

Private Sub PushButton4_Click()

Me.WindowState = 1 Me.Hide

End Sub

Private Sub PushButton5_Click()

Pesan

TaskDialog.MainInstructionText = "KELUAR DARI PROGRAM" TaskDialog.ContentText = "Anda Akan Keluar dari Program Bell Otomatis ?" TaskDialog.AddButton "Ya", 101 TaskDialog.AddButton "Tidak", 999

TaskDialog.ShowDialog

End Sub

Private Sub PushButton6_Click()

On Error Resume Next fShortName = GetShortName(File1.Path & "" & File1.FileName) mciSendString "close all", vbNullString, 0, 0 mciSendString "open " & fShortName & " type MPEGVideo style child alias mpeg parent " & Me.hwnd, vbNullString, 0, 0 mciSendString "status mpeg length", TrackLength, Len(TrackLength), 0 mciSendString "put mpeg window at 208 20 793 595", 0&, 0, 0 mciSendString "set window show maximized", vbNullString, 0, 0 mciSendString "play mpeg", vbNullString, 0, 0 Slider1.Max = CLng(TrackLength) Slider1.TickFrequency = CLng(TrackLength) / 100 'slider1.Max = CLng(TrackLength) 'Label4.Caption = File1.Filename Timer2.Enabled = True

End Sub

Private Sub PushButton7_Click()

Bersih Tutup PushButton1.Caption = "Tambah" PushButton2.Caption = "Ubah" PushButton7.Enabled = False

End Sub

Private Sub PushButton8_Click()

On Error Resume Next fShortName = GetShortName(File1.Path & "pembuka.wav") mciSendString "close all", vbNullString, 0, 0 mciSendString "open " & fShortName & " type MPEGVideo style child alias mpeg parent " & Me.hwnd, vbNullString, 0, 0 mciSendString "status mpeg length", TrackLength, Len(TrackLength), 0 mciSendString "put mpeg window at 208 20 793 595", 0&, 0, 0 mciSendString "set window show maximized", vbNullString, 0, 0 mciSendString "play mpeg", vbNullString, 0, 0 Slider1.Max = CLng(TrackLength) Slider1.TickFrequency = CLng(TrackLength) / 100 'slider1.Max = CLng(TrackLength) 'Label4.Caption = File1.Filename Timer2.Enabled = True End Sub

Private Sub PushButton9_Click()

On Error Resume Next fShortName = GetShortName(File1.Path & "tutup.wav") mciSendString "close all", vbNullString, 0, 0 mciSendString "open " & fShortName & " type MPEGVideo style child alias mpeg parent " & Me.hwnd, vbNullString, 0, 0 mciSendString "status mpeg length", TrackLength, Len(TrackLength), 0 mciSendString "put mpeg window at 208 20 793 595", 0&, 0, 0 mciSendString "set window show maximized", vbNullString, 0, 0 mciSendString "play mpeg", vbNullString, 0, 0 Slider1.Max = CLng(TrackLength) Slider1.TickFrequency = CLng(TrackLength) / 100 'slider1.Max = CLng(TrackLength) 'Label4.Caption = File1.Filename Timer2.Enabled = True End Sub

Private Sub RadioButton1_Click(Index As Integer)

SaveSetting App.Title, "Settings", "Pilih", RadioButton1(0).Value Form_Load

End Sub

Private Sub TaskDialog_ButtonClicked(ByVal Id As Long, CloseDialog As Variant)

Dim Urutan As String

If Id = 105 Then

Me.Enabled = True

Set Con2 = New Recordset

Con2.Open "delete from data where hari='" & Combo1.Text & "' and uraian= '" & PT1.Text & "'", db, adOpenStatic, adLockOptimistic LoadData Tutup Bersih End If

If Id = 104 Then

Me.Enabled = True

Set Con2 = New Recordset

Con2.Open "update data set jam='" & ME1.Text & "',suara='" & PT2.Text & "' where hari='" & Combo1.Text & "' and uraian= '" & PT1.Text & "'", db, adOpenStatic, adLockOptimistic

PushButton2.Caption = "Ubah"

LoadData Tutup Bersih PushButton7.Enabled = False End If

If Id = 103 Then

Me.Enabled = True If Combo1.Text = "Senin" Then Urutan = "01" If Combo1.Text = "Selasa" Then Urutan = "02" If Combo1.Text = "Rabu" Then Urutan = "03" If Combo1.Text = "Kamis" Then Urutan = "04" If Combo1.Text = "Jumat" Then Urutan = "05" If Combo1.Text = "Sabtu" Then Urutan = "06" If Combo1.Text = "Minggu" Then Urutan = "07"

Set Con2 = New Recordset

Con2.Open "insert into data (hari,uraian,jam,suara,urt) values ('" & Combo1.Text & "','" & PT1.Text & "','" & ME1.Text & "','" & PT2.Text & "','" & Urutan & "')", db, adOpenStatic, adLockOptimistic PushButton1.Caption = "Tambah"

LoadData

Tutup Bersih PushButton7.Enabled = True End If

If Id = 102 Then

Me.Enabled = True If Combo1.Text = "Senin" Then Urutan = "01" If Combo1.Text = "Selasa" Then Urutan = "02" If Combo1.Text = "Rabu" Then Urutan = "03" If Combo1.Text = "Kamis" Then Urutan = "04" If Combo1.Text = "Jumat" Then Urutan = "05" If Combo1.Text = "Sabtu" Then Urutan = "06" If Combo1.Text = "Minggu" Then Urutan = "07"

Set Con2 = New Recordset

Con2.Open "insert into data (hari,uraian,jam,suara,urt) values ('" & Combo1.Text & "','" & PT1.Text & "','" & ME1.Text & "','" & PT2.Text & "','" & Urutan & "')", db, adOpenStatic, adLockOptimistic PushButton1.Caption = "Tambah"

LoadData

Tutup Bersih PushButton7.Enabled = True PushButton1_Click End If

If Id = 101 Then

End End If

End Sub

Private Sub Text1_Change()

If Text1.Text = "Sunday" Or Text1.Text = "Minggu" Then Text2.Text = "07" If Text1.Text = "Monday" Or Text1.Text = "Senin" Then Text2.Text = "01" If Text1.Text = "Tuesday" Or Text1.Text = "Selasa" Then Text2.Text = "02" If Text1.Text = "Wednesday" Or Text1.Text = "Rabu" Then Text2.Text = "03" If Text1.Text = "Thursday" Or Text1.Text = "Kamis" Then Text2.Text = "04" If Text1.Text = "Friday" Or Text1.Text = "Jumat" Then Text2.Text = "05" If Text1.Text = "Saturday" Or Text1.Text = "Sabtu" Then Text2.Text = "06"

End Sub

Private Sub Text3_Change()

Set Con2 = New Recordset Con2.Open "select suara from data where urt='" & Text2.Text & "' and jam='" & Text3.Text & "'", db, adOpenStatic, adLockOptimistic If Con2.RecordCount > 0 Then On Error Resume Next fShortName = GetShortName(File1.Path & "" & Con2!suara) mciSendString "close all", vbNullString, 0, 0 mciSendString "open " & fShortName & " type MPEGVideo style child alias mpeg parent " & Me.hwnd, vbNullString, 0, 0 mciSendString "status mpeg length", TrackLength, Len(TrackLength), 0 mciSendString "put mpeg window at 208 20 793 595", 0&, 0, 0 mciSendString "set window show maximized", vbNullString, 0, 0 mciSendString "play mpeg", vbNullString, 0, 0 Slider1.Max = CLng(TrackLength) Slider1.TickFrequency = CLng(TrackLength) / 100 'slider1.Max = CLng(TrackLength) 'Label4.Caption = File1.Filename Timer2.Enabled = True

End If

End Sub

Private Sub Timer1_Timer()

Label2.Caption = Format(Date, "dddd") & ", " & Format(Date, "dd MMMM yyyy") & " " & Format(Time, "HH:mm:ss") Text3.Text = Format(Time, "HH:mm") Label3.Caption = Format(Time, "HH:mm") If Label3.Caption = Label5.Caption Then ShutDown

End Sub

Private Sub Timer2_Timer()

On Error Resume Next

Dim CurPos As String * 40

'mciSendString "set mpeg time format milliseconds", 0, 0, 0 mciSendString "status mpeg position", CurPos, Len(CurPos), 0 Slider1.Value = CLng(CurPos) 'slider1.Value = CLng(CurPos) If Slider1.Value >= Slider1.Max Then Timer2.Enabled = False a = a + 1 'Label4.Caption = File1.Filename If a < cou Then Slider1.Value = 0 'slider1.Value = 0 File1.ListIndex = a 'Label4.Caption = File1.Filename Else a = 0 Slider1.Value = 0 'slider1.Value = 0 File1.ListIndex = a 'Label4.Caption = File1.Filename Timer2.Enabled = False End If End If End Sub

Private Sub Timer3_Timer()

Picture1.BackColor = RGB(1, 90, 148) Image2.Top = -180 Image2.Left = Image2.Left + 50 If Image2.Left > Image2.Width Then Image2.Left = -1 * Image2.Width

End Sub

Private Sub TrayIcon1_Click()

Me.Show

Me.WindowState = 0

End Sub