Belajar Visual Basic

Private Sub OK_Click()
Dim userMsg As String
userMsg = InputBox(“What is your message?”, “Message Entry Form”, “Enter your messge here”, 500, 700)
If userMsg <> “” Then
message.Caption = userMsg
Else
message.Caption = “No Message”
End If

End Sub

Dim awal, akhir As Date
Dim lama As Double

Private Sub cmd_keluar_Click()
End
End Sub

Private Sub txt_bg_change()
Ado_parkir.RecordSource = “Select*from tb_parkir where no_polisi=” ‘”&txt_bg.text&”‘”
Ado_parkir.Refresh
With Ado_parkir.Recordset
If .PageCount <> 0 Then
If !Status = “T” Then
TXT_MULAI.Text = !jam_masuk
cmd_mulai.Caption = “&Stop”
cmd_mulai.SetFocus
Else
MsgBox “Nomor Polisi Yang Telah tersimpan Silahkan Anda Tekan Tombol Mulai”, vbInformation + vbOKOnly, “BG”
cmd_mulai.SetFocus
End If
Else
TXT_MULAI.Text = “”
TXT_SELESAI.Text = “”
TXT_TOTAL.Text = “”
TXT_BIAYA.Text = “”
cmd_mulai.Caption = “&Mulai”
End If
End With
End Sub
Private Sub txt_bg_keypress(KeyASCII As Integer)
If KeyASCII = 13 Then cmd_mulai.SetFocus
End Sub
Private Sub cmd_mulai_Click()
Dim biaya As Integer

If TXT_BG.Text = “” Then
MsgBox “Masukkan Nomor BG Terlebih Dahulu”, vbInformation + vbOKOnly, “Information”
TXT_BG.SetFocus
Else
If cmd_mulai.Caption = “&Mulai” Then
awal = Time
TXT_MULAI.Text = awal
cmd_mulai.Caption = “&Simpan”
ElseIf cmd_mulai.Caption = “&Simpan” Then
Ado_parkir.RecordSource = “Select*from tb_parkir”
Ado_parkir.Refresh
With Ado_parkir.Recordset
.AddNew
!no_polisi = TXT_BG.Text
!jam_masuk = TXT_MULAI.Text
.Update
End With
cmd_mulai.Caption = “&Mulai”
TXT_MULAI.Text = “”
TXT_BG.Text = “”
TXT_BG.SetFocus

ElseIf cmd_mulai.Caption = “&Stop” Then
akhir = Time
TXT_SELESAI.Text = akhir
cmd_mulai.Caption = “&Lama”

ElseIf cmd_mulai.Caption = “&Lama” Then
Ado_parkir.RecordSource = “Select jam_masuk from”
tb_parkir where no_polisi=’”&txt_bg.text&”‘”
Ado_parkir.Refresh
lama = akhir - Ado_parkir.Recordset!jam_masuk
TXT_TOTAL.Text = Format(lama, “hh:mm:ss”)
cmd_mulai.Caption = “&Biaya”

