Free Source Code

Sejarah Visual Basic

2012-09-28T10:13:00.001-07:00

Bahasa pemrograman yang paling awal dirancang pada tahun 1950-an dan dibuat semata-mata untuk memecahkan masalah matematika yang kompleks. Bahasa-bahasa tersebut agak membingungkan bagi orang awam. Namun hal itu bukanlah masalah berbesar, karena komputer hanya ditemukan di lembaga-lembaga riset besar. Lambat laut tentunya orang sadar bahwa teknologi komputer bisa berguna tidak hanya untuk melakukan perhitungan matematika, namun bisa berguna untuk bidang yang lain. Maka komputer pun mulai menjadi barang yang biasa ditemukan di lingkungan bisnis dan universitas. Dengan semakin banyaknya orang yang menggunakan komputer, semakin banyak pula orang yang sadar bahwa bahasa pemrograman yang rumit hanya akan menghambat perkembangan komputer itu sendiri. Pada tanggal 1 Mei 1964, penemu bahasa BASIC, yaitu Profesor John G. Kemeny dan Thomas E. Kurtz di Dartmouth College di New Hampshire menjalankan pertama kali program BASIC.

Bahasa BASIC (Beginner’s All-purpose Symbolic Instruction Code) merupakan bahasa tingkat tinggi yang berbentuk interpreter, yang memungkinkan untuk mengoperasikan komputer secara interaktif, program dapat ditulis, dijalankan, diubah dan dijalankan lagi tanpa harus melalui tahap kompilasi seperti pada bahasa tingkat tinggi lainnya yang berbentu compiler. Bahasa ini dirancang khusus untuk memudahkan tugas belajar memprogram.

Pada tahun 1975, Paul Allen, pemrogram muda yang bekerja ada perusahaan komputer Honeywall dengan teman masa kecilnya William Bill Gates menawarkan interpreter BASIC kepada Ed Robert, pemilik perusahaan MITS yang memproduksi komputer mikro Altair 8800 yang mempunyai RAM 4 KB. Kedua orang ini semasa di SMA sudah pernah mendirikan perusahaan dengan nama Traf-O-Data, tetapi tidak sukses. Ed Robert berjanji akan membeli interpreter BASIC tersebut apabila ia bisa berjalan di atas komputer Altair. Paul Allen dan Bill Gates mengembangkan interpreter BASIC tersebut tanpa pernah melihat secara langsung bentuk dari komputer Altair, apalagi menggunakannya. Apa yang mereka andalkan adalah manual dari microprocessorIntel 8080 yang digunakan di Altair dan diagram dari komputer Altair itu sendiri. Untuk mengujinya, mereka menjalankan interpreter BASIC-nya pada komputer besar dan akhirnya merekam hasilnya ke pita kertas (paper tape). Ketika Paul Allen akan mendemonstrasikan hasil kerjanya pada Ed Robert, dia teringat bahwa belum ditulis suatu program loader untuk membaca dan meletakkan interpreter BASIC yang ada di paper tape ke dalam main memory Altair. Paul Allen langsung menulis program loader tersebut dalam bahasa mesin dan memanggil interpreter BASIC dari pita kertas. Setelah beberapa menit, program berhasil masuk ke main memory. Paul Allen menyadari bahwa dia dan Bill Gates telah membuat banyak kesalahan di sana-sini, walaupun demikian, interpreter BASIC ini akhirnya dapat berjalan juga di komputer mikro Altair dan Ed Robert jadi membelinya. Untuk kedua kalinya, Paul Allen dan Bill Gates mendirikan suatu perusahaan yang disebut dengan Microsoft, yang terkenal sampai sekarang. Inilah cikal bakal dari BASIC yang terkenal itu.

Beberapa tahun kemudian muncullah bahasa pemrograman tingkat tinggi yang dengan menawarkan berbagai macam fungsi dalam pustakanya (library). Akan tetapi, untuk membuat sebuah aplikasi bisnis berbentuk grafik masih merupakan pekerjaaan yang cukup sulit untuk dilakukan. Jangankan aplikasi berbentuk grafik untuk menangani permasalahan mencetak data ke dalam printer saja sudah cukup untuk membuat pemrogram kesulitan. Belum lagi untuk membedakan antara printer satu dengan yang lainnya, walaupun keduanya mempunyai tipe yang sama, yaktu sama-sama dotmatrix, pemrogram harus terlebih dahulu membuat sebuah program yang mengakomodasi semua printer tersebut. Itulah gambaran kesulitan yang dialami oleh generasi pertama pemrogram. Dibutuhkan lebih dari 20 tahun untuk mendapatkan lingkungan pemrograman berbasis DOS yang cukup stabil.

Ketika komputer mikro tergusur oleh IBM PC, maka inilah zaman dimulainya era komputer pribadi (personal computer – PC) dengan antarmuka pemakai grafis (Graphical User Interface – GUI). Dengan munculnya Microsoft Windows, para pemakai PC bisa bekerja dalam lingkungan yang kaya grafis dan intuitif. Dengan GUI menyebabkan aplikasi-aplikasi jauh lebih mudah dipelajari dan dipakai. Hal ini sebagai ganti belajar mengetikkan dan menghafal perintah-perintah yang panjang, para pemakai cukup memilih sebuah menu dengan mengklik tombol mouse. Jendela-jendela pada layar memungkinkan pemakai untuk menjalankan lebih dari satu program secara bersamaan (multi-tasking). Kotak-kotak dialog muncul ketika sebuah program membutuhkan konfirmasi dari pemakai.

Pada tahun 1986, Dr. Bjarne Stroustrup meluncurkan bukunya yang sangat berpengaruh dengan judul The C++ Programming Language sebagai tanda dimulainya era pemrograman berorientasi objek (Object Programming Language -OOP). Pada tahun yang sama Intel meluncurkan microprocessor 32 bit yang pertama kali yakni 386. Banyak pemrogram profesional Amerika menggunakan bahasa C++ sebagai bahasa pemrogramannya ketika membangun suatu aplikasi yang berjalan di atas Windows. Pustaka-pustaka class (class library) dibangun untuk membantu kecepatan pengembangan suatu aplikasi. Terutama class yang berhubungan dengan objek.

Banyak orang percaya bahwa Windows mengawali masa berakhirnya pemrogram amatir. Dalam dunia MS-DOS, para profesional dalam di bidang non-komputer, biasanya mampu menulis aplikasi-aplikasi sederhana yang membantu mereka dalam pekerjaannya, merampingkan perhitungan yang membosankan, atau mengelola data dengan cepat. Jadi C++ bukanlah bahasa yang tepat untuk mereka. Karena yang mereka butuhkan adalah bahasa pemrograman yang cepat dan mudah dipelajari. Sementara C++ adalah bahasa yang benar-benar berbeda dengan bahasa C sebelumnya karena mengandung OOP. Pada waktu itu, sebagian besar pemrogram profesional membutuhkan waktu 6 bulan untuk akrab dengan konsep OOP seperti pengkapsulan (encapsulation), pewarisan (inheritance), dan polimorfisme (polymorphism). Namun bisakah setiap orang memahami hal-hal tersebut? Tentu tidak, apalagi tuntutan pemrograman dalam Windows begitu rumit bahkan untuk aplikasi yang paling sederhana sekalipun.

Tuntutan ini terjawab pada 1991, ketika Microsoft memperkenalkan Visual Basic versi 1.0. Sistem pemrograman Visual Basic mengemas kerumitan Windows dengan cara yang benar-benar menakjubkan. Sejumlah besar pemrogram yang kesulitan untuk mempelajari C++ atau pemrogram yang membutuhkan bahasa pemrograman yang lebih mudah dan lebih produktif untuk lingkungan Windows 3.0, dapat dengan mudah dan sukses pindah ke Visual Basic.

Dengan mengkombinasikan kemampuan bahasa Basic dan peranti desain visual, bahasa ini menyediakan kesederhanaan dan kemudahan pakai tanpa mengorbankan kinerja atau fasilitas grafis yang menyebabkan Windows menjadi lingkungan kerja yang begitu menyenangkan. Menu, tombol, textbox, font, dan semua elemen lainnya dengan mudah dapat dirancang. Dan semua fasilitas tersebut tidak membutuhkan lebih dari beberapa baris pemrograman.

Berikut Perjalanan Visual Basic (VB 1.0 Sampai VB 10)

VB 1.0

Visual Basic 1.0 adalah salah satu bahasa komputer pertama yang mendukung pemrograman event-driven. Event-driven adalah gaya pemrograman yang sangat cocok untuk antarmuka pemakai grafis. Secara tradisional, pemrograman adalah sesuatu yang berorientasi pada proses dan langkah demi langkah. Sebagai ganti menuliskan sebuah program yang mengeplot setiap langkah dalam urutan tepat, pemrogram menuliskan sebuah program yang bereaksi terhadap tindakan pemakai seperti memilih sebuah menu, mengklik jendela, atau menggerak mouse. Suatu program yang besar dapat diganti dengan kumpulan miniprogram yang dipicu oleh event-event yang dilakukan oleh pemakai. Dan dengan Visual Basic, aplikasi seperti ini bisa dituliskan dengan cepat dan mudah. Sebagaimana kata Visual yang tersirat, pemrograman dilakukan secara visual. Ini berarti bahwa sebuah aplikasi sudah terlihat hasilnya walaupun belum dijalankan. Letak dan ukuran menu, textbox, tombol, dan elemen lainnya dapat dirancang dengan menggunakan mouse dan keyboard.

