» Unlabelled » Cara Membuat Aplikasi Kocok Arisan dengan VB6

Cara Membuat Aplikasi Kocok Arisan dengan VB6

Pada artikel kali ini saya akan membagikan sebuah tips bagaimana cara membuat aplikasi kocokan arisan dengan menggunakan VB6.

Buat Anda yang suka main arisan keluarga tidak ada salahnya mencoba dan menerapkan dengan membuatnya di visual basic agar arisan keluarga Anda terkesan lebih profesional dan modern dan tidak lagi menggunakan kocok secara manual.
Bagi Anda yang penasaran bagaimana cara membuat ikuti langkah-langkah berikut dibawah ini :

Cara Membuat Aplikasi Kocok Arisan dengan VB6


  • Buka FormVB6 Anda, pilih Standar EXE
  • Tanamkam dalam Form beberapa Label, 2 Listbox, 3 Commandbuton, 1 Textbox dan 2 Timer
  • Tambahkan 1 buah modul di Form dengan cara Project >> Add Module
  • Desainlah Form seperti gambar dibawah ini :

Desain Form



No Toll Box Properties Keterangan
1 Label1 Caption : Jumlah Peserta Form1
2 Label2 Caption :Yang Belum Form1
3Label3 Caption :Udah DapetForm1
4 Label4 Caption :Aplikasi Acak Nomor ArisanForm1
5Text1Name   : maks Form1
6 List1 Name : List1 Form1
7 List2 Name :List2Form1
8 Command1 Caption : Kocok
Name   : Command1		Form1
9 Command2 Caption :Set
Name    : cmd_reset		 Form1
10 Command3 Caption : Reset
Name    : cmd_reset		 Form1
11 Timer1 Interval  :20 Form1
12 Timer2 Interval  :50 Form1
13Label5 Caption : 
Name    : hasil
BackColor :Pilih hitam
Perbesar label seperti pada desain diatas 
dengan warna hitam		 Form1

  • Buatlah sebuah Database dengan MS.Access tujuannya agar nomor peserta arisan dapat disimpan untuk pengocokan berikutnya :

Nama Database : acak
Nama tabelnya : acak

Filed tabel tediri dari : angka dan status
Simpan database satu folder dengan form ini

Sesudah membuat tabel Database biarkan tabel kosong alias jangan diisi

Desain Database


Setelah Mendesain Form seperti diatas, ketik kode dibawah ini di bagian Module :

Public koneksi As New ADODB.Connection
Public rs As New Recordset
 
Sub Main()
    dbConnect_mdb App.path & "\acak.mdb"
    Form1.Show
End Sub
 
Public Sub dbConnect_mdb(path As String)
    Dim askConn As Integer
    On Error GoTo errHandler
     
    koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Persist Security Info=False"
    koneksi.CursorLocation = adUseClient
 
    Exit Sub
errHandler:
    askConn = MsgBox("Koneksi MDB tidak dapat dilakukan, " & Err.Description & vbCrLf & _
                     "Cek kembali parameter nama server, User ID dan password yang diinputkan." & vbCrLf & _
                     "Anda akan melakukan koneksi kembali ?", vbInformation + vbYesNo, "Kesalahan Koneksi")
    If askConn = vbYes Then Main Else End
End Sub

Public Sub Use(SQL As String)
Dim Pesan As String
On Error GoTo er
    Set rs = Nothing
    rs.Open SQL, koneksi, adOpenDynamic, adLockOptimistic
Exit Sub

er:
Clipboard.SetText Err.Number
Select Case Err.Number
Case -2147217904
  Pesan = "Ada nama field yg salah/ga ada, cek lagi deh !!"
Case -2147217900
  If VBA.Trim(VBA.UCase(SQL)) Like "*SELEC*" Then
      Pesan = "Ada kesalahan dalam syntax SQL SELECT nya, cek lagi deh !!!"
  Else
      Pesan = "Nama Tabel tidak ada, atau  cek lagi deh !!"
  End If
Case -2147217913
  Pesan = "Type data tidak sesuai, harusnya string tapi diisi numerik" & vbCrLf & "Cek lagi, mungkin ada field berisi angka tapi bertipe string/text jadi anda tetep harus pake tanda petik"
Case Else
  Pesan = Err.Description
End Select
 
End Sub