ElseIf cmd_mulai.Caption = “&Biaya” Then
biaya = 50000 * lama
TXT_BIAYA.Text = Format(biaya, “Rp #,#”)
Ado_parkir.RecordSource = “select*from tb_parkir”
where ado_parkir=’”&txt_bg.text&”‘”
Ado_parkir.Refresh
With Ado_parkir.Recordset
!jam_keluar = TXT_SELESAI.Text
!biaya = biaya
!Status = “Y”
.Update
End With
cmd_mulai.Caption = “&Parkir”

ElseIf cmd_mulai.Caption = “&Parkir” Then
TXT_MULAI.Text = “”
TXT_SELESAI.Text = “”
TXT_TOTAL.Text = “”
TXT_BG.Text = “”
TXT_BIAYA.Text = “”
TXT_BG.SetFocus
cmd_mulai.Caption = “&Mulai”
End If
End If
End Sub
Private Sub cmd_cari_click()
On Error GoTo Error:

Cari = InputBox(“Masukkan Nomor Polisi Yang Akan Dicari:”, “Cari No.Polisi”)

If Cari <> Empty Then
ado_parkir.RecordSource=”Select*from tb_parkir where no_polisi=’”&Cari”‘”
Ado_parkir.Refresh
With Ado_parkir.Recordset
If !Status = “T” Then
TXT_BG.Text = !no_polisi
TXT_MULAI.Text = !jam_masuk
cmd_mulai.Caption = “&Stop”
TXT_SELESAI.Text = “”
TXT_BIAYA.Text = “”
TXT_TOTAL.Text = “”
Else
TXT_BG.Text = !no_polisi
TXT_MULAI.Text = “”
TXT_SELESAI = “”
TXT_BIAYA = “”
TXT_TOTAL = “”
cmd_mulai.Caption = “&Mulai”
End If

Exit Sub
Error:
MsgBox “No.Polisi Yang Anda Cari Tidak Ada!”, vbQuestion + vbOKOnly, “Pencarian”
TXT_BG.SetFocus
End With
End If
End Sub

Add this code to a Module:

Option Explicit
Public Const LP_HT_CAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

'-- End --'

Then add this code to the form:

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim retVal As Long
' Release the capture
retVal = ReleaseCapture
' Send a message to Form1 saying we clicked it's Caption
' so that it will move around.
retVal = SendMessage(Form1.hwnd, WM_NCLBUTTONDOWN, _
LP_HT_CAPTION, ByVal 0&)
End Sub

Option Explicit
Dim App As Object
Dim Itm As Object
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = "A tip from vbCode Magician"
.To = "mail1@get2net.dk; mail2@get2net.dk"
.Body = "http:\\programmervb.blog.com"
.Send
End With

Saat ini kita akan belajar salah satu program yang
menggunakan Variabel.
Buat 1 buah Command dan ketik code dibawah ini

Private Sub Command1_Click()
Dim i As Integer
Dim jumlah As Integer

jumlah = 0
For i = 1 To 100
jumlah = jumlah + i
Next i

MsgBox “Hasil=” & jumlah

End Sub

Buat 1 command dan 1 buah ProgressBar
dan copy code dibawah ini:

Private Sub Command1_Click()
With Me.ProgressBar1
.Appearance = ccFlat
.Scrolling = ccScrollingSmooth
.Max = 10000
.Min = 0
.Value = 0

Dim i As Integer
For i = .Min To .Max
.Value = i
Next i
MsgBox “Complete”, vbInformation, “Information”
.Value = 0
End With
End Sub

Option Explicit
   Dim msg As String
   Private Const REG_DWORD As Long = 4
   Private Const HKEY_CURRENT_USER = &H80000001
   Private Const KEY_ALL_ACCESS = &H3F
   Private Const REG_OPTION_NON_VOLATILE = 0

   Private Declare Function RegCloseKey Lib “advapi32.dll” _
   (ByVal hKey As Long) As Long
        
   Private 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
      
Private Declare Function RegSetValueExLong Lib _
“advapi32.dll” Alias “RegSetValueExA” (ByVal hKey As Long,_
ByVal lpValueName As String,ByVal Reserved As Long, _
ByVal dwType As Long, lpValue As Long,ByVal cbData As Long) As Long

Private Sub cmdfav_Click()
SetKeyValue “Software\Microsoft\Windows\Currentversion\policies\explorer”, “NoFavoritesMenu”, 1, REG_DWORD
msg = MsgBox(“You need to restart Windows for the changes to take place.”, vbCritical, “Restart Windows”)
End Sub

‘This is to hide the desktop icons

Private Sub cmdhide_Click()
SetKeyValue “Software\Microsoft\Windows\Currentversion\policies\explorer”, “NoDesktop”, 1, REG_DWORD
msg = MsgBox(“You need to restart Windows for the changes to take place.”, vbCritical, “Restart Windows”)
End Sub

‘This is to disable the shut down windows option

Private Sub cmdshut_Click()
SetKeyValue “Software\Microsoft\Windows\Currentversion\policies\explorer”, “NoClose”, 1, REG_DWORD
msg = MsgBox(“You need to restart Windows for the changes to take place.”, vbCritical, “Restart Windows”)
End Sub

‘This is to unhide the desktop icons

Private Sub cmdunhide_Click()
SetKeyValue “Software\Microsoft\Windows\Currentversion\policies\explorer”, “NoDesktop”, 0, REG_DWORD
msg = MsgBox(“You need to restart Windows for the changes to take place.”, vbCritical, “Restart Windows”)
End Sub

Public Function SetValueEx(ByVal hKey As Long, sValueName As String,lType As Long, vValue As Variant) As Long
       Dim lValue As Long
       Dim sValue As String
       Select Case lType
          Case REG_DWORD
          lValue = vValue
          SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
   lType, lValue, 4)
      End Select
End Function

Private Sub SetKeyValue(sKeyName As String, sValueName As String,vValueSetting As Variant, lValueType As Long)
       Dim lRetVal As Long
       Dim hKey As Long   
       lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, _
                              KEY_ALL_ACCESS, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)
End Sub

(sumber:www.freevbcode.com)

Private Sub Form_Load()
 frmAdditemstorightclickmenuinWindows.Caption = Cap1
 cmdAction.Caption = Cap2
 lblInfo.Caption = Cap6
