Permutasi

Option Explicit

Dim id As Integer
Dim N As Integer
Dim perm() As Integer

Function Engine(i As Integer)
Dim t As Integer
Dim j As Integer

id = id + 1
perm(i) = id
If (id = N) Then stampaj
For j = 1 To N
If (perm(j) = 0) Then
Engine (j)
End If
DoEvents
Next j
id = id - 1
perm(i) = 0
End Function

Private Sub cmdClear_Click()
List1.Clear
End Sub

Private Sub cmdGen_Click()
If Val(txtLength.Text) > Len(txtChar.Text) Then
MsgBox “Jumlah Permutasi Salah”
Exit Sub
End If

If Len(txtChar.Text) = 0 Or (Val(txtLength.Text) = 0) Then Exit Sub

Dim i As Integer
N = Val(txtLength.Text)
ReDim perm(N)
For i = 1 To N
perm(i) = 0
Next i
If ChSave.Value = 1 Then
MsgBox “Disimpan pada hasil.txt”
Open App.Path + “\hasil.txt” For Output As #1
End If
Engine 0
If ChSave.Value = 1 Then Close #1

End Sub

Sub Form_Load()
On Error Resume Next
id = -1

End Sub

Sub stampaj()
Dim i As Integer
Dim result As String
result = “”
For i = 1 To N
result = result & CStr(Mid$(txtChar.Text, perm(i), 1))
Next i
List1.AddItem result
If ChSave.Value = 1 Then Print #1, result
End Sub

Read More

Membuat Program Address Menggunakan VB

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

Read More

Visual Basic Program Menghitung lama Parkir

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

Read More