Alarm

Berbeda dengan aplikasi alarm pada umumnya, aplikasi alarm ini menyimpan beberapa data sekaligus. Terdapat juga fitur berjalan saat startup, minimize to tray, dan menyimpan data.
Download source code-nya disini.

Membuat Tipe File Sendiri

Pernah terpikir untuk membuat tipe file buatan anda sendiri ?. Pastinya dengan membuat tipe file sendiri, aplikasi Anda akan tampak lebih professional. Pembuatan tipe file biasanya bertujuan agar user dapat mengetahui file tersebut dikhususkan untuk aplikasi Anda dan agar file tersebut tidak tertukar dengan aplikasi yang lain.
Buat sebuah Module baru dan ketikkan :

[ VB 6.0 ]

Private Declare Sub SHChangeNotify Lib "shell32" (ByVal wEventId As Long, ByVal uFlags As Long, ByVal dwItem1 As Long, ByVal dwItem2 As Long)

Public Sub NewFileType(ByVal Extension As String, ByVal ContentName As String, ByVal TypeName As String, Optional ByVal IconFileName As String = "")
Dim Reg, a As String
a = Replace(App.Path & "\" & App.EXEName & ".exe", "\\", "\")
If InStr(a, " ") <> 0 Then a = Chr(34) & a & Chr(34)

Set Reg = CreateObject("WScript.Shell")
Reg.RegWrite "HKEY_CLASSES_ROOT\." & Extension & "\", ContentName
Reg.RegWrite "HKEY_CLASSES_ROOT\" & ContentName & "\", TypeName
Reg.RegWrite "HKEY_CLASSES_ROOT\" & ContentName & "\DefaultIcon\", IconFileName
Reg.RegWrite "HKEY_CLASSES_ROOT\" & ContentName & "\Shell\Open\Command\", a & " %1"
SHChangeNotify &H8000000, 0, 0, 0
End Sub

Public Sub DelFileType(ByVal Extension As String)
On Error GoTo Ero
Dim Reg, s As String
Set Reg = CreateObject("WScript.Shell")
s = Reg.RegRead("HKEY_CLASSES_ROOT\." & Extension & "\")

Reg.RegDelete "HKEY_CLASSES_ROOT\." & Extension & "\"
Reg.RegDelete "HKEY_CLASSES_ROOT\" & s & "\DefaultIcon\"
Reg.RegDelete "HKEY_CLASSES_ROOT\" & s & "\Shell\Open\Command\"
Reg.RegDelete "HKEY_CLASSES_ROOT\" & s & "\Shell\Open\"
Reg.RegDelete "HKEY_CLASSES_ROOT\" & s & "\Shell\"
Reg.RegDelete "HKEY_CLASSES_ROOT\" & s & "\"

SHChangeNotify &H8000000, 0, 0, 0
Ero:
End Sub

Public Function CheckFileType(ByVal Extension As String) As Boolean
On Error GoTo Ero
Dim Reg, s As String, a As String
Set Reg = CreateObject("WScript.Shell")
s = Reg.RegRead("HKEY_CLASSES_ROOT\." & Extension & "\")
s = Reg.RegRead("HKEY_CLASSES_ROOT\" & s & "\Shell\Open\Command\")
a = Replace(App.Path & "\" & App.EXEName & ".exe", "\\", "\")
If InStr(a, " ") <> 0 Then a = Chr(34) & a & Chr(34)

CheckFileType = (Left(s, Len(a)) = a)
Exit Function
Ero:
CheckFileType = False
End Function

[ VB .NET ]

Private Declare Sub SHChangeNotify Lib "shell32" (ByVal wEventId As Integer, ByVal uFlags As Integer, ByVal dwItem1 As Integer, ByVal dwItem2 As Integer)

Public Sub NewFileType(ByVal Extension As String, ByVal ContentName As String, ByVal TypeName As String, Optional ByVal IconFileName As String = "")
Dim Reg = CreateObject("WScript.Shell")
Dim a As String = Application.ExecutablePath
If InStr(a, " ") <> 0 Then a = Chr(34) & a & Chr(34)
Reg.RegWrite("HKEY_CLASSES_ROOT\." & Extension & "\", ContentName)
Reg.RegWrite("HKEY_CLASSES_ROOT\" & ContentName & "\", TypeName)
Reg.RegWrite("HKEY_CLASSES_ROOT\" & ContentName & "\DefaultIcon\", IconFileName)
Reg.RegWrite("HKEY_CLASSES_ROOT\" & ContentName & "\Shell\Open\Command\", a & " %1")
SHChangeNotify(&H8000000, 0, 0, 0)
End Sub

Public Sub DelFileType(ByVal Extension As String)
On Error GoTo Ero
Dim Reg = CreateObject("WScript.Shell")
Dim s As String = Reg.RegRead("HKEY_CLASSES_ROOT\." & Extension & "\")

Reg.RegDelete("HKEY_CLASSES_ROOT\." & Extension & "\")
Reg.RegDelete("HKEY_CLASSES_ROOT\" & s & "\DefaultIcon\")
Reg.RegDelete("HKEY_CLASSES_ROOT\" & s & "\Shell\Open\Command\")
Reg.RegDelete("HKEY_CLASSES_ROOT\" & s & "\Shell\Open\")
Reg.RegDelete("HKEY_CLASSES_ROOT\" & s & "\Shell\")
Reg.RegDelete("HKEY_CLASSES_ROOT\" & s & "\")

SHChangeNotify(&H8000000, 0, 0, 0)
Ero:
End Sub

Public Function CheckFileType(ByVal Extension As String) As Boolean
On Error GoTo Ero
Dim Reg = CreateObject("WScript.Shell")
Dim a As String = Application.ExecutablePath
If InStr(a, " ") <> 0 Then a = Chr(34) & a & Chr(34)
Dim s As String = Reg.RegRead("HKEY_CLASSES_ROOT\." & Extension & "\")
s = Reg.RegRead("HKEY_CLASSES_ROOT\" & s & "\Shell\Open\Command\")
CheckFileType = (Microsoft.VisualBasic.Left(s, Len(a)) = a)
Exit Function
Ero:
CheckFileType = False
End Function

Contoh penggunaanya :
Misalnya Anda ingin membuat tipe file *.pvb dengan nama "Dokumen Pribadiku".
Kodenya adalah :

NewFileType "pvb", "pvbfile", "Dokumen Pribadiku"

Sedangkan untuk menghapus / membatalkannya, ketikkan :

DelFileType "pvb"

Untuk mengecek apakah tipe file tersebut terdaftar untuk aplikasi Anda, ketikkan :

MsgBox CheckFileType("pvb")

Setelah semuanya berhasil, sekarang Anda tinggal menyambungkan perintah pembukaan file tersebut ke aplikasi. Untuk lebih jelasnya klik disini.

Membulatkan Nilai Uang

Jika Anda berbelanja ke minimarket, hampir semua harga barang-barangnya tidak ada yang bulat. Dan ketika dibawa dan ditotal harganya di kasir, maka muncul nilai total harga yang tentu saja tidak pas, lalu pihak kasir memberitahukan kepada Anda nilai pembulatan dari total harga barang yang harus dibayar.Fungsi berikut ini digunakan untuk membulatkan nilai uang, sama seperti yang dilakukan oleh kasir tersebut.

Buat sebuah Module dan ketikkan :

Public Function BulatkanUang(ByVal NilaiUang As Double, Optional ByVal BatasDihapus As Integer = 0, Optional ByVal PecahanTerkecil As Integer = 100) As Double
Dim d As Double
d = NilaiUang - (Fix(NilaiUang / PecahanTerkecil) * PecahanTerkecil)
If (d = 0) Or (d <= BatasDihapus) Then
BulatkanUang = NilaiUang - d
Else
BulatkanUang = NilaiUang + (PecahanTerkecil - d)
End If
End Function

Misalkan nilai uangnya adalah 45025. Apabila nilai kelebihannya kurang dari atau sama dengan 15 maka tidak akan dihitung / dihapus, namun jika diatas 15 maka akan dihitung dengan dibulatkan ke atas. Pecahan uang terkecil yang tersedia adalah 100. Kodenya :

n = BulatkanUang(45025, 15, 100)

Credit Title

Credit title adalah sebuah rangkaian tulisan dan gambar yang bergerak dari bawah ke atas. Credit title biasanya dapat ditemukan dalam akhir sebuah film / sinetron.

[ VB 6.0 ]
Buat sebuah Form dengan sebuah kontrol PictureBox (BorderStyle=None) dan sebuah kontrol Timer (Enabled=True; Interval=5). Lalu tempatkan isi (label, image, dll) yang ingin dijalankan ke dalam kontrol PictureBox tadi. Kemudian, sesuaikan ukuran PictureBox agar semua isinya dapat terlihat. Ketikkan kode berikut :
Di 'Form_Load'

Picture1.Top = Me.ScaleHeight

Di 'Form_Resize"

Picture1.Left = (Me.Width / 2) - (Picture1.Width / 2)

Di 'Timer1_Timer'

Picture1.Top = Picture1.Top - 15
If Picture1.Top <= -Picture1.Height Then 'jika sudah selesai
Picture1.Top = Me.ScaleHeight 'ulangi lagi
End If

[ VB .NET ]
Buat sebuah Form dengan sebuah kontrol Panel dan sebuah kontrol Timer (Enabled=True; Interval=10) didalamnya. Lalu tempatkan isi (label, image, dll) yang ingin dijalankan ke dalam kontrol Panel tadi. Kemudian, sesuaikan ukuran Panel agar semua isinya dapat terlihat. Ketikkan kode berikut :
Di 'Form1_Load'

Panel1.Top = Me.ClientRectangle.Height

Di 'Form1_Resize"

Panel1.Left = (Me.Width / 2) - (Panel1.Width / 2)

Di 'Timer1_Tick'

Panel1.Top = Panel1.Top - 1
If Panel1.Top <= -Panel1.Height Then 'jika sudah selesai
Panel1.Top = Me.ClientRectangle.Height 'ulangi
End If

Untuk menampikannya secara fullscreen / layar penuh, klik disini.

Membuka File tanpa menjalankan Aplikasi terlebih dulu

Sebagian besar programmer VB pasti tahu bagaimana membuka file ketika aplikasi sedang berjalan. Lalu apakah Anda tahu bagaimana membuka file tanpa menjalankan aplikasi Anda terlebih dulu. Berikut ini adalah sedikit contoh untuk mempraktekkannya.

Buat sebuah Form dengan sebuah kontrol TextBox didalamnya. Lalu ketikkan kode berikut di bagian 'Form_Load'
[ VB 6.0 ]

If Command <> "" Then
Text1.Text = Replace(Command, Chr(34), "")
End If

[ VB .NET ]

If Microsoft.VisualBasic.Command <> "" Then
TextBox1.Text = Replace(Microsoft.VisualBasic.Command, Chr(34), "")
End If

Selanjutnya, jadikan (compile / build) project tersebut menjadi file *.exe.


Inilah pilihan proses pengetesannya:
1). Klik kanan file
Pilih sebuah file dari Windows Explorer. Kemudian klik kanan pada file tersebut, lalu pilih menu 'Open With' > 'Choose Program'. Klik tombol 'Browse', lalu pilh / arahkan ke aplikasi Anda (*.exe). Dan terakhir klik tombol 'OK'.

2). Command prompt
Buka Command prompt (Start > All Programs > Accessories > Command Prompt),
lalu ketikkan :
Lokasi aplikasi <spasi> Lokasi file
lalu tekan Enter.

3). Run
Buka Run (Start > Run), lalu ketikkan :
Lokasi aplikasi <spasi> Lokasi file
lalu tekan Enter.

4). Kode VB

Shell "LOKASI APLIKASI <spasi> LOKASI FILE", vbNormalFocus

Fungsi Terbilang

Jika anda pernah melihat lembaran kwitansi, pastinya ada kolom 'Terbilang' yang digunakan untuk menuliskan nominal uang dalam bentuk kata. Fungsi berikut ini digunakan untuk mengubah nominal angka menjadi kata-kata / terbilang, lengkap dengan nilai desimalnya. Misalkan nominal 1500, maka hasilnya adalah 'seribu lima ratus'

Buat sebuah Module baru dan ketikkan : (khusus VB .NET, gantikan kode yang berwarna merah dengan kode System.Math.Abs)

Private Function KeKata(ByVal n As Double)
Dim t As String
Dim Angka() As String
Angka = Split(",satu,dua,tiga,empat,lima,enam,tujuh,delapan,sembilan,sepuluh,sebelas", ",")

If n < 12 Then
t = " " & Angka(n)
ElseIf n < 20 Then
t = KeKata(n - 10) & " belas"
ElseIf n < 100 Then
t = KeKata(n \ 10) & " puluh" & KeKata(n Mod 10)
ElseIf n < 200 Then
t = " seratus" & KeKata(n - 100)
ElseIf n < 1000 Then
t = KeKata(n \ 100) & " ratus" & KeKata(n Mod 100)
ElseIf n < 2000 Then
t = " seribu" & KeKata(n - 1000)
ElseIf n < 1000000 Then
t = KeKata(n \ 1000) & " ribu" & KeKata(n Mod 1000)
ElseIf n < 1000000000 Then
t = KeKata(n \ 1000000) & " juta" & KeKata(n Mod 1000000)
ElseIf n < 1000000000000# Then
t = KeKata(Fix(n / 1000000000)) & " milyar" & KeKata(n - (Fix(n / 1000000000) * 1000000000))
ElseIf n < 1E+15 Then
t = KeKata(Fix(n / 1000000000000#)) & " trilyun" & KeKata(n - (Fix(n / 1000000000000#) * 1000000000000#))
End If

KeKata = t
End Function

Private Function KeKataDesimal(ByVal n As Double)
Dim t As String, s As String, d As String, i As Integer
Dim Angka() As String
d = Mid(5 / 2, 2, 1)
Angka = Split("nol,satu,dua,tiga,empat,lima,enam,tujuh,delapan,sembilan", ",")

s = Split(n, d)(1)
For i = 1 To Len(s)
t = t & " " & Angka(Mid(s, i, 1))
Next

KeKataDesimal = t
End Function

Public Function Terbilang(ByVal Nilai As Double, Optional ByVal AwalKapital As Boolean = False)
Dim s As String, n As Double, d As String
d = Mid(5 / 2, 2, 1)
n = Abs(Nilai)

If InStr(Nilai, d) Then
s = KeKata(n) & " koma " & KeKataDesimal(n)
Else
s = KeKata(n)
End If

If Nilai < 0 Then s = "minus " & s

s = Trim(Replace(s, "  ", " "))

Terbilang = IIf(AwalKapital = True, StrConv(s, 3), s)
End Function

Untuk menggunakannya ketikkan :

s = Terbilang(5500)

Fungsi Pecahan Uang

Fungsi ini digunakan untuk mengetahui rincian pecahan / recehan mata uang dari suatu nilai nominal uang. Misalkan nilai nominalnya 1550, maka rincian pecahannya adalah 1 Seribuan, 1 Lima ratusan, 1 Lima puluhan. Fungsi ini sangat cocok bila dipadukan dengan aplikasi pembayaran, semisal aplikasi kasir.

Buat sebuah Module baru dan ketikkan :

Dim Nominal(10) As Double, NamaNominal(10) As String

Public Function PecahanUang(ByVal Nilai As Double, Optional ByVal Pemisah As String = ", ") As String
Dim i As Integer, t As String, s As Double 'sisa

If Nominal(0) = 0 Then 'harus mulai dari yang terbesar s/d terkecil
Nominal(0) = 100000: NamaNominal(0) = "Seratus ribuan"
Nominal(1) = 50000: NamaNominal(1) = "Lima puluh ribuan"
Nominal(2) = 20000: NamaNominal(2) = "Dua puluh ribuan"
Nominal(3) = 10000: NamaNominal(3) = "Sepuluh ribuan"
Nominal(4) = 5000: NamaNominal(4) = "Lima ribuan"
Nominal(5) = 2000: NamaNominal(5) = "Dua ribuan"
Nominal(6) = 1000: NamaNominal(6) = "Seribuan"
Nominal(7) = 500: NamaNominal(7) = "Lima ratusan"
Nominal(8) = 200: NamaNominal(8) = "Dua ratusan"
Nominal(9) = 100: NamaNominal(9) = "Seratusan"
Nominal(10) = 50: NamaNominal(10) = "Lima puluhan"
End If

For i = 0 To UBound(Nominal)
If (Nilai >= Nominal(i)) Then
t = Format(Fix(Nilai / Nominal(i)), "#,#") & " " & NamaNominal(i)
s = Nilai - (Fix(Nilai / Nominal(i)) * Nominal(i))
Exit For
End If
Next

If (s <> 0) And (s >= Nominal(UBound(Nominal))) Then t = t & Pemisah & PecahanUang(s, Pemisah)

PecahanUang = t
End Function

Untuk menggunakannya ketikkan :

s = PecahanUang(5500)

Form Bergetar

Form bergetar biasanya digunakan dalam aplikasi Chatting, untuk mengingatkan lawan chattingnya apabila pesannya tidak dibalas-balas (buzz). Berikut cara membuatnya :

Buat sebuah Form dengan sebuah Tombol / Button dan sebuah Timer (Enabled=False; Interval=10) didalamnya. Di bagian '(Declarations)' dari Form ketikkan :

Dim g As Integer

Di bagian Tombol / Button 'Click' ketikkan :

Timer1.Enabled = True

Di bagian Timer ketikkan : (khusus untuk VB .NET gantikan angka yang berwarna merah dengan angka 4)

If Me.WindowState <> 0 Then GoTo Ero
Select Case g
Case 0, 5
Me.Left = Me.Left - 60
Case 1, 6
Me.Top = Me.Top - 60
Me.Left = Me.Left + 60
Case 2, 7
Me.Top = Me.Top + 60
Me.Left = Me.Left + 60
Case 3, 8
Me.Top = Me.Top + 60
Me.Left = Me.Left - 60
Case 4, 9
Me.Top = Me.Top - 60
End Select

If g = 9 Then
Ero:
Timer1.Enabled = False
g = 0
Else
g = g + 1
End If

Jalankan aplikasi dan tekan Tombolnya.

Fungsi Format

Fungsi format digunakan untuk mengubah struktur atau tampilan suatu data. Fungsi format memiliki berbagai varian, diataranya adalah :

1. Format(x,n) , fungsi ini merupakan fungsi format yang umum dan bisa digunakan untuk berbagai macam tipe data, tapi kebanyakan digunakan untuk tipe data angka dan tanggal&waktu. Fungsi ini akan merubah data x berdasarkan nilai n. Berikut contoh penggunaannya :

ANGKA
Nilai masukan / input dalam Visual Basic harus menggunakan karakter Inggris, yang berbeda dengan karakter Indonesia. Dimana karakter Inggris menggunakan tanda titik (".") sebagai tanda desimalnya, dan tanda koma (",") sebagai tanda pemisah ribuannya.
Sedangkan untuk nilai hasilnya / output akan menggunakan karakter yang sama dengan settingan karakter komputer (untuk contoh dibawah ini, komputer menggunakan settingan karakter Indonesia).
Format(127500.67, "#,#") hasilnya 127.501
Format(127500.67, "#,#.000") hasilnya 127.500,670
Format(127500.67, "Currency") hasilnya Rp127.501
Format(127500.67, "Rp #,#.00") hasilnya Rp 127.500,67
Format(127500.67, "#,#.00 rupiah") hasilnya 127.500,67 rupiah
Format(127500.67, "0,00E+00") hasilnya 128E+03
Format(0.5, "0%") hasilnya 50%

TANGGAL & WAKTU
Dalam contoh ini digunakan fungsi Now sebagai pengganti nilai input-nya.
Format(Now, "dddd") hasilnya Minggu
Format(Now, "long date") hasilnya 31 Oktober 2010
Format(Now, "short date") hasilnya 31/10/2010
Format(Now, "dd-MM-yyyy") hasilnya 31-10-2010
Format(Now, "dd-MMM-yyyy") hasilnya 31-Okt-2010
Format(Now, "dddd, dd MMMM yyyy") hasilnya Minggu, 31 Oktober 2010
Format(Now, "long time") hasilnya 3:12:57
Format(Now, "short time") hasilnya 3:12
Format(Now, "h:mm:ss") hasilnya 3:12:57
Format(Now, "hh:mm:ss") hasilnya 03:12:57



2. FormatNumber dan FormatCurrency , fungsi ini merupakan fungsi format yang dikhususkan untuk data angka. Perbedaan FormatNumber dengan Format Currency terletak pada penambahan simbol mata uang dan karakter default bentuk negatifnya. Contoh :
FormatNumber(1250000, 2) hasilnya 1.250.000,00
FormatCurrency(1250000, 2) hasilnya Rp1.250.000,00
FormatNumber(-1250000, 2) hasilnya -1.250.000,00
FormatCurrency(-1250000, 2) hasilnya (Rp1.250.000,00)

Pointer Tangan pada Kontrol

Dalam properti 'MousePointer' pada kontrol VB 6.0, tidak tersedia pilihan pointer yang berbentuk seperti tangan. Untuk itu harus dibuatkan cara khusus untuk membuatnya, berikut kodenya :

Di bagian '(Declaration)' dari Form ketikkan :

Private Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long

Pada bagian kontrol yang akan diubah bentuk pointernya, ketikkan kode berikut di bagian 'MouseMove' dan 'MouseDown' -nya.

SetCursor (LoadCursor(0, 32649))

Anda juga bisa mengubah bentuk pointernya dengan bentuk yang lain, dengan cara mengubah angka yang berwarna merah dengan angka 32648 s/d 32663.