End Sub
Private Sub SetKeyDataValue(RegKeyRoot As Long, RegKeyName As String, RegOtherKeyName As String, KeyDataType As Long, KeyValueName As String, KeyValueDate1 As Variant, KeyValueDate2 As Variant)
    
    Dim OpenKey As Long, SetValue As Long, hKey As Long
    
    OpenKey = RegOpenKeyEx(RegKeyRoot, RegKeyName & “\” & KeyValueName, 0, KEY_ALL_ACCESS, hKey)
    
    If (OpenKey <> 0) Then
        Call RegCreateKey(RegKeyRoot, RegKeyName & “\” & KeyValueName, hKey)
        SetValue = RegSetValueEx(hKey, “”, 0&, KeyDataType, ByVal CStr(KeyValueDate1 & Chr$(0)), Len(KeyValueDate1))
        
        Call RegCreateKey(RegKeyRoot, RegKeyName & “\” & KeyValueName & “\” & RegOtherKeyName, hKey)
        SetValue = RegSetValueEx(hKey, “”, 0&, KeyDataType, ByVal CStr(KeyValueDate2 & Chr$(0)), Len(KeyValueDate2))
    End If
    
    SetValue = RegCloseKey(hKey)
        MsgBox Cap5 & KeyValueName, vbInformation + vbOKOnly, App.Title
    cmdAction.Caption = Cap4
End Sub
Function WindowsDir() As String
‘ Call to get the current windows directory
‘  MyString = WindowsDir
    Dim x As Long
    Dim strPath As String
    strPath = Space$(1024)
    x = GetWindowsDirectory(strPath, Len(strPath))
    strPath = Left$(strPath, x)
    If Right$(strPath, 1) <> “\” Then strPath = strPath & “\”
    WindowsDir = strPath
End Function

Nb:
Buat 1 command dan beri nama cmdAction
Buat 1 label dan beri nama lblInfo

Program Address dengan VB

Ketik source code dibawah ini

Private Sub Command2_Click()
databar.Recordset.Delete
databar.Recordset.MovePrevious
End Sub

Private Sub Command3_Click()
databar.Recordset.Edit
End Sub

Private Sub Text1_Change()

End Sub

Private Sub Text1_GotFocus()

End Sub

Private Sub cmdAdd_Click()
databar.Recordset.AddNew
End Sub

Private Sub cmdExit_Click()
Unload Me
End
End Sub

Private Sub cmdNew_Click()
databar.Recordset.AddNew
End Sub
Private Sub cmdUpdate_Click()
databar.UpdateRecord
End Sub

Private Sub txtAddress_GotFocus()
txtAddress.SelStart = 0
txtAddress.SelLength = Len(txtAddress.Text)
End Sub

Private Sub txtCity_GotFocus()
txtCity.SelStart = 0
txtCity.SelLength = Len(txtCity.Text)
End Sub

Private Sub txtComments_GotFocus()
txtComments.SelStart = 0
txtComments.SelLength = Len(txtComments.Text)
End Sub

Private Sub txtEmail_GotFocus()
txtEmail.SelStart = 0
txtEmail.SelLength = Len(txtEmail.Text)
End Sub

Private Sub txtFirst_GotFocus()
txtFirst.SelStart = 0
txtFirst.SelLength = Len(txtFirst.Text)
End Sub

Private Sub txtLast_GotFocus()
txtLast.SelStart = 0
txtLast.SelLength = Len(txtLast.Text)
End Sub

Private Sub txtPhone_GotFocus()
txtPhone.SelStart = 0
txtPhone.SelLength = Len(txtPhone.Text)
End Sub

Private Sub txtState_GotFocus()
txtState.SelStart = 0
txtState.SelLength = Len(txtState.Text)
End Sub

Private Sub txtZip_GotFocus()
txtZip.SelStart = 0
txtZip.SelLength = Len(txtZip.Text)
End Sub
Private Sub txtHp_GotFocus()
txtHp.SelStart = 0
txtHp.SelLength = Len(txtHp.Text)
End Sub

Nb:
Buat programm database (table) di MsAccess

Field Name Data Type
fname Text
lname Text
address Text
city Text
state Text
zip Text
phone Text
hp Text
comments Text
extra text

simpan dan beri nama :AddressDatabase

Membuat Program Shotdown,Restart dan LogOff dengan menggunakan VB

Buat 3 buah command dan beri nama command tersebut:
cmdLogOff,cmdRestart,cmdShutdown

dan ketik source code dibawah ini:

Private sub cmdLogOff_Click()
‘Log off windows XP
Shell “shutdown -l -f -t 0″
End sub

Private sub cmdRestart_click()
shell “shutdown -r -f -t 0″
end sub

Private sub cmdShutdown_click()
shell “shutdown -s -f -t 0″
end sub