Form Login yang koneksi MS Access

Buka Microsoft Office - Microsoft Access 2000
Rancanglah sebuah tabel dengan attribute "Username" dan "Password" dengan format Text.
Simpanlah tabel tersebut dengan nama apa saja, contoh "Tabel_User", kemudian simpan File MS Access dengan nama apa saja, contoh: "Login.mdb"

Bukalah Microsoft Visual Basil 6.0
Pilih Standard.exe, kemudian pilih Form.
Masukkan :
- 2 buah Label, yaitu Label1 dan Label2
- 2 buah Text Box, yaitu Text1 dan Text2
- 2 buah Command Button, yaitu Command1 dan Command2

Kemudian ganti nilai property yang diperlukan, seperti:
Form1:
Name = FrmLogin
Caption = Login
BorderStyle = 1-FixedSingle

Label1:
Name = LblUsername
Caption = Username

Label2:
Name = LblPassword
Caption = Password

Text1:
Name = TxtUsername
Text = "" (Kosongkan)

Text2:
Name = TxtPassword
PasswordChar = *
Text = "" (Kosongkan)

Command1:
Name = CmdLogin
Caption = Login
Default = True

Command2:
Name = CmdExit
Caption = Exit

Kemudian rancanglah form sesuai yang diinginkan.

Langkah selanjutnya adalah, tambahkan sebuah Class Module dengan cara,
Klik kanan pada Project Explorer di sebelah kanan atas, kemudian pilih Add Class Module. Muncul sebuah form dengan 4 pilihan, pilih saja Class Module, maka munculah sebuah jedela coding.
Tujuan dari Class Module ini adalah kita membentuk sebuah class untuk membangun koneksi dengan MS Access.
Sebelum memulai coding, tambahkan dulu referensi ADODB dengan cara,
Klik Menu Project - Refference, mucul sebuah form dengan sederetan list, pilih saja
"Microsoft ActiveX Data Object 2.8", kemudian klik Apply atau OK.

