Sharing With Passion

December 11, 2013

Posted by Sabar Santoso in , , | December 11, 2013 No comments
Terdapat banyak cara untuk menampilkan beberapa field / tabel yang berbeda untuk di proses dalam sebuah halaman Vb 6.0. Bisa menggunakan listview, listbox, combo box, command button dan lain-lain. Kali ini saya akan mencoba mengambil field pada tabel dan database yang berbeda dengan menggunakan combo box. Berikut adalah salah satu contohnya :




Private Const CB_FINDSTRING = &H14C
Private Const CB_SHOWDROPDOWN = &H14F
Private Const LB_FINDSTRING = &H18F
Private Const CB_ERR = (-1)
Public KONEKSI As New ADODB.Connection

Private Declare Function SendMessage Lib _
    "user32" Alias "SendMessageA" (ByVal _
    hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) _
    As Long

Dim Rsbarang As New ADODB.Recordset
Dim Rskonsumen As New ADODB.Recordset

Public Sub bukakoneksi()
    Dim ConnString As String
    ConnString = "DSN=App_Toko_Eshi"
    Set KONEKSI = New ADODB.Connection
    KONEKSI.ConnectionString = ConnString
    KONEKSI.CursorLocation = adUseClient
    KONEKSI.Open
End Sub
Private Sub Form_Load()
    bukakoneksi
    Isi_Combo_konsumen
    Isi_Combo_Barang
End Sub

Private Sub CboNamaBarang_Click()
Rsbarang.Open "select id_barang, satuan, harga from tbl_barang where nama = '" & CboNamaBarang.Text & "'", KONEKSI, adOpenDynamic, adLockBatchOptimistic
   If Rsbarang.EOF = False Then  'Jika hasil query ada isinya maka..
      TxtNama.Text = "" & Rsbarang!id_barang
      TxtSatuan.Text = "" & Rsbarang!satuan
      TxtHarga.Text = "" & Rsbarang!harga
   Else
      MsgBox "Data Tidak Ada"
      kosong
End If
   Rsbarang.Close
   txtBeli.Enabled = True
End Sub

Private Sub CboNamaKonsumen_KeyPress(KeyAscii As Integer)
    Dim CB As Long
    Dim FindString As String  
    If KeyAscii < 32 Or KeyAscii > 127 Then Exit Sub
    If CboNamaKonsumen.SelLength = 0 Then
        FindString = CboNamaKonsumen.Text & Chr$(KeyAscii)
    Else
        FindString = Left$(CboNamaKonsumen.Text, CboNamaKonsumen.SelStart) & Chr$(KeyAscii)
    End If

    SendMessage CboNamaKonsumen.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
    CB = SendMessage(CboNamaKonsumen.hwnd, CB_FINDSTRING, -1, ByVal FindString)
   
    If CB <> CB_ERR Then
        CboNamaKonsumen.ListIndex = CB
        CboNamaKonsumen.SelStart = Len(FindString)
        CboNamaKonsumen.SelLength = Len(CboNamaKonsumen.Text) - CboNamaKonsumen.SelStart
    End If
   
    KeyAscii = 0
    CboNamaBarang.Enabled = True
End Sub

Private Sub CboNamaKonsumen_GotFocus()
    SendMessage CboNamaKonsumen.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
    CboNamaBarang.Enabled = True
End Sub

Private Sub CboNamaBarang_KeyPress(KeyAscii As Integer)
    Dim CB As Long
    Dim FindString As String
    If KeyAscii < 32 Or KeyAscii > 127 Then Exit Sub  
    If CboNamaBarang.SelLength = 0 Then
        FindString = CboNamaBarang.Text & Chr$(KeyAscii)
    Else
        FindString = Left$(CboNamaBarang.Text, CboNamaBarang.SelStart) & Chr$(KeyAscii)
    End If
    SendMessage CboNamaBarang.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
    CB = SendMessage(CboNamaBarang.hwnd, CB_FINDSTRING, -1, ByVal FindString)
   
    If CB <> CB_ERR Then
        CboNamaBarang.ListIndex = CB
        CboNamaBarang.SelStart = Len(FindString)
        CboNamaBarang.SelLength = Len(CboNamaBarang.Text) - CboNamaBarang.SelStart
    End If   
    KeyAscii = 0
End Sub

Private Sub CboNamaBarang_GotFocus()
    SendMessage CboNamaBarang.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
End Sub

Sub Isi_Combo_konsumen()
Rskonsumen.Open "select nama from tbl_konsumen", KONEKSI, adOpenDynamic, adLockBatchOptimistic
CboNamaKonsumen.Clear
While Not Rskonsumen.EOF
  CboNamaKonsumen.AddItem Rskonsumen!Nama
Rskonsumen.MoveNext
Wend
End Sub

Sub Isi_Combo_Barang()
      Dim Rsbarang As New ADODB.Recordset
      Rsbarang.Open "select nama from tbl_barang", KONEKSI, adOpenDynamic, adLockBatchOptimistic
      CboNamaBarang.Clear
            While Not Rsbarang.EOF
                    CboNamaBarang.AddItem Rsbarang!Nama
                    Rsbarang.MoveNext
            Wend
End Sub

0 comments:

Post a Comment

Silahkan Isi Komentar Anda :

Search

Bookmark Us

Delicious Digg Facebook Favorites More Stumbleupon Twitter