VB 2.0

Visual Basic 2.0 dirilis pada November 1992, Cakupan pemrogramannya cukup mudah untuk digunakan dan kecepatannya juga telah di modifikasi. Khususnya pada Form yg menjadikan object dapat dibuat secara seketika, serta konsep dasar dari Class modul yg berikutnya di implementasikan pada VB 4

VB3.0

Untuk memenuhi untuk tuntutan dari para pemrogram seiring dengan perkembangan bisnis perusahaan, beberapa tahun kemudian Visual Basic 3.0 diluncurkan dengan kinerja yang sudah ditingkatkan. Visual Basic 3.0 , dirilis pada musim panas 1993 dan dibagi menjadi versistandard dan professional. VB 3 memasukan Versi 1.1 dari Microsoft Jet Database Engine yg dapat membaca serta menulis database Jet (atau Access) 1.x Bukan hanya DAO (Data Access Object – yang berfungsi untuk mengakses database) sudah ditambahkan, tapi juga akses data visual dengan kontrol data (data control) juga sudah diberikan. Aplikasi data-browsing dapat dengan mudah dilakukan tanpa menulis kode. Kontrol OLE (Object Linking and Embedding) juga sudah ditambahkan. Visual Basic 3.0 , dirilis pada musim panas 1993 dan dibagi menjadi versistandard dan professional. VB 3 memasukan Versi 1.1 dari Microsoft Jet Database Engine yg dapat membaca serta menulis database Jet (atau Access) 1.x

VB4.0

Seiring dengan perkembangan teknologi microprocessor yang telah berbasis 386 ke teknologi Pentium, Microsoft pun kemudian meluncurkan Windows 32 bit-nya yang pertama kali yakni Windows 95. Windows 95 sangat terkenal karena menampilkan GUI dengan konsep baru yang lebih memudahkan pemakai dalam menjalankan aplikasi. Untuk menjembatani perubahan dari Windows 3.11 (16 bit) ke dalam Windows 95, Microsoft meluncurkan Visual Basic 4.0 (Agustus 1995) yang menawarkan 2 compiler yang terpisah dan berbeda, yang satu untuk pengembangan windows 16 bit dan yang lain untuk windows 32 bit. Pada versi ini, pemrogram sudah dapat membangun program dengan berbasiskan Componen Object Model (COM) yang mendukung kemampuan untuk membuat Dynamic-Link Libraries (DLLs). Inilah untuk kali pertama konsep OOP diterapkan dalam Visual Basic.

VB5.0

Visual Basic 5.0 (February 1997), Microsoft merilis secara eksklusif Visual basic untuk versi windows 32 bit . Programmer yg menulis programnya pada versi 16 bit dapat dengan mudah melakukan import porgramnya dari VB4 ke VB5. dan juga sebaliknya, program VB5 dapat diimport menjadi VB4. VB 5 memperkenalakan kemampuan untuk membuat User Control. Kemampuan untuk membangun dan mendistribusikan ActiveX Control diberikan pada Visual Basic 5.0. Dengan ditemukannya teknologi ActiveX, baik berbentuk Active DLL (COM) ataupun ActiveX Control (OCX).

VB6.0

pada 1998, Microsoft meluncurkan Visual Basic 6.0 dengan 3 fitur projek baru: Data Project, DHTML Application, IIS Application. Dengan 3 senjata baru ini, diharapkan pemrograman Visual Basic sudah mampu untuk membuat aplikasi internet yang handal.

VB7.0

Visual Basic .NET (VB 7), dirilis pada tahun 2002, Beberapa yang mencoba pada versi pertama .NET ini mengemukakan bahwa bahasa ini sangat powerful tapi bahasa yg digunakan sangat berbeda dengan bahasa sebelumnya, dengan kekurangan diberbagai area, termasuk runtime-nya yang 10 kali lebih besar dari paket runtime VB6 serta peningkatan penggunan memory.

VB8.0

Visual Basic 2005 (VB 8.0) , merupakan iterasi selanjutnya dari Visual Basic .NET. dan Microsoft memutuskan untuk menghilangkan kata kata .NET pada judulnya. Pada Rilis ini , Microsoft memasukan beberapa fitur baru, diantaranya:

Edit and Continue , mungkin inilah kekurangan fitur terbesar dari VB .NET . pada VB 2005 ini kita diperbolehkan melakukan perubahan kode pada saat program sedang dijalankan

Perbaikan pada Konversi dari VB ke VB NET12Visual Basic .NET 2003 (VB 7.1) , dirilis dengan menggunakan NET framework versi 1.1.

Visual Basic 2005 Express

Visual Basic 2005 Express , merupkan bagian dari Product Visual Studio. Microsoft membuat Visual Studio 2005 Express edition untuk pemula dan yg gemar dengan VB, salah satu produknya adalah Visual Basic 2005 Express yg merupakan produk gratis dari Microsoft

VB9.0

Basic “Orcas” (VB 9.0) , dijadwalkan akan dirilis pada tahun 2007 dan dibangun diatas .NET 3.5. Pada rilis ini, Microsoft menambahkan beberapa fitur, diantaranya :

True Tenary operator , yaitu fungsi If(boolean,value, value) yg digunakan untuk menggantikan fungsi IIF
LINQ Support
Ekspresi Lambda
XML Literals
Nullable types
Type Inference

VB10.0

Visual Basic ‘VBx’ (VB 10.0) , Visual Basic 10, yang juga dkenal dengan nama VBx, akan menawarkan dukungan untuk Dynamic Language Runtime. VB 10 direncanakan akan menjadi bagian dari SilverLight 1.1

Beberapa Fungsi Komponen-Komponen VB :

Text Box -> Text box merupakan kontrol yang dipakai sebagai tempat untuk mengisi maupun menampilkan data.
Label -> Label merupakan kontrol yang dipakai sebagai tempat untuk menampilkan keterangan.
Command Botton -> Command button merupakan kontrolyang dipakai sebagai tombol untuk melakukan sebuah proses.
Combo Box -> Combo box merupakan kontrol yang dipakai sebagai tempat untuk menampilkan daftar pilihan. Dengan combo box kita tinggal memilih pilihan yang ada pada combo box tersebut.
List Box -> List Box memiliki fungsi yang hamper sama dengan combo box, yaitu menampilkan daftar. Perbedaannya, pada combo box hanya satu pilihan yang terlihat sebelum combo box diklik, sedangkan pada list box dapat menampilkan beberapa pilihan.
Option Botton -> Option button berfungsi untuk menampilkan daftar pilihan.
Frame -> Frame berfungsi untuk mengelompokan kontrol-kontrol pada form menjadi satu bagian.
List Box -> Digunakan Untuk Menampilkan Daftar Pilihan Yang Bisa Digulung.
Hscroll bar -> Untuk Penggulungan Dengan Langkah Lebar Dengan Indikasi Posisi Pemilihan Dlm Posisi Horizontal.
Vscroll bar ->Untuk Penggulungan Dengan Langkah Lebar Mengindikasikan Posisi Pemilihannya Vertical.
Timer -> Untuk Penghitung Waktu Event Dalam Interval Yang Ditentukan.
Drive list box -> Untuk Menampilkan Disk Drive Yang Di Miliki Komputer.
Dir list box -> Menampilkan Direktori Dan Path.
File list box -> Menampilkan Sebuah Daftar File.
Shape -> Untuk Memasang Kontrol Yang Mampu Menghasilkan Sarana Agar Peamakia Bisa Menggambar Berbagai Bentuk

Fungsi Convert Angka Menjadi Terbilang

2012-09-13T06:20:00.001-07:00

Berikut saya akan membagikan Source Code Membuat Fungsi/Convert Angka Menjadi Terbilang dengan menggunakan Visual Basic 6. Penerapannya adalah apabila di suatu perusahaan baik di bank, pertokoan atau instansi pemerintah pembuatan nota kwitansi setoran,penarikan atau pembayaran pasti disertai dengan terbilang agar lebih akurat pengesahan nilai atau nominal angka. Memang secara manual bisa kita ketik di Microsoft Excel atau aplikasi lainnya tapi membutuhkan waktu sedikit lama,
Berikut saya memberikan contoh mengubah angka menjadi terbilang dengan menggunakan Visual Basic.

1. Source code di form