Coding pada Class Module:
''Global Variabel'''
Dim Koneksi As New ADODB.Connection
Public RsUser As New ADODB.Recordset

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub BukaKoneksi(File As String)
Koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0.Data Source = " & App.Path & " \" & File & "; Persist Security Info=False"
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Pulblic Sub TutupKoneksi()
If Koneksi.State Then Koneksi.Close
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub BukaRsUser()
RsUser.Open "Select * from Tabel_User", koneksi, AdOpenKeyset, AdLockOptimistic
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub TutupRsUser()
If RsUser.State Then RsUser.Close
End Sub

Tutup jendela coding, kemudia buka FrmLogin. Klik sebarang tempat pada FmrLogin, jangan mengenai kontrol (label, text dan command).

Dim Obj As New Class1 'Global Variabel

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
Obj.BukaKoneksi "Login.mdb"
Obj.BukaRsUser
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdLogin_Click()
Dim Flag As Boolean

Dim i As Integer

Flag = False

Obj.RsUsername.MoveFirst
For i = 0 to Obj.RsUsername.RecordCount - 1
If Obj.RsUsername = TxtUsername And Obj.RsPassword = TxtPassword Then
Flag = True
End if
Next i

If TxtUsername = "" then
MsgBox "Isilah username", vbCritical, "Konfirmasi"
TxtUsername.Setfocus
Elseif TxtPassword = "" then
MsgBox "Isilah Password", vbCritical, "Konfirmasi"
TxtPassword.Setfocus
Elseif Flag = False Then
MsgBox "Terdapat kesalahan dalam mengisi username atau password", vbCritical, "Konfirmasi"
SendKeys "{home}+{end}"
TxtUsername.Setfocus
Else
Msgbox "Login berhasil", vbInformation, "Konfirmasi"
End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdExit_Click()
Obj.TutupRsUser
Obj.TutupKoneksi
End
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Penjelasan
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Koneksi As New ADODB.Connection
Public RsUser As New ADODB.Recordset

Membuat dua buah variabel masing-masing bertipe private dan public. Varibel koneksi sebagai variabel untuk menampung koneksi dan RsUser untuk menampung data yang diambil dari Tabel_User.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub BukaKoneksi(File As String)
Koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0.Data Source = " & App.Path & " \" & File & "; Persist Security Info=False"
End Sub

Sebuah fungsi untuk membuka koneksi ke Ms Access dengan provider Microsoft Jet 4.0, dengan nama file disimpan dalam variabel File yang bertipe data String

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Pulblic Sub TutupKoneksi()
If Koneksi.State Then Koneksi.Close
End Sub

Sebuah fungsi untuk menutup koneksi terhadap database (Ms Access)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub BukaRsUser()
RsUser.Open "Select * from Tabel_User", koneksi, AdOpenKeyset, AdLockOptimistic
End Sub

Fungsi untuk membuka Tabel_User. "Select * from Tabel_User maksudnya adalah mengambil semua kolom pada Tabel_User (Username, Password).
AdOpenKeySet memungkinkan data berpindah dari data yang satu ke data yang lain,
AdLockOptimistic artinya memungkin mengubah data pada saat database sedang dibuka.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub TutupRsUser()
If RsUser.State Then RsUser.Close
End Sub

Fungsi untuk menutup Tabel_User

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Obj As New Class1

Obj adalah sebuah variabel global dari FrmLogin, merupakan Object dari Class1 yang digunakan untuk memanggil Public Property serta Method dari Class1 (Konsep OOP).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub Form_Load()
Obj.BukaKoneksi "Login.mdb"
Obj.BukaRsUser
End Sub

Membuka koneksi terhadap Ms Access (Login.mdb) serta membuka Tabel_User.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub CmdLogin_Click()
Dim Flag As Boolean 'variabel bertipe boolean, True atau False

Dim i As Integer

Flag = False 'set Flag menjadi False (nilai default).

'''' Method untuk mencari tiap data pada Tabel_User ''''
Obj.RsUsername.MoveFirst 'Melakukan pencarian dari data pertama
For i = 0 to Obj.RsUsername.RecordCount - 1
If Obj.RsUsername = TxtUsername And Obj.RsPassword = TxtPassword Then
Flag = True 'Jika data sesuai kriteria maka Flag akan di set menjadi True
End if
Obj.RsUsername.MoveNext 'Jika tidak memenuhi kriteria maka pindah ke data berikutnya.
Next i

'''Validasi Login'''
If TxtUsername = "" then
MsgBox "Isilah username", vbCritical, "Konfirmasi"
TxtUsername.Setfocus
Elseif TxtPassword = "" then
MsgBox "Isilah Password", vbCritical, "Konfirmasi"
TxtPassword.Setfocus
Elseif Flag = False Then
MsgBox "Terdapat kesalahan dalam mengisi username atau password", vbCritical, "Konfirmasi"
SendKeys "{home}+{end}"
TxtUsername.Setfocus
Else
Msgbox "Login berhasil", vbInformation, "Konfirmasi"
End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdExit_Click()
Obj.TutupRsUser
Obj.TutupKoneksi
End
End Sub

Menutup Tabel_User serta Koneksi, dan mengtikan program.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Jalankan program (tekan F5) makan Form Login sudah dapat dijalankan. Bisa pula tambahkan satu buah form lagi agar setelah berhasil login, maka program akan otomatis membuka form selanjutnya setelah form login.
(Caranya, Form2.Show setelah MsgBox Login berhasil)

Animasi Form VB

Animasi Visual Basic

Sub AnimateForm(frm As Form)
GotoVal = frm.Height / 2
For Gointo = 1 To GotoVal
DoEvents
frm.Height = frm.Height - 100
frm.Top = (Screen.Height - frm.Height) \ 2
If frm.Height <= 500 Then Exit For Next Gointo horiz: frm.Height = 30 GotoVal = frm.Width / 2 For Gointo = 1 To GotoVal DoEvents frm.Width = frm.Width - 100 frm.Left = (Screen.Width - frm.Width) \ 2 If frm.Width <= 2000 Then Exit For Next Gointo Unload Me End Sub Copyright by x-vb@jhie
'http://www.vbbego.cjb.net
'Penulis: x-vb@jhie - 7/19/2004

Tulisan Blink2


Code:

Private Sub Timer1_Timer()
Dim Tm As Double
Dim strText As String
Dim Ctr As Integer

With Form1
.BackColor = RGB(0, 255, 0)
.FontName = "Arial Black"
.FontSize = 24
.FontBold = True
'.FontItalic = True
.FontUnderline = True
End With

strText = "YaDoY666 WuZ HeRe...!!!"
x = CurrentX
y = CurrentY
x = 100 'Set the position of the_
y = 100 'text here x = ? ,y = ?
For Ctr = 0 To 255
ForeColor = RGB(0, 0, Ctr)
x = x + 1
y = y + 1
CurrentX = x
CurrentY = y
Print strText
Next Ctr
ForeColor = RGB(0, 0, 0)
CurrentX = x: CurrentY = y
Print strText
For Tm = 1 To 300000

DoEvents
Next Tm

Form1.Cls
End Sub

'Animasi Close Form
'Cuma Butuh 1 Form,1Command Button n 3 Timer


Private Sub Command1_Click()
Timer1.Enabled = True
Timer2.Enabled = True
Timer3.Enabled = True
Form1.Height = 0
Form1.Caption = "APLIKASI AKAN DITUTUP );"
End Sub

Private Sub Form_Load()
Timer1.Interval = 1
Timer2.Interval = 1
Timer3.Interval = 2000
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
Form1.Left = 6000
Form1.Top = 5000
Form1.Width = 4000
Form1.Height = 2000
Command1.Left = 1000
Command1.Top = 700
Command1.Width = 2000
Command1.Height = 700
Command1.Caption = "KLIK OK );"
End Sub

Private Sub Timer1_Timer()
If Form1.Left <> Not 0 Then
Form1.Left = Form1.Left - 1
If Form1.Left = 5900 Then
Form1.Left = 6000
Else
End If
End If
End Sub

Private Sub Timer2_Timer()
If Form1.Left <> Not 0 Then
Form1.Left = Form1.Left + 1
If Form1.Left = 6000 Then
Form1.Left = 5900
End If
End If
End Sub

Private Sub Timer3_Timer()
Unload Me
End Sub

Memperepat Pencarian File

Private Declare Function SearchTreeForFile Lib "imagehlp" _
(ByVal RootPath As String, ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
Private Const MAX_PATH = 260
Private Sub Form_Load()

Dim tempStr As String, Ret As Long
tempStr = String(MAX_PATH, 0)
Ret = SearchTreeForFile("c:", "calc.exe", tempStr)
If Ret <> 0 Then
MsgBox "Lokasi file di " + Left$(tempStr, _
InStr(1, tempStr, Chr$(0)) - 1)
Else
MsgBox "File tidak ditemukan!"
End If
End Sub

Download ActiveX

WordXChange.ocx

Toolbar2.ocx

cPopMenu.ocx

gdone10.ocx

gdoneo10.ocx

DXAnimatedGIF.ocx

axGrid.ocx

LDMinMax6.ocx

Line3D.ocx
ARFlatBttn.ocx
bls3DPanelX.ocx
ActiveGUI.ocx

DSAniSet.ocx

newex.ocx

FldrView.ocx

TriSpace.ocx

clrcombo.ocx

RButton.ocx

AMCLabel.ocx

XTools.ocx

ZTray.ocx

BS.OCX

CHKLIST.OCX

SWBGradient.ocx

SWBTopForm.ocx

HotKeyControl.ocx

xfxFormShaper.ocx

PROGBAR.ocx

cHotKey.ocx

TDBGS32.OCX

VFmp3player.ocx

CdBase.ocx

Kupex-WinPower.ocx

XRTGraph.ocx

UserInfo32.ocx

as97Popup.ocx

SCGrid.ocx

AutoResizeControl.ocx

Subclass.ocx

VertMenu.ocx

sstabs2.ocx

sstbars2.ocx

Adtextbox.ocx

Jam Digital dan Analog Dengan Visual Basic

1). Membuat Jam Digital Dengan Visual Basic

Buat 1 buah label dan timer
dan ketik source code dibawah ini

Private sub form_load()
me.label1.fontbold=true
me.label1.fontsize=24

me.timer1.interval=1000
end sub

private sub timer_timer()
me.label1.caption=format(now,"hh:mm:ss")
end sub

2). Membuat Jam Analog Dengan Visual Basic

Option Explicit
Dim xgen, ygen, xmin, ymin, xsec, ysec, xhor, yhor As Double
Dim h, m, s As Date
'control the minute '
Function mint()

If s >= 0 And s < 12 Then
Call findminangle(CDbl(m))
ElseIf s >= 12 And s < 24 Then
Call findminangle(CDbl(m) + 0.2)
ElseIf s >= 24 And s < 36 Then
Call findminangle(CDbl(m) + 0.4)
ElseIf s >= 36 And s <= 48 Then
Call findminangle(CDbl(m) + 0.6)
ElseIf s >= 48 And s <= 59 Then
Call findminangle(CDbl(m) + 0.8)
End If
xmin = xgen
ymin = ygen

Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xmin, ymin), RGB(255, 24, 32)
End Function
'control the second
Function secnd()
Call findminangle(CDbl(s))
xsec = xgen
ysec = ygen
Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xsec, ysec), RGB(100, 100, 100)

End Function
'control the hour
Function hr()

If m >= 0 And m < 12 Then
Call findminangle(CDbl(h) * 5)
ElseIf m >= 12 And m < 24 Then
Call findminangle(5 * (CDbl(h) + 0.2))
ElseIf m >= 24 And m < 36 Then
Call findminangle(5 * (CDbl(h) + 0.4))
ElseIf m >= 36 And m < 48 Then
Call findminangle(5 * (CDbl(h) + 0.6))
ElseIf m >= 48 And m <= 59 Then
Call findminangle(5 * (CDbl(h) + 0.8))
End If
xhor = xgen
yhor = ygen
If xhor >= Form1.ScaleWidth / 2 And yhor >= Form1.ScaleHeight / 2 Then

Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor - 200, yhor - 200), RGB(0, 0, 255)
ElseIf xhor <= Form1.ScaleWidth / 2 And yhor >= Form1.ScaleHeight / 2 Then
Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor + 200, yhor - 200), RGB(0, 0, 255)
ElseIf xhor <= Form1.ScaleWidth / 2 And yhor <= Form1.ScaleHeight / 2 Then
Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor + 200, yhor + 200), RGB(0, 0, 255)
ElseIf xhor >= Form1.ScaleWidth / 2 And yhor <= Form1.ScaleHeight / 2 Then
Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor - 200, yhor + 200), RGB(0, 0, 255)
End If

End Function
'draw the clock
Function drawdig()
Dim i As Integer
Circle (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2), 1411, RGB(255, 34, 34)
For i = 5 To 60
Call findminangle(CDbl(i))
Form1.CurrentX = xgen - TextWidth(i / 5) / 2
Form1.CurrentY = ygen - TextWidth(i / 5) / 2
Form1.Print i / 5
i = i + 4
Next
End Function
'find the co-ordinate
Function findminangle(p As Double)
Dim temp As Double

temp = 60 - (p - 15)
temp = temp * 60 * 0.1
temp = (22 * temp) / (7 * 180)

xgen = (Form1.ScaleWidth / 2) + (1000 * Cos(temp))
ygen = (Form1.ScaleHeight / 2) - (1000 * Sin(temp))

End Function

Private Sub Timer1_Timer()

Form1.Cls

Call drawdig
Form1.Caption = Time()
h = Hour(Time())
m = Minute(Time())
s = Second(Time())

Call mint
Call secnd
Call hr
End Sub