Sub Reset(frm As Form)
    Dim ctrl As Control
    For Each ctrl In frm
        If TypeOf ctrl Is TextBox Then ctrl.text = ""
        If TypeOf ctrl Is ComboBox Then ctrl.text = ""
    Next
End Sub

Public Sub PakeKoma(text As TextBox, digit As Integer)
    Dim mask As String
    
    With text
    .SelStart = Len(.text)
    .Alignment = 1
    .MaxLength = 15
    
    If digit > 0 Then
       mask = "###" & "." & String(digit - 1, "#") & "0"
    Else
       mask = "###,###,##0"
    End If
    .text = Format(.text, mask)
    .Tag = Format(text, "#########")
    End With
End Sub

Public Sub GEDE(text As TextBox)
    text.SelStart = Len(text.text)
    text.text = UCase(text)
End Sub
 

Kembali ke Form, pada form lalu ketik kode berikut dibawahh ini :

Dim kk, nn, yy As Long

Private Sub cmd_set_Click()
On Error Resume Next
koneksi.Execute "delete from acak"

For i = 1 To Val(maks)
    koneksi.Execute "insert into acak values (" & i & ", 'N')"
Next
baca_sisa
Label6.Caption = maks.text
End Sub


Sub baca_sisa()
Use "select * from acak where status = 'N'"

List1.Clear
List2.Clear
While Not rs.EOF
  List1.AddItem rs!angka
  rs.MoveNext
Wend
If List1.ListCount > 0 Then cmd_set.Enabled = False
rs.Close

Use "select * from acak where status = 'Y'"
While Not rs.EOF
  List2.AddItem rs!angka
  rs.MoveNext
Wend
If List2.ListCount > 0 Then cmd_reset.Enabled = True
rs.Close
End Sub

Private Sub acak()
Use "select * from acak where status = 'N' ORDER BY RND(angka)"
If rs.EOF = False Then
    hasil = rs!angka
    koneksi.Execute ("update acak set status = 'Y' where angka = " & hasil)
Else
    hasil = "."
    MsgBox "Peserta sudah habis...", vbInformation, "Info"
End If
rs.Close
baca_sisa
End Sub

Private Sub cmd_reset_Click()
If MsgBox("Anda Yakin ???", vbQuestion + vbDefaultButton2, "RESET") = vbNo Then Exit Sub
koneksi.Execute "delete from acak"
List1.Clear
List2.Clear
hasil = ""
maks = ""
cmd_set.Enabled = True
cmd_reset.Enabled = False
Label6.Caption = 0
End Sub

Private Sub Command1_Click()
'acak  -- kalo pengen langsung tanpa animasi.. ilangin centangnya
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
dbConnect_mdb App.path & "\acak.mdb"
List1.Clear
List2.Clear
hasil = ""
maks = ""
cmd_set.Enabled = True
cmd_reset.Enabled = False
baca_sisa

End Sub

Sub animasi()
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
kk = kk + 1


If nn < List1.ListCount - 1 Then
    nn = nn + 1
    hasil = List1.List(nn)
Else
    nn = 0
    hasil = List1.List(nn)
End If

If kk > 30 Then
    kk = 0
    Timer1.Enabled = False
    acak
    Timer2.Enabled = True
End If
End Sub

Private Sub Timer2_Timer()
If yy < 12 Then
    yy = yy + 1
    hasil.BackColor = QBColor(yy)
Else
    yy = 0
    hasil.BackColor = vbBlack
    Timer2.Enabled = False
End If

End Sub

Kemudian Jalankan Program Anda dan contoh hasilnya akan tampak pada gambar dibawah ini



Output Program

Cara Pengoperasian :
Masukan Jumlah peserta arisan pada texbox kosong lalu tekan "SET", maka jumlah peserta arisan akan terisi pada Listbox1
Untuk menentukan siapa yang akan mendapatkan arisan  tekan "KOCOK", maka slah peserta yang keluar akan terisi di Listbox2

Catatan:
Angka yang Anda sudah KOCOK tidak akan hilang walaupun Anda matikan komputernya karena sudah tersimpan ke Database dan Anda bisa lanjutkan untuk pengocokan berikutnya.

Demikianlah artikel dari tentang saya Cara Membuat Aplikasi Kocok Arisan dengan VB6.Semoga artikel ini bermanft buat kita semua.Amin
Selamat mencoba semoga Sukses....

No comments:

Post a Comment