Option Explicit
Private Sub cmdClose_Click()
End
End Sub
Private Sub cmdTerbilang_Click()
Dim obj As New clsTerbilang
txtTerbilang.Text = obj.NumToText(txtNumber.Text)
End Sub
Private Sub txtNumber_KeyPress(KeyAscii As Integer)
If ((KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57) Then
KeyAscii = 0
End If
End Sub

2. Sorce code class modul terbilang

Option Explicit
Dim Once(0 To 20) As String
Dim Tenths(9) As String
Dim Num As String
Dim n(9) As Integer
Dim i As Integer
Dim meValue As String
Private Sub Class_Initialize()
Once(0) = ""
Once(1) = " Satu"
Once(2) = " Dua"
Once(3) = " Tiga"
Once(4) = " Empat"
Once(5) = " Lima"
Once(6) = " Enam"
Once(7) = " Tujuh"
Once(8) = " Delapan"
Once(9) = " Sembilan"
Once(10) = " Sepuluh"
Once(11) = " Sebelas"
Once(12) = " Dua Belas"
Once(13) = " Tiga Belas"
Once(14) = " Empat Belas"
Once(15) = " Lima Belas"
Once(16) = " Enam Belas"
Once(17) = " Tujuh Belas"
Once(18) = " Delapan Belas"
Once(19) = " Sembilan Belas"
Tenths(2) = " Dua Puluh"
Tenths(3) = " Tiga Puluh"
Tenths(4) = " Empat Puluh"
Tenths(5) = " Lima Puluh"
Tenths(6) = " Enam Puluh"
Tenths(7) = " Tujuh Puluh"
Tenths(8) = " Delapan Puluh"
Tenths(9) = " Sembilan Puluh"
End Sub
Public Function NumToText(Num As String) As String
meValue = ""
Num = Format(Num, "000,000,000.00")
n(1) = Mid(Num, 1, 1)
n(2) = Mid(Num, 2, 1)
n(3) = Mid(Num, 3, 1)
n(4) = Mid(Num, 5, 1)
n(5) = Mid(Num, 6, 1)
n(6) = Mid(Num, 7, 1)
n(7) = Mid(Num, 9, 1)
n(8) = Mid(Num, 10, 1)
n(9) = Mid(Num, 11, 1)
'*** MILLIONS
i = n(1) & n(2) & n(3)
If i > 0 Then
If n(1) > 0 Then
meValue = Once(n(1)) & " Ratus"
End If
i = n(2) & n(3)
If i >= 20 Then
meValue = meValue & Tenths(n(2)) & Once(n(3)) & " Juta"
Else
meValue = meValue & Once(i) & " Juta"
End If
End If
'*** THOUSANDS
i = n(4) & n(5) & n(6)
If i > 0 Then
If n(4) > 0 Then
meValue = meValue & Once(n(4)) & " Ratus"
End If
i = n(5) & n(6)
If i >= 20 Then
meValue = meValue & Tenths(n(5)) & Once(n(6)) & " Ribu"
Else
meValue = meValue & Once(i) & " Ribu"
End If
End If
'*** HUNDREDS
i = n(7) & n(8) & n(9)
If i > 0 Then
If n(7) > 0 Then
meValue = meValue & Once(n(7)) & " Ratus"
End If
i = n(8) & n(9)
If i >= 20 Then
meValue = meValue & Tenths(n(8)) & Once(n(9))
Else
meValue = meValue & Once(i)
End If
End If
meValue = Replace(meValue, "Satu Ribu", "Seribu")
meValue = Replace(meValue, "Satu Ratus", "Seratus")
meValue = Trim(meValue)
NumToText = meValue
End Function

Demikian souce code semoga bisa bermanfaat dan membantu rekan-rekan dalam pekerjaan.
Download disini

Membuat Halaman Database VB 6

2012-09-11T23:26:00.000-07:00

Membuat halaman database sangat dibutuhkan dalam pengolaan database yang cukup besar. Apabila kita menemukan suatu project demikian apa yang bisa lakukan?. Bagi anda yang mengetahui atau sudah mahir dalam programing VB 6 tentu saja sudah mengetahui solusinya. Berikut saya sharing atau berikan suatu "Tips Membuat Halaman Database atau Page Paging" dengan menggunakan database "Microsoft Access".

Option Explicit

Dim mykoneksi As Connection

Dim WithEvents tb_1 As Recordset

Dim WithEvents tb_2 As Recordset

Dim record As Integer

Dim field As Integer

Dim page As Integer

Dim jumlah_per_halaman As Integer

Dim eop As Integer

Dim j As Integer

Private Sub cbopage_Click()

Dim i As Integer

Dim tempBottom As Integer

Dim tempTop As Integer

If cbopage.Text > 1 And _

cbopage.Text < tb_1.PageCount Then cmdprev.Enabled = True: cmdnext.Enabled = True

If cbopage.Text = tb_1.PageCount Then cmdprev.Enabled = True: cmdnext.Enabled = False

If cbopage.Text <= 1 Then cmdprev.Enabled = False: cmdnext.Enabled = True

If cbopage.ListCount = 1 Then cmdprev.Enabled = False: cmdnext.Enabled = False

If cbopage.Text = "1" Then

j = 0

tb_1.MoveFirst

For i = 1 To jumlah_per_halaman

j = j + 1

tb_1.MoveNext

If tb_1.EOF Then Exit For

Next i

Else

j = 0

tb_1.MoveFirst

eop = cbopage.Text * jumlah_per_halaman

tb_1.Move eop - jumlah_per_halaman

For i = 1 To jumlah_per_halaman

j = j + 1

tb_1.MoveNext

If tb_1.EOF Then Exit For

Next i

End If

tempBottom = (cbopage * jumlah_per_halaman) - (jumlah_per_halaman - 1)

tempTop = ((cbopage * jumlah_per_halaman) - (jumlah_per_halaman - 1)) + (j - 1)

Set tb_2 = New Recordset

tb_2.Open "SELECT * FROM table1 WHERE no_urut>=" _

& tempBottom & " AND no_urut<=" & tempTop & "", _

mykoneksi, adOpenDynamic, adLockOptimistic

Set DataGrid1.DataSource = tb_2.DataSource

record = tb_2.RecordCount

field = tb_2.Fields.Count

DoEvents

End Sub

Private Sub cbo_perpage_Click()

Dim i As Integer

jumlah_per_halaman = cbo_perpage.Text

tb_1.PageSize = jumlah_per_halaman

page = tb_1.PageCount

cbopage.Clear

For i = 1 To page

cbopage.AddItem i

Next i

cbopage.Text = cbopage.List(0)

End Sub

Private Sub cmdCLOSE_Click()

Unload Me

End Sub

Private Sub cmdnext_Click()

cbopage.Text = cbopage.Text + 1

If cbopage.Text > 1 Then cmdprev.Enabled = True

If cbopage.Text >= tb_1.PageCount Then cmdnext.Enabled = False: cmdprev.SetFocus

End Sub

Private Sub cmdprev_Click()

cbopage.Text = cbopage.Text - 1

If cbopage.Text > 1 Then cmdprev.Enabled = True: cmdprev.SetFocus

If cbopage.Text <= 1 Then cmdprev.Enabled = False: cmdnext.Enabled = True

End Sub

Private Sub Form_Load()

Dim i As Integer

Set mykoneksi = New Connection

mykoneksi.CursorLocation = adUseClient

mykoneksi.Open "PROVIDER=MSDataShape;Data PROVIDER=" & _

"Microsoft.Jet.OLEDB.4.0;Data Source=" _

& App.Path & "\db1.mdb;"

Set tb_1 = New Recordset

tb_1.Open "SELECT * FROM table1", mykoneksi

For i = 10 To 35 Step 10

cbo_perpage.AddItem i

Next i

cbo_perpage.Text = cbo_perpage.List(0)

jumlah_per_halaman = cbo_perpage.List(0)

tb_1.PageSize = jumlah_per_halaman

page = tb_1.PageCount

cmdprev.Enabled = False

cmdnext.Enabled = True

Exit Sub

Pesan:

MsgBox Err.Number & " - " & Err.Description

End

End Sub

Contoh Kode membuat halaman vb 6 diatas masih sederhana dan bisa dikembangkan sesuai kebutuhan kita. NB : "mungkin ada rekan-rekan yang ahli mohon di share... terima kasih".

Download Source disini.

Membuat Animasi Picture

2012-09-11T22:52:00.001-07:00

Membuat aplikasi seringkali kita ingin agar aplikasi kita kelihatan menarik misalnya about me, loading form atau halaman pembuka. berikut saya berikan contoh Membuat Animasi Picture VB 6 dan bisa dikembangkan sesuai kebutuhan kita.
Contoh tampilan latihan membuat animasi picture seperti di bawah ini :

Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Dim flipped As Integer ' bit field

Private Sub Form_Load()
' we need to make the form visible, first
Show
DoEvents
' then we can show the image (this cause a refresh)
cboDissolve.ListIndex = 0
End Sub

Private Sub cboZoom_Click()
cmdShow.Value = True
End Sub

Private Sub chkTile_Click()
cmdShow.Value = True
End Sub

Private Sub cboDissolve_Click()
fraZoom.Enabled = (cboDissolve.ListIndex = 0)
cmdHorizontal.Enabled = (cboDissolve.ListIndex = 0)
cmdVertical.Enabled = (cboDissolve.ListIndex = 0)
cmdBoth.Enabled = (cboDissolve.ListIndex = 0)
cmdShow.Value = True
End Sub

Private Sub cmdShow_Click()
If cboDissolve.ListIndex = 0 Then
ShowImage
Else
DissolveImage
End If
flipped = 0
End Sub

Sub ShowImage()
' show the hidden image
Dim destWidth As Single, destHeight As Single
Dim destX As Single, destY As Single
Dim stepX As Single, stepY As Single

' determine zoom factor
Select Case cboZoom.ListIndex
Case cboZoom.ListCount - 4
' fit width
destWidth = picDest.ScaleWidth
destHeight = picSource.ScaleHeight * (destWidth / picSource.ScaleWidth)
Case cboZoom.ListCount - 3
' fit height
destHeight = picDest.ScaleHeight
destWidth = picSource.ScaleWidth * (destHeight / picSource.ScaleWidth)
Case cboZoom.ListCount - 2
' fit page (no distorsion)
destWidth = picDest.ScaleWidth
destHeight = picDest.ScaleHeight
If destWidth / picSource.ScaleWidth < destHeight / picDest.ScaleHeight Then
' fit width, adjust height
destHeight = picSource.ScaleHeight * (destWidth / picSource.ScaleWidth)
Else
' fit height, adjust width
destWidth = picSource.ScaleWidth * (destHeight / picSource.ScaleWidth)
End If
Case cboZoom.ListCount - 1
' fit page (distorsion)
destWidth = picDest.ScaleWidth
destHeight = picDest.ScaleHeight
Case Else
On Error Resume Next
destWidth = picSource.ScaleWidth * Val(cboZoom) / 100
destHeight = picSource.ScaleHeight * Val(cboZoom) / 100
If Err Then Exit Sub
End Select

picDest.Cls

If chkTile.Value = vbChecked Then
' tile images
For destX = 0 To picDest.ScaleWidth Step destWidth
For destY = 0 To picDest.ScaleHeight Step destHeight
picDest.PaintPicture picSource.Picture, destX, destY, destWidth, destHeight
Next
Next
Else
' simple copy
picDest.PaintPicture picSource.Picture, 0, 0, destWidth, destHeight
End If
End Sub

Sub DissolveImage()
' show the hidden image
Dim srcWidth As Single, srcHeight As Single
Dim srcX As Single, srcY As Single
Dim destWidth As Single, destHeight As Single
Dim destX As Single, destY As Single
Dim stepX As Single, stepY As Single
Dim i As Integer

Const DISSOLVE_STEPS = 20

' most routine below use these values
srcWidth = picSource.ScaleWidth
srcHeight = picSource.ScaleHeight

stepX = srcWidth / DISSOLVE_STEPS
stepY = srcHeight / DISSOLVE_STEPS

picDest.Cls

Select Case cboDissolve.ListIndex
Case 1
' Scroll from Left
srcX = srcWidth
For i = 1 To DISSOLVE_STEPS
srcX = srcX - stepX
picDest.PaintPicture picSource.Picture, 0, 0, , , srcX, 0
RefreshAndDelay
Next
Case 2
' Scroll from right
destX = srcWidth
For i = 1 To DISSOLVE_STEPS
destX = destX - stepX
picDest.PaintPicture picSource.Picture, destX, 0, srcWidth - destX, , , , srcWidth - destX
RefreshAndDelay
Next
Case 3
' Scroll from Top
srcY = srcHeight
For i = 1 To DISSOLVE_STEPS
srcY = srcY - stepY
picDest.PaintPicture picSource.Picture, 0, 0, , , 0, srcY
RefreshAndDelay
Next
Case 4
' Scroll from bottom
destY = srcHeight
For i = 1 To DISSOLVE_STEPS
destY = destY - stepY
picDest.PaintPicture picSource.Picture, 0, destY, , , , , , srcHeight - destY
RefreshAndDelay
Next

Case 5
' Roll from Left
destWidth = 0
For i = 1 To DISSOLVE_STEPS
destWidth = destWidth + stepX
picDest.PaintPicture picSource.Picture, 0, 0, , , 0, 0, destWidth
RefreshAndDelay
Next
Case 6
' Roll from right
destX = srcWidth
For i = 1 To DISSOLVE_STEPS
destX = destX - stepX
picDest.PaintPicture picSource.Picture, destX, 0, , , destX, 0, srcWidth - destX
RefreshAndDelay
Next
Case 7
' Roll from Top
destHeight = 0
For i = 1 To DISSOLVE_STEPS
destHeight = destHeight + stepY
picDest.PaintPicture picSource.Picture, 0, 0, , , 0, 0, , destHeight
RefreshAndDelay
Next
Case 8
' Roll from bottom
destY = srcHeight
For i = 1 To DISSOLVE_STEPS
destY = destY - stepY
picDest.PaintPicture picSource.Picture, 0, destY, , , 0, destY, , srcHeight - destY
RefreshAndDelay
Next
Case 9
' explode
destX = srcWidth / 2
destY = srcHeight / 2
srcWidth = 0
srcHeight = 0
For i = 1 To DISSOLVE_STEPS
destX = destX - stepX / 2
destY = destY - stepY / 2
srcWidth = srcWidth + stepX
srcHeight = srcHeight + stepY
picDest.PaintPicture picSource.Picture, destX, destY, , , destX, destY, srcWidth, srcHeight
RefreshAndDelay
Next
Case 10
' mosaic
' first, prepare the matrix of the (X,Y) coordinates
' for all the tiles
Dim xy(DISSOLVE_STEPS * DISSOLVE_STEPS, 1) As ShiftConstants
Dim kx As Integer, ky As Integer, ndx As Integer
destX = 0
For kx = 1 To DISSOLVE_STEPS
destY = 0
For ky = 1 To DISSOLVE_STEPS
i = i + 1
xy(i, 0) = destX
xy(i, 1) = destY
destY = destY + stepY
Next
destX = destX + stepX
Next
' this loop picks up a random tile, draws it and then
' deletes it from the xy() array so that it can't be
' selected any more
For ndx = UBound(xy) To 1 Step -1
' draw the tile
i = Int(Rnd * ndx + 1)
destX = xy(i, 0)
destY = xy(i, 1)
picDest.PaintPicture picSource.Picture, destX, destY, , , destX, destY, stepX, stepY
' delete it from xy() - actually it just replace it
' with the last item in the array
xy(i, 0) = xy(ndx, 0)
xy(i, 1) = xy(ndx, 1)
Next
End Select

End Sub

Private Sub cmdHorizontal_Click()
' flip the image horizontally
flipped = flipped Xor 1
ShowFlippedImage
End Sub

Private Sub cmdVertical_Click()
' flip the image vertically
flipped = flipped Xor 2
ShowFlippedImage
End Sub

Private Sub cmdBoth_Click()
' flip the image on both axis
flipped = flipped Xor 3
ShowFlippedImage
End Sub

Sub ShowFlippedImage()
picDest.Cls
Select Case flipped
Case 0
picDest.PaintPicture picSource.Picture, 0, 0
Case 1
' flip the image horizontally
picDest.PaintPicture picSource.Picture, picSource.ScaleWidth, 0, -picSource.ScaleWidth
Case 2
' flip the image vertically
picDest.PaintPicture picSource.Picture, 0, picSource.ScaleHeight, , -picSource.ScaleHeight
Case 3
' flip the image on both axis
picDest.PaintPicture picSource.Picture, picSource.ScaleWidth, picSource.ScaleHeight, -picSource.ScaleWidth, -picSource.ScaleHeight
End Select
End Sub

Sub RefreshAndDelay()
'Refresh
Sleep 50
End Sub

Kode diatas hanya sederhana, saya dapat dari internet melalui Om Googleee. dan telah membantu saya membuat aplikasi-aplikasi sederhan.

Source Code

Lupa Password Administrator Windows

2012-09-10T19:25:00.000-07:00

Kalau suatu saat kita lupa user password di windows (xp, vista, 7), itu tidak terlalu masalah, karena masih bisa direset menggunakan account administrator , tetapi kalau yang lupa adalah password administratornya, ini baru masalah karena sudah barang tentu tidak bisa direset menggunakan account user.
Ada cara alternatif untuk mengatasi kalau kita lupa password administrator, sebelum menggunakan jalan terakhir yaitu menginstal ulang windowsnya, caranya yaitu dengan me-reset password menggunakan tool berikut:

Silakan download disini softwarenya, ukurannya sekitar 3,6 MB, (suport windows xp, vista dan windows 7)
Extract file zipnya, di dalamnya ada file iso (cd080802.iso), kemudian copykan (burn) ke CDR blank menggunakan software burning seperti nero. Gunakan pilihan Burn image to disc.
Untuk windows XP setelah diextract file zipnya , untuk burning ke CD tingal klik kanan pada file ISOnya pilih Burn Image to Disc ( tanpa perlu memakai software tambahan).
Booting komputer menggunakan CD yang telah kita buat (set komputer (bios) agar first bootnya ke CD/DVD drive).

Untuk Microsoft Windows yang terinstall secara standard (yang umum), sampai step/urutan ke 7 kita tinggal tekan enter enter.
Berikut Langkah-langkahnya :

Demikian semoga bermanfaat.

Menampilkan Gambar VB

2012-09-10T15:45:00.000-07:00

Berikut ini saya akan bagikan source code untuk Menampilkan Gambar/Image Visual Basic, mudah-mudahan dapat membantu bagi penggemar programing visual basic. Source code ini hanya sederhana dan anda bisa kembangkan sesuai kebutuhan.
Tampilannya seperti gambar berikut:

Dalam source kode diatas ada fungsi menampilkan data dengan memilih drive. berikut source codenya:

Option Explicit

Private Sub Form_Load()
Drive1.Drive = "c:"
Dir1.Path = "c:\windows"
File1.Pattern = "*.bmp;*.dib;*.wmf;*.emf;*.gif;*.jpg"
End Sub

Private Sub Drive1_Change()
Dir1.Path = Left$(Drive1.Drive, 1) & ":\"
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub File1_Click()
LoadImage File1.Path & IIf(Right$(File1.Path, 1) <> "\", "\", "") & File1.filename
End Sub

Private Sub Form_Resize()
On Error Resume Next
File1.Height = ScaleHeight - File1.Top
picPreview.Move picPreview.Left, picPreview.Top, ScaleWidth - picPreview.Left, ScaleHeight - picPreview.Top
ShowImage
End Sub

Private Sub optActual_Click()
ShowImage
End Sub

Private Sub optStretch_Click()
ShowImage
End Sub

Private Sub optTile_Click()
ShowImage
End Sub

Sub LoadImage(filename As String)
On Error Resume Next
Set imgHidden.Picture = LoadPicture(filename)
If Err Then
MsgBox "Unable to load file " & filename, vbExclamation
Exit Sub
End If
Caption = filename & "- Image Preview"
ShowImage
End Sub

Sub ShowImage()
Dim x As Single, y As Single
If optActual.Value Then
' Tampilan image center
picPreview.Cls
picPreview.PaintPicture imgHidden.Picture, (picPreview.ScaleWidth - imgHidden.Width) / 2, (picPreview.ScaleHeight - imgHidden.Height) / 2
ElseIf optStretch.Value Then
' Tampilan image stretch
picPreview.PaintPicture imgHidden.Picture, 0, 0, picPreview.ScaleWidth, picPreview.ScaleHeight
ElseIf optTile.Value Then
' Tampilan image actual
x = 0
Do While x < picPreview.ScaleWidth
y = 0
Do While y < picPreview.ScaleHeight
picPreview.PaintPicture imgHidden.Picture, x, y
y = y + imgHidden.Height
Loop
x = x + imgHidden.Width
Loop
End If

End Sub

Demikian sample source code Menampilkan Gambar/Image VB apabila masih ada kekurangan mohon dimaafkan. Source code Download

Fungsi Event LostFocus dan GotFocus

2012-09-09T21:08:00.000-07:00

Fungsi Event Gotfocus yaitu terjadi pada saat focus object memasuki sebuah komponen . dan LostFocus kebalikan dari fungsi GotFocus yaitu terjadi pada saat focus object meninggalkan sebuah kompunen.

Private Sub txtUserID_LostFocus()If txtUserID.Text = "" ThenMsgBox "Harus diisi"End If

End SubPrivate Sub txtUserID_GotFocus()txtUserID.Text = ""End Sub

Contoh penerapan Fungsi Event LostFocus dan GotFocus seperti source code sederhana di bawah ini:

Option Explicit

Private m_FocusControl As Control

Private Sub HighlightControl(ByVal ctl As Control)
ctl.BackColor = RGB(&HC0, &HFF, &HFF)
End Sub

Private Sub UnHighlightControl(ByVal ctl As Control)
ctl.BackColor = vbWhite
End Sub

Private Sub txtCity_GotFocus()
HighlightControl txtCity
End Sub

Private Sub txtCity_LostFocus()
UnHighlightControl txtCity
End Sub

Private Sub txtFirstName_GotFocus()
HighlightControl txtFirstName
End Sub

Private Sub txtFirstName_LostFocus()
UnHighlightControl txtFirstName
End Sub

Private Sub txtLastName_GotFocus()
HighlightControl txtLastName
End Sub

Private Sub txtLastName_LostFocus()
UnHighlightControl txtLastName
End Sub

Private Sub txtState_GotFocus()
HighlightControl txtState
End Sub

Private Sub txtState_LostFocus()
UnHighlightControl txtState
End Sub

Private Sub txtStreet_GotFocus()
HighlightControl txtStreet
End Sub

Private Sub txtStreet_LostFocus()
UnHighlightControl txtStreet
End Sub

Private Sub txtZip_GotFocus()
HighlightControl txtZip
End Sub

Private Sub txtZip_LostFocus()
UnHighlightControl txtZip
End Sub

Jika anda pingin mengembangkannya silakan klik Download

Membuat Gradient VB

2012-09-09T19:31:00.000-07:00

Pengertian gradient dalam kamus terjemahan adalah tinggi/curam tanjakan, lereng. Kalau kita implementasikan arti kata tersebut dalam pemograman adalah membuat suati garis dari kordinat x sampai y.
Contoh penerapan yaitu seperti gambar di samping ini membuat warna tampilan Form dan PictureBox. Sebagai latihan buat satu project dan tempatkan 2 buah komponen PictureBox, 1 buah kompunen timer dan 3 buah komponen label. dan masukan source kode di bawah ini.

Berikut contoh source code Membuat Gradien:

Option Explicit
Dim Red, Green, Blue, sred, ered, sgreen, sblue, egreen, eblue, difr, difg, difb, fora
Public Enum enumOrientation
Orientation_Horizontal = 0
Orientation_Vertical = 1
End Enum

Public Function Gradient(Frm As Object, Orientation As enumOrientation, SClr As ColorConstants, EClr As ColorConstants)
Dim Yi
Frm.AutoRedraw = True: Frm.ScaleMode = 3 '2 is interesting,too
Analyze (SClr): sred = Red: sgreen = Green: sblue = Blue
Analyze (EClr): ered = Red: egreen = Green: eblue = Blue
difr = ered - sred: difg = egreen - sgreen: difb = eblue - sblue
Select Case Orientation
Case Is = 0: fora = Frm.ScaleHeight
Case Is = 1: fora = Frm.ScaleWidth
End Select
For Yi = 0 To fora
sred = sred + (difr / fora): If sred < 0 Then sred = 0
sgreen = sgreen + (difg / fora): If sgreen < 0 Then sgreen = 0
sblue = sblue + (difb / fora): If sblue < 0 Then sblue = 0
Select Case Orientation
Case Is = 0: Frm.Line (0, Yi)-(Frm.ScaleWidth, Yi), RGB(sred, sgreen, sblue), B
Case Is = 1: Frm.Line (Yi, 0)-(Yi, Frm.ScaleHeight), RGB(sred, sgreen, sblue), B
End Select
Next
End Function

Public Function Analyze(CConst As ColorConstants)
Dim rr, gr, br As Long
rr = 1: gr = 256: br = 65536
Dim rest As Long
rest = CConst \ br
Blue = rest
CConst = CConst Mod br
If Blue < 0 Then Blue = 0
rest = CConst \ gr
Green = rest
CConst = CConst Mod gr
If Green < 0 Then Green = 0
rest = CConst \ rr
Red = rest
CConst = CConst Mod rr
If Red < 0 Then Red = 0
End Function

Private Sub Form_Resize()
Gradient Picture1, 0, vbCyan, vbYellow
Gradient Picture2, 0, vbRed, vbCyan
Gradient Me, 1, vbGreen, vbRed
Label1.Caption = "Gradiant Picture"
End Sub

Private Sub Timer1_Timer()
Label4.Caption = Time
Label5.Caption = Format(Date, "Long date")
End Sub

Silakan Download disini

Manipulasi Database II

2010-07-04T19:32:00.001-07:00

Source code berikut saya dapat di internet dan sangat membantu dalam pengolaan database. dan contoh ini saya sudah praktekkan dalam pembuatan program aplikasi dan sangat membatu sekali.

Di dalam contoh tersebut sudah meliputi:

1. Compac Database

2. Navigasi Control Ado

3. Backup dan Restore Database

4. Password Database

5. Laporan Database dengan DataReport

6. Menampilkan Data di GridView

Bagi anda yang pingin belajar pengelolaan database silakan download di bawah ini :

Download Source Code

Membuat Text Box Khusus Angka

2010-07-04T18:14:00.000-07:00

Dengan adanya properties Control VALUE, akan memudahkan didalam melakukan operasi matematika sehingga tidak lagi sibuk membuang karakter koma (,) cukup menggunakan properties VALUE saja. Di dalam contoh program ini disertai 2 contoh yaitu :
1. menggunakan: myText.Text
2. menggunakan: myText.Value
Bagi anda yang pingin mencoba Membuat Text Box Khusus Angka silakan klik link download di bawah ini. Terima Kasih.
Download Code Selengkapnya.

Manipulasi Database

2010-07-03T05:58:00.000-07:00

Contoh source code untuk menangani database, lengkap dengan fungsi/prosedur menambah, menyimpan, mengedit, menghapus, navigasi, mencari pertama, mencari berikutnya, memfilter, dan menyortir data. Sangat cocok untuk digunakan sebagai template untuk menangani pemrograman database menggunakan coding yang memerlukan validasi data dan penanganan khusus lainnya.
Menggunakan reference "Microsoft ActiveX Data Objects 2.0 Library" dan control "DataGrid".

Download Code Selengkapnya.

Membuat Program Screen Saver

2010-07-03T04:29:00.000-07:00

Screen secara harafiah berarti layar. Screen sering digunakan untuk layar monitor pada komputer, layar tempat penayangan film di bioskop, dsb. Screen Saver berarti animasi yang ditampilkan apabila tidak ada respon input ke komputer dari user dalam jangka waktu tertentu (Windows). Di dalam visual basic kita bisa membuat program screen saver. seperti contoh code yang bisa didownload dibawah ini untuk dikembangkan.

Download

Print Preview File TXT

2010-07-02T22:37:00.000-07:00

Contoh program menampilkan hasil laporan txt atau Print Preview File Txt dengan menggunakan ActiveX Control. Seperti tampilan dibawah ini:

Contoh Penggunaannya :

Option Explicit
Dim db As DAO.Database, DbMaster As DAO.Database, DbTmp As DAO.Database
Dim Rs As DAO.Recordset, RsSandi As DAO.Recordset, RsTmp As DAO.Recordset
Dim jJum1 As Currency, jJum2 As Currency, jJum3 As Currency, jJum4 As Currency, jJum5 As Currency, jJum6 As Currency, jJum7 As Currency
Dim mintFileNo As Integer
Dim mstrfilename As String
Dim mintpageno As Integer
Dim mintlineno As Integer
Dim CariR As String * 9
Private Sub CmdKeluar_Click()
  boolDirty = False
  Call RekamKegiatan(" Keluar dari menu : " & HrfJalan)
  HrfJalan = "Aplikasi System Akuntansi"
  Unload Me
End Sub
Private Sub CmdLayar_Click()
  ReportViewer1.ShowPrintPreview
End Sub
Private Sub CmdPrinter_Click()
  'Load Form36
  Form36.Show
End Sub
Private Sub CmdProses_Click()
  If Option1.Value = False And Option2.Value = False And Option3.Value = False And Option4.Value = False And Option5.Value = False Then
   CInteraction.ShowMsgBox "Informasi", "Anda tidak memilih pilihan yang akan dicetak", , , , , imgExclamationEx, 1
   Exit Sub
  End If
  Set db = OpenDatabase(App.Path & "\DATA\AKUN" & BDatabase & ".MDB", False, False, dbLangGeneral & ";pwd=newpassword")
  Set Rs = db.OpenRecordset(Filedata & "B", dbOpenTable)
  Rs.Index = "TANGGAL"
  Set DbMaster = OpenDatabase(App.Path & "\DATA\AKUNTANSI.MDB", False, False, dbLangGeneral & ";pwd=newpassword")
  Set RsSandi = DbMaster.OpenRecordset("AKNSANDI", dbOpenTable)
  RsSandi.Index = "REKSANDI"
  Call TabelSaldo
  Set DbTmp = OpenDatabase(App.Path & "\DATA\TMPMDB.MDB", False, False, dbLangGeneral & ";pwd=newpassword")
  Set RsTmp = DbTmp.OpenRecordset(Operator, dbOpenTable)
  RsTmp.Index = "REBUKU"

  jJum1 = 0: jJum2 = 0: jJum3 = 0: jJum4 = 0: jJum5 = 0: jJum6 = 0
  '-----------------------
  'sub-sub buku besar
  '-----------------------
  If Option3.Value = True Then
   With RsTmp
   If .RecordCount > 0 Then
   .MoveFirst
   Do While Not .EOF
   .Delete
   .MoveNext
   Loop
   End If
   End With
   With Rs
   If .RecordCount < 1 Then
   CInteraction.ShowMsgBox "Informasi", "Data masih kosong", , , , , 0, 1
   Tutup
   Exit Sub
   End If
   .MoveFirst
   Do While Not .EOF
   If Right(!rebuku, 2) <> "00" Then
   With RsTmp
   .AddNew
   !rebuku = Rs!rebuku
   .Update
   End With
   End If
   .MoveNext
   Loop
   End With
   With RsTmp
   If .RecordCount < 1 Then
   CInteraction.ShowMsgBox "Informasi", "Data masih kosong", , , , , 0, 1
   Tutup
   Exit Sub
   End If
   mstrfilename = App.Path & "\" & Operator & ".txt"
   mintFileNo = 1
   mintpageno = 1
   Open mstrfilename For Output As #mintFileNo ' Open file for output.
   .MoveFirst
   If .RecordCount > 100 Then
   PBar.Max = .RecordCount + 1
   End If
   putar = 0
   Do While Not .EOF
   CariR = !rebuku
   Call ReportHeader
   jJum1 = 0: jJum2 = 0: jJum3 = 0: jJum4 = 0: jJum5 = 0: jJum6 = 0
   With Rs
   .MoveFirst
   Do While Not .EOF
   If !rebuku = CariR Then
   Print #mintFileNo, AlignValue(!tanggal, "L", 12);
   Print #mintFileNo, AlignValue(" ", "L", 30);
   Print #mintFileNo, AlignValue(Format(!saldoa, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!dbkas, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!kdkas, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!dbmem, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!kdmem, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!Saldok, "#,##0.#0"), "R", 21)
   jJum1 = jJum1 + !dbkas: jJum2 = jJum2 + !kdkas: jJum3 = jJum3 + !dbmem: jJum4 = jJum4 + !kdmem
   mintlineno = mintlineno + 1
   If mintlineno > 35 Then
   Call ReportFother
   Print #mintFileNo, Chr(12)
   mintlineno = 0
   mintpageno = mintpageno + 1
   Call ReportHeader
   End If
   End If
   Rs.MoveNext
   Loop
   Call ReportFother
   End With
   putar = putar + 1
   PBar.Value = putar
   .MoveNext
   Loop
   End With
   Close #mintFileNo
   ReportViewer1.ReportTitle = "Rekening Koran Buku Besar" ' Optional
   ReportViewer1.FileName = mstrfilename 'Must Fields
   'ReportViewer1.ShowPrintPreview ' To Show the Report
   'Showing about form Optional
   'ReportViewer1.ShowAboutDlg
   Tutup
   'CInteraction.ShowMsgBox "Informasi", "Proses selesai", , , , , 0, 1
   CmdLayar.Enabled = True
   CmdPrinter.Enabled = True
   CmdProses.Enabled = False
   Call RekamKegiatan(" Melihat : " & Option3.Caption)
  End If
Private Sub ReportHeader()
  Print #mintFileNo, Chr(27) + Chr(69);
  Print #mintFileNo, AlignValue("REKENING KORAN", "C", 120)
  Print #mintFileNo,
  Print #mintFileNo, AlignValue("Rekening : " & CariR, "L", 30) & Space(2)
  RsSandi.Seek "=", CariR
  If Not RsSandi.NoMatch Then
   Print #mintFileNo, AlignValue("Nama : " & RsSandi!nama, "L", 30) & Space(2)
  Else
   Print #mintFileNo, AlignValue("Nama : ", "L", 30) & Space(2)
  End If
  Print #mintFileNo, String(168, "=")
  Print #mintFileNo, AlignValue(" ", "L", 63); AlignValue("MUTASI KAS", "C", 42); AlignValue("MUTASI MEMORIAL", "C", 42)
  Print #mintFileNo, AlignValue("Tanggal", "C", 12); AlignValue("Keterangan", "C", 30); AlignValue("Saldo Awal", "C", 21);
  Print #mintFileNo, String(84, "-"); AlignValue("Saldo Akhir", "C", 21)
  Print #mintFileNo, AlignValue(" ", "L", 63); AlignValue("Debet", "C", 21); AlignValue("Kredit", "C", 21); AlignValue("Debet", "C", 21); AlignValue("Kredit", "C", 21)
  Print #mintFileNo, String(168, "-");
  Print #mintFileNo, Chr(27) + Chr(70)
  mintlineno = mintlineno + 8
End Sub
Private Sub ReportFother()
  Print #mintFileNo, String(168, "-")
  Print #mintFileNo, AlignValue(" Jumlah ", "C", 63); AlignValue(Format(jJum1, "#,##0.#0"), "R", 21); AlignValue(Format(jJum2, "#,##0.#0"), "R", 21); AlignValue(Format(jJum3, "#,##0.#0"), "R", 21); AlignValue(Format(jJum4, "#,##0.#0"), "R", 21)
  Print #mintFileNo, String(168, "-")
End Sub
Private Function RndNum(n As Integer) As Integer
  Randomize n + Timer
  RndNum = Int(Rnd * n)
End Function
Private Sub Form_Activate()
  boolDirty = True
End Sub
Private Sub Form_Load()
  Dim inghwnd As String
  inghwnd = Me.hWnd
  Call DisableClose(inghwnd)
  Call RekamKegiatan(" Menjalankan menu : " & HrfJalan)
  CmdLayar.Enabled = False
  CmdPrinter.Enabled = False
  CmdProses.Enabled = False
  Form19.Left = Lebar / 2 - (Me.Width / 2)
  Form19.Top = ((Tinggi / 2) - (Me.Height / 2))
  Call DisableClose(inghwnd)
End Sub
Private Sub Option3_Click()
  CmdLayar.Enabled = False
  CmdPrinter.Enabled = False
  CmdProses.Enabled = True
End Sub
Private Sub Option4_Click()
  CmdLayar.Enabled = False
  CmdPrinter.Enabled = False
  CmdProses.Enabled = True
End Sub
Sub Tutup()
  Rs.Close
  Set Rs = Nothing
  RsSandi.Close
  Set RsSandi = Nothing
  RsTmp.Close
  Set RsTmp = Nothing
  db.Close
  Set db = Nothing
  DbMaster.Close
  Set DbMaster = Nothing
  DbTmp.Close
  Set DbTmp = Nothing
End Sub

Download File OCX

Membuat Preview Laporan

2010-07-02T19:36:00.000-07:00

Membuat laporan dari suatu aplikasi yang kita buat, tentunya kita menginginkan tampilan laporan yang menarik. VB telah menyediakan bentuk laporan seperti :
1. Laporan dengan bantuan crystal report
2. Laporan yang hasil di preview di form
3. Laporan yang langsung di cetak ke printer
dan masih banyak lagi trik-trik laporan, tergantung kebutuhan kita. Berikut ini saya akan mencontohkan laporan membuat print Preview versi saya seperti gambar berikut :

Bentuk laporan seperti ini saya modifikasi dari Code Visual Basic yang saya dapat dari internet (Sumbernya sudah lupa alamatnya). Tapi bagi anda yang ingin silakan download codenya untuk dikembangkan.

Download

MultiCoulum ComboBox

2010-07-02T19:01:00.000-07:00

Menampilkan data drop down telah disediakan oleh visual basic yaitu ComboBox. Combo Box hanya menampilkan satu coloum. Bagaimanakah kita menampilkan combobox dengan beberapa coloum (Multi Coloum ComboBox)? Seperti contoh code berikut ini.

Download

Membuat Setup Aplikasi

2010-07-02T18:16:00.000-07:00

Program ini adalah contoh sederhana bagaimana membuat file setup aplikasi sendiri untuk menginstall/mengcopy file-file aplikasi yang anda buat ke dalam suatu folder/lokasi tertentu. seting setup disimpan ke dalam registry.

Code Form

Private Sub Command1_Click()
'Tampilkan form ini
Show
DoEvents
pbProgress.Value = 0
DoEvents
'Deklarasi variabel
Dim Run As String
'Ambil dari Registry settings
Run = GetSetting(ThisApp, ThisKey, "Run", "")
DoEvents
'Periksa apakah sebelumnya sudah pernah disetup
If Run = "True" Then 'Jika ya...
'Bebaskan form dari memori
Unload Form1
MsgBox "Setup ini sudah pernah dijalankan sebelumnya!", vbCritical, "Gagal"
Exit Sub 'Langsung keluar dari aplikasi
'Jika muncul pesan sudah pernah dijalankan,
'silahkan Anda hapus setting di registry dengan
'menjalankan regedit. Lokasi setting ada di:
'HKEY_CURRENT_USER\Software\VB And VBA Program Settings\VBS\Setup Master\
'Hapus (delete) String Value "Run" jika Anda ingin
'menjalankan setup ini lagi.
End If
'Jika belum, simpan nilai Run di registry dengan True
SaveSetting ThisApp, ThisKey, "Run", "True"
DoEvents
'Pembuatan direktori
Const ATTR_DIRECTORY = 16
If Dir$(DestPath, ATTR_DIRECTORY) <> "" Then
'Jika direktori sudah ada, tidak usah dibuat lagi
Else
'Jika direktori belum ada, buat!
MkDir DestPath
DoEvents
End If
pbProgress.Value = 33
DoEvents
'Copy file yang Anda inginkan
'dalam contoh ini misalkan saja file index.html
HTMLFiles
FileCopy App.Path & "\index.html", DestPath & "index.html"
DoEvents
pbProgress.Value = 66
DoEvents
pbProgress.Value = 100
DoEvents
'Jika sudah selesai, tampilkan pesan, lalu keluar/selesai!
MsgBox "Setup telah berhasil dengan sukses!", vbInformation, "Sukses"
pbProgress.Value = 0
Unload Me
End
End Sub
Private Sub Command2_Click()
End
End Sub

Module

Option Explicit
'Set Constanta sebagai Public agar dikenali di seluruh
'project
Public Const INVALID_HANDLE_VALUE = -1
Public Const MAX_PATH = 260
Public Const ThisApp = "VBS"
Public Const ThisKey = "Setup Master"
Public Const DestPath = "c:\vbsquare\"
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" _
(ByVal lpPathName As String, _
lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
'API Calls for Registry
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByVal lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'Fungsi API Call untuk memeriksa registrasi
Declare Function RegComCtl32 Lib "c:\windows\system\ComCtl32.dll" Alias "DllRegisterServer" () As Long
'Set konstanta lainnya untuk Registry
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CURRENT_USER = &H80000001
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const SYNCHRONIZE = &H100000
Const ERROR_SUCCESS = 0&
Const ERROR_MORE_DATA = 234
Const REG_SZ = 1
Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Function CopyFiles(sSourcePath As String, sDestination As String, sFiles As String) As Long
'Deklarasi variabel
Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES
Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim copied As Long
Dim currFile As String
'Membuat direktori
r = CreateDirectory(sDestination, SA)
hFile = FindFirstFile(sSourcePath & sFiles, WFD)
'Penanganan jika terjadi error
If (hFile = INVALID_HANDLE_VALUE) Then
MsgBox "No " & sFiles & " files found."
Exit Function
End If
'Copy file-file yang diperlukan
If hFile Then
Do
currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))
r = CopyFile(sSourcePath & currFile, sDestination & currFile, False)
copied = copied + 1
bNext = FindNextFile(hFile, WFD)
Loop Until bNext = 0
End If
'Selesai proses peng-copy-an
r = FindClose(hFile)
CopyFiles = copied
End Function
Public Function HTMLFiles()
'Deklarasi variabel
Dim sSourcePath As String
Dim sDestination As String
Dim sFiles As String
Dim numCopied As Long
'Set nilai variabel
sSourcePath = App.Path + "\"
sDestination = DestPath
sFiles = "*.htm"
'Copy file-file yang diperlukan
numCopied = CopyFiles(sSourcePath, sDestination, sFiles)
End Function

Menghitung Biaya Dengan Timer

2010-07-02T09:39:00.000-07:00

Berikut saya share contoh program untuk menghitung biaya berdasarkan perubahan durasi waktu 30 detik. Dan sangat cocok dikembangkan di dalam pembuatan aplikasi warnet.

Dim Awal, Akhir, Lama As Single
Dim dtkAwal, dtkAkhir As Single
Private Sub Command1_Click()
   If Command1.Caption = "Start" Then
   Text4.Text = 0
   dtkAwal = Time
   Awal = Now
   Text1.Text = Format(Awal, "hh:mm:ss")
   Command1.Caption = "Stop"
   ElseIf Command1.Caption = "Stop" Then
   Timer1.Enabled = False
   Akhir = Now
   Lama = Akhir - Awal
   Text3.Text = Format(Lama, "hh:mm:ss")
   Command1.Caption = "Selesai"
   ElseIf Command1.Caption = "Selesai" Then
   End
  End If
End Sub
Private Sub Timer1_Timer()
If Command1.Caption = "Stop" Then
   dtkAkhir = Time 'dtkAkhir adalah waktu terkini
   If Second(dtkAkhir - dtkAwal) = 30 Then
   dtkAwal = dtkAkhir 'Assignment dtkAkhir ke dtkAwal
   Text4.Text = Format(Text4.Text + 1100, "#,#") 'Update biaya
   End If
   Text2.Text = Format(Now, "hh:mm:ss")
   Text3.Text = Format(Now - Awal, "hh:mm:ss")
End If
End Sub

Banwidth Monitor

2010-07-02T06:55:00.000-07:00

Banwidth Monitor yaitu untuk mengontrol transfer dan receive data Seperti contoh dibawah ini :

Download

Dial Connection

2010-07-02T06:26:00.000-07:00

Dial Connection bisa dibuat dengan menggunakan code VB selain yang telah disedikan oleh Windows XP.

Download

Menampilkan Icon Network (Winsock)

2010-07-02T06:03:00.000-07:00

Di dalam suatu program network tentu kita perlu mengetahui apakah computer kita sudah terkoneksi dengan komputer lain?. Berikut ini contoh program menampilkan icon koneksi dengan komponen winsock.

Option Explicit
Private Sub Form_Load()
   If OnTheNet Then
   lblConnectInfo.Caption = "Connected"
   Else
   lblConnectInfo.Caption = "Not connected"
   End If
End Sub
Private Function OnTheNet() As Boolean
   Winsock1.Close
   Winsock1.Bind
   If Winsock1.LocalIP = "" Then
   OnTheNet = False
   Else
   OnTheNet = True
   End If
End Function

Membuat Map Network Drive

2010-07-02T05:48:00.000-07:00

Membuat Map Network Drive tidak hanya di tool Windows Tetapi bisa juga kita membuatnya dengan Source Kode VB. Seperti gambar berikut ini :

Contoh Source Code Membuat Map Network Drive

Option ExplicitPrivate Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long
Private Sub cmdMapDrive_Click()Dim drive_letter As StringDim share_name As StringDim password As String lblResult.Caption = "Working..." Screen.MousePointer = vbHourglass DoEvents drive_letter = txtDriveLetter.Text If InStr(drive_letter, ":") = 0 _ Then drive_letter = drive_letter & ":" share_name = txtShareName.Text password = txtPassword.Text If WNetAddConnection(share_name, password, _ drive_letter) > 0 _ Then lblResult.Caption = "Error mapping drive" Else lblResult.Caption = "Drive mapped" End If Screen.MousePointer = vbDefaultEnd Sub

Demikian dan saya ucapkan terima kasih.

Program Trial

2010-07-02T05:36:00.000-07:00

Di dunia maya banyak sekali program-program yang dijual dengan memiliki masa waktu tertentu (Trial). Bagaimanakah kita membuat program seperti tersebut diatas?. Berikut ini saya berikan contoh Program Trial dalam code visual basic. Contoh code ini saya dapat dari internet (sumbernya sudah lupa) berhubung suudah lama. jika anda berminat silakan download programnya.

Download

Membuat Password

2010-07-02T04:59:00.000-07:00

Membuat program aplikasi yang aman, tentunya kita membutuhkan password. disaat mengimput password di text tentunya kita tidak inginkan orang lain melihat password yang kita masukan. berikut ini saya uraikan bagaimana memasukan password dengan menampilkan tanda bintang (*).

Di dalam code dibawah ini di suatu form kita siapkan komponen dibawah ini:

Component Timer 2 Buah di form
Component Label2 untuk menampilkan timer
Component TextBox1
Component Command

Code Form1

Option Explicit
Dim ter As Booleana
Private Sub Command1_Click()
ter = False
DisableCtrlAltDelete (False)
Unload Form1
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Timer1.Enabled = False
Timer2.Enabled = True
Text1.Enabled = True
End If
End Sub
Private Sub Form_Load()
DisableCtrlAltDelete (True)
ter = True
End Sub
Private Sub Form_LostFocus()
Form1.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
If ter = True Then
Cancel = 5
Else
End If
End Sub
Private Sub Timer1_Timer()
Form1.SetFocus
Label2.Caption = 5
End Sub
Private Sub Timer2_Timer()
Label2.Caption = Val(Label2.Caption) - 1 & " Waktu untuk memasukan password."
Text1.SetFocus
If Text1.Text = "mouse" Then
ter = False
Timer2.Enabled = False
Timer1.Enabled = False
Label2.Caption = "5"
MsgBox "Password diterima, prgram bisa ditutup sekarang."
Text1.Enabled = False
Command1.Enabled = True
End If
If Val(Label2.Caption) = 0 Then
Timer1.Enabled = True
Timer2.Enabled = False
Text1.Text = ""
Text1.Enabled = False
Command1.Enabled = False
End If
End Sub

Code Module

'Used for DisableCtrlAltDelete
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
'Used for ExitWindows
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
'Used for AlwaysOnTop
Const FLAGS = 3
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Public SetTop As Boolean
Private Declare Function SetWindowPos Lib "user32" (ByVal h%, ByVal hb%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
Sub ExitWindows(ExitMode As String)
Select Case ExitMode
Case Is = "shutdown"
ter = ExitWindowsEx(EWX_SHUTDOWN, 0)
Case Is = "reboot"
ter = ExitWindowsEx(EWX_REBOOT Or EXW_FORCE, 0)
Case Else
MsgBox ("Error in ExitWindows call")
End Select
End Sub
Sub AlwaysOnTop(FormName As Form, bOnTop As Boolean)
'Set form selalu di atas
Dim Success As Integer
If bOnTop = False Then
Success% = SetWindowPos(FormName.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
Success% = SetWindowPos(FormName.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End If
End Sub
Sub Center(FormName As Form)
'Center Forms...
Move (Screen.Width - FormName.Width) \ 2, (Screen.Height - FormName.Height) \ 2
End Sub
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
Sub OpenApp(File As String)
X = Shell(File)
End Sub

Membuat Menu TabStrip

2010-07-02T04:37:00.000-07:00

Membuat Menu TabStrip seperti contoh kode program dibawah ini :

Option Explicit
Private SelectedTab As Integer
Private Sub Form_Load()
Dim i As Integer
   For i = 1 To ChoiceFrame.UBound
   ChoiceFrame(i).Move _
   ChoiceFrame(0).Left, _
   ChoiceFrame(0).Top, _
   ChoiceFrame(0).Width, _
   ChoiceFrame(0).Height
   ChoiceFrame(i).Visible = False
   Next i
    SelectedTab = 1
   TabStrip1.SelectedItem = TabStrip1.Tabs(SelectedTab)
   ChoiceFrame(SelectedTab - 1).Visible = True
End Sub
Private Sub TabStrip1_Click()
   ChoiceFrame(SelectedTab - 1).Visible = False
   SelectedTab = TabStrip1.SelectedItem.Index
   ChoiceFrame(SelectedTab - 1).Visible = True
End Sub

Memanipulasi Text Menggunakan Timer

2010-07-01T15:36:00.000-07:00

Berikut sample Memanipulasi Text Menggunakan Timer atau membuat tulisan berjalan dengan visual basic.

Dim awal As Date
Dim Gerak As Boolean
Dim Aksi As Boolean,Angka As Integer
Private Sub MDIForm_Load()
HrfJalan = "Huruf Jalan"
StatusBar1.Panels(4).Text = Time
Timer2.Enabled = True
iJam = Format(StatusBar1.Panels(4).Text,"hh:mm:ss")
ShowWinnerMessage
Gerak = False
Aksi = False
Timer3.Interval = 500
Timer3.Enabled = True
awal = Time
End Sub

Private Sub ShowWinnerMessage()
    LblJalan.Visible = True
    Timer1.Enabled = True
    Timer4.Enabled = True
End Sub
--------------------------------------------------
Menampilkan huruf berjalan dari kiri ke kanan
-------------------------------------------------
Private Sub Timer1_Timer()
LblJalan = HrfJalan
LblJalan.Left = LblJalan.Left + 2
'Jika huruf jalan lebih besar dari scala picture 2 maka labejln.left akan meset ke 0
If LblJalan.Left > Picture2.ScaleWidth Then LblJalan.Left = 0
End Sub
-------------------------------------------------
Menampilkan jam dengan detik berjalan di status bar panel 4
-------------------------------------------------
Private Sub Timer2_Timer()
With StatusBar1
     .Panels(4).Text = Time
End With
End Sub
------------------------------------------------
Penhitung waktu, Jika dalam program tidak
terjadi aksi apapun maka program otomatis
akan keluar dengan waktu interval tertentu
-----------------------------------------------
Private Sub Timer3_Timer()
Dim durasi As Date
Aksi = False
'Periksa...
If Aksi = False Then
     Gerak = False
     Timer3.Enabled = True
Else 'Jika ada perubahan di Mouse_Move
     Gerak = True
     Timer3.Enabled = False
End If
'Text1.Text = awal
'Text2.Text = Time
'Jika tidak ada pergerakan, aktifkan perhitungan durasi
If Gerak = False Then
    durasi = Time - awal
    'Dalam contoh ini, jika 5 detik aplikasi tidak
    'mengalami kegiatan, maka langsung keluar...
    If Format(durasi, "hh:mm:ss") = "00:01:05" Then
       'Sebelum keluar, bebaskan semua variabel di form ini
       FormSplash.Show
       Set fMainForm = Nothing
       Unload Me
    End If
End If
End Sub
--------------------------------------------------------------
Menampilkan text berjalan pada status bar panel 1
--------------------------------------------------------------
Private Sub Timer4_Timer()
Dim Tulis As String
Dim pnlX1 As Panel
Set pnlX1 = StatusBar1.Panels(1)
      Tulis = "User : " + Operator
      Angka = Angka + 1
      pnlX1.Text = TulisJalan(Angka, Tulis, 100)
End Sub
----------------------------------------------------
Fungsi penghitung kalimat untuk teks berjalan dari kanan
---------------------------------------------------
Function TulisJalan(ByRef Hitung As Integer, kalimat As String, panjang As Integer)
    If Hitung = Len(kalimat) + panjang Then
        Hitung = 0
    ElseIf Hitung > Len(kalimat) Then
        TulisJalan = kalimat & Space(Hitung - Len(kalimat))
    Else
        TulisJalan = Mid(kalimat, 1, Hitung)
    End If
End Function