SAMPLE DATABASE 1 (SOURCE CODE)

Lanjutkan posting contoh database, sekarang saya lampirkan sourcecode nya. sebelumnya di komputer harus sudah diinstall Microsoft Office minimal versi 2007. yang mutlak harus ada Acess dan Excel. karena contoh program menggunakan database acess dan excel sebagai print out nya.

Harus diinport referencess Microsoft Excel 12.0 Object Library

Kelebihan program ini adalah :

1. Daftar datanya bisa discroll menggunakan mouse (ada tambahan kode program untuk aktifkan scroll msflexgrid).
2. MsFlexgrid bisa di edit langsung, menggunakan textbox dan combobox. 

Berikut sourcecode yang saya buat. semoga bermanfaat.


'Form 1 source code.........................................................................................................................
Private Sub DataFG_Click()
TxtEdit.Visible = False
FrameTambah.Visible = False
End Sub


Private Sub DataFG_DblClick()
DataFG_KeyPress 13
End Sub

Private Sub DataFG_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   If FrameTambah.Visible = True Then Exit Sub
   If DataFG.Enabled = False Then Exit Sub
   If DataFG.Rows <= 0 Then Exit Sub
 
   EditorFG
End If
End Sub
Sub EditorFG()
            TxtEdit.Left = DataFG.CellLeft + DataFG.Left
            TxtEdit.Top = DataFG.CellTop + DataFG.Top
            TxtEdit.Width = DataFG.CellWidth
            TxtEdit.Height = DataFG.CellHeight
         
            TxtEdit.Visible = True
            TxtEdit.Text = DataFG.Text
            TxtEdit.SetFocus
            DoEvents          
End Sub

Private Sub DataFG_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Ndt As String
Dim Nno As String
Dim N As Integer

If KeyCode = 46 Then 'delete
   If DataFG.Rows <= 1 Then Exit Sub
 
   N = DataFG.Row
   Ndt = DataFG.TextMatrix(N, 1)
   Nno = DataFG.TextMatrix(DataFG.Row, 4)
 
   If MsgBox("Hapus data " & Ndt, vbYesNo + vbQuestion, "Delete") = vbNo Then Exit Sub
   DATA1.RecordSource = "select * from alamat where id=" & Nno
   DATA1.Refresh
   If DATA1.Recordset.RecordCount > 0 Then DATA1.Recordset.Delete
   txtCari_KeyUp 0, 0
   DataFG.SetFocus
End If
End Sub

Private Sub DataFG_Scroll()
TxtEdit.Visible = False
FrameTambah.Visible = False
End Sub

Private Sub Form_Activate()
tmrLoad.Enabled = True
End Sub

Private Sub Form_Load()
FrameTambah.Top = DataFG.Top + DataFG.Height + 50
FrameTambah.Left = DataFG.Left
FrameTambah.Visible = False
LblJml.Caption = "0"
txtCari.Text = ""
End Sub



Private Sub Form_Unload(Cancel As Integer)
If DataFG.Enabled = False Then
   Cancel = 1
  Else
  Call WheelUnHook(Me.hwnd)
  Cancel = 0
End If
End Sub

Private Sub ImageExport_Click()
If DataFG.Enabled = False Then Exit Sub

Frameexport.Visible = True
DataFG.Enabled = False
txtCari.Enabled = False

EXPORT_DATA

Frameexport.Visible = False
txtCari.Enabled = True
DataFG.Enabled = True

End Sub

Private Sub ImageTambah_Click()
If DataFG.Enabled = False Then Exit Sub

TXTtambah(0).Text = ""
TXTtambah(1).Text = ""
TXTtambah(2).Text = ""
DataFG.Enabled = False

FrameTambah.Visible = True
TXTtambah(0).SetFocus

End Sub

Private Sub tmrLoad_Timer()
tmrLoad.Enabled = False
If tmrLoad.Tag = "1" Then Exit Sub
tmrLoad.Tag = "1" 'just load
ConnectDBS

Call DataFG_Fill("SELECT * FROM ALAMAT ORDER BY NAMA")
Call WheelHook(Me.hwnd)

End Sub

Private Sub txtCari_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Zdt As String
If KeyCode = 27 Then Exit Sub
If DataFG.Enabled = False Then Exit Sub

txtCari.Locked = True
Zdt = "select * from alamat where " & _
         " nama like '%" & txtCari.Text & "%'  or " & _
         " telepon like '%" & txtCari.Text & "%' or " & _
        " alamat like '%" & txtCari.Text & "%' "
DataFG_Fill Zdt

txtCari.Locked = False

End Sub

Private Sub TxtEdit_GotFocus()
TxtEdit.SetFocus
TxtEdit.SelStart = 0
TxtEdit.SelLength = Len(TxtEdit.Text)
End Sub

Private Sub TxtEdit_KeyPress(KeyAscii As Integer)
Dim Ndt As Double

If KeyAscii = 27 Then
   TxtEdit.Visible = False
   DataFG.SetFocus
   Exit Sub
 
End If

If KeyAscii = 13 Then
   TxtEdit.Text = UCase(TxtEdit.Text)
   TxtEdit.Text = Replace(TxtEdit.Text, "%", "")
   TxtEdit.Text = Replace(TxtEdit.Text, "\", "")
   TxtEdit.Text = Replace(TxtEdit.Text, "'", "")
   TxtEdit.Text = Replace(TxtEdit.Text, """", "")
   TxtEdit.Text = Replace(TxtEdit.Text, "*", "")

   Ndt = CDbl(DataFG.TextMatrix(DataFG.Row, 4))
   If DataFG.Col = 1 Then 'nama
      DATA1.RecordSource = "select * from alamat where id=" & Ndt
      DATA1.Refresh
      If DATA1.Recordset.RecordCount > 0 Then
         DATA1.Recordset.Fields("Nama") = TxtEdit.Text
         DATA1.Recordset.Update
         DataFG.Text = TxtEdit.Text
      End If
   
   End If
 
 
   If DataFG.Col = 2 Then 'nama
      DATA1.RecordSource = "select * from alamat where id=" & Ndt
      DATA1.Refresh
      If DATA1.Recordset.RecordCount > 0 Then
         DATA1.Recordset.Fields("telepon") = TxtEdit.Text
         DATA1.Recordset.Update
         DataFG.Text = TxtEdit.Text
      End If
   
   End If
 
   If DataFG.Col = 3 Then 'alamat
      DATA1.RecordSource = "select * from alamat where id=" & Ndt
      DATA1.Refresh
      If DATA1.Recordset.RecordCount > 0 Then
         DATA1.Recordset.Fields("alamat") = TxtEdit.Text
         DATA1.Recordset.Update
         DataFG.Text = TxtEdit.Text
      End If
   
   End If
 
   DataFG.TextMatrix(DataFG.Row, 4) = DATA1.Recordset.Fields("id")
    'DATA1.Recordset.Close
   TxtEdit.Visible = False
   DataFG.SetFocus
End If

End Sub

Private Sub TXTtambah_GotFocus(Index As Integer)
TXTtambah(Index).BackColor = &HFFFFFF



End Sub

Private Sub TXTtambah_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 27 Then
   FrameTambah.Visible = False
   DataFG.Enabled = True
End If


If KeyAscii = 13 Then
   If Index = 0 Then TXTtambah(1).SetFocus
   If Index = 1 Then TXTtambah(2).SetFocus
   If Index = 2 Then SimpanData
 
End If
End Sub
Sub SimpanData()
Dim A As Integer

With DATA1.Recordset
    .AddNew
    .Fields("nama") = TXTtambah(0).Text
    .Fields("alamat") = TXTtambah(1).Text
    .Fields("telepon") = TXTtambah(2).Text
 
    .Update
End With
A = DataFG.Rows
DataFG.Rows = A + 1
DataFG.TextMatrix(A, 0) = A
DataFG.TextMatrix(A, 1) = TXTtambah(0).Text
DataFG.TextMatrix(A, 2) = TXTtambah(1).Text
DataFG.TextMatrix(A, 3) = TXTtambah(2).Text
DataFG.TextMatrix(A, 4) = DATA1.Recordset.Fields("id")
TXTtambah(0).Text = ""
TXTtambah(1).Text = ""
TXTtambah(2).Text = ""
TXTtambah(0).SetFocus


End Sub
Private Sub TXTtambah_LostFocus(Index As Integer)
TXTtambah(Index).BackColor = &HE0E0E0
TXTtambah(Index).Text = UCase(TXTtambah(Index).Text)
TXTtambah(Index).Text = Replace(TXTtambah(Index).Text, "%", "")
TXTtambah(Index).Text = Replace(TXTtambah(Index).Text, "\", "")
TXTtambah(Index).Text = Replace(TXTtambah(Index).Text, "'", "")
TXTtambah(Index).Text = Replace(TXTtambah(Index).Text, """", "")
TXTtambah(Index).Text = Replace(TXTtambah(Index).Text, "*", "")


End Sub




' Here you can add scrolling support to controls that don't normally respond.
' This Sub could always be moved to a module to make scrollwheel behaviour
' generic across forms.
' ===========================================================================
Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
  Dim ctl As Control, cContainerCtl As Control
  Dim bHandled As Boolean
  Dim bOver As Boolean

  For Each ctl In Controls
    ' Is the mouse over the control
    On Error Resume Next
    bOver = (ctl.Visible And IsOver(ctl.hwnd, Xpos, Ypos))
    On Error GoTo 0

    If bOver Then
      ' If so, respond accordingly
      bHandled = True
      Select Case True

        Case TypeOf ctl Is MSFlexGrid
          FlexGridScroll ctl, MouseKeys, Rotation, Xpos, Ypos

        Case TypeOf ctl Is PictureBox, TypeOf ctl Is Frame
          Set cContainerCtl = ctl: bHandled = False

        Case TypeOf ctl Is ListBox, TypeOf ctl Is TextBox, TypeOf ctl Is ComboBox
          ' These controls already handle the mousewheel themselves, so allow them to:
          If ctl.Enabled Then ctl.SetFocus

        Case Else
          bHandled = False

      End Select
      If bHandled Then Exit Sub
    End If
    bOver = False
    'Debug.Print ctl.Name
  Next ctl

End Sub


'Module Session................................................................................
Option Explicit

' Store WndProcs
Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" ( _
                ByVal hwnd As Long, _
                ByVal lpString As String) As Long

Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" ( _
                ByVal hwnd As Long, _
                ByVal lpString As String, _
                ByVal hData As Long) As Long

Private Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" ( _
                ByVal hwnd As Long, _
                ByVal lpString As String) As Long

' Hooking
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
                ByVal lpPrevWndFunc As Long, _
                ByVal hwnd As Long, _
                ByVal Msg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long) As Long

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
                ByVal hwnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long

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

' Position Checking
Private Declare Function GetWindowRect Lib "user32" ( _
                ByVal hwnd As Long, _
                lpRect As RECT) As Long
             
Private Declare Function GetAncestor Lib "user32.dll" ( _
                ByVal hwnd As Long, _
                ByVal gaFlags As Long) As Long

Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private Const CB_GETDROPPEDSTATE = &H157
Private Const GA_ROOT = 2

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

' Check Messages
' ================================================
Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim MouseKeys As Long
  Dim Rotation As Long
  Dim Xpos As Long
  Dim Ypos As Long
  Dim fFrm As Form

  Select Case Lmsg

    Case WM_MOUSEWHEEL
 
      MouseKeys = wParam And 65535
      Rotation = wParam / 65536
      Xpos = lParam And 65535
      Ypos = lParam / 65536
   
      Set fFrm = GetForm(Lwnd)
      If fFrm Is Nothing Then
        ' it's not a form
        If Not IsOver(Lwnd, Xpos, Ypos) And IsOver(GetAncestor(Lwnd, GA_ROOT), Xpos, Ypos) Then
          ' it's not over the control and is over the form,
          ' so fire mousewheel on form (if it's not a dropped down combo)
          If SendMessage(Lwnd, CB_GETDROPPEDSTATE, 0&, 0&) <> 1 Then
            GetForm(GetAncestor(Lwnd, GA_ROOT)).MouseWheel MouseKeys, Rotation, Xpos, Ypos
            Exit Function ' Discard scroll message to control
          End If
        End If
      Else
        ' it's a form so fire mousewheel
        If IsOver(fFrm.hwnd, Xpos, Ypos) Then fFrm.MouseWheel MouseKeys, Rotation, Xpos, Ypos
      End If
  End Select

  WindowProc = CallWindowProc(GetProp(Lwnd, "PrevWndProc"), Lwnd, Lmsg, wParam, lParam)
End Function

' Hook / UnHook
' ================================================
Public Sub WheelHook(ByVal hwnd As Long)
  On Error Resume Next
  SetProp hwnd, "PrevWndProc", SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub WheelUnHook(ByVal hwnd As Long)
  On Error Resume Next
  SetWindowLong hwnd, GWL_WNDPROC, GetProp(hwnd, "PrevWndProc")
  RemoveProp hwnd, "PrevWndProc"
End Sub

' Window Checks
' ================================================
Public Function IsOver(ByVal hwnd As Long, ByVal lX As Long, ByVal lY As Long) As Boolean
  Dim rectCtl As RECT
  GetWindowRect hwnd, rectCtl
  With rectCtl
    IsOver = (lX >= .Left And lX <= .Right And lY >= .Top And lY <= .Bottom)
  End With
End Function

Private Function GetForm(ByVal hwnd As Long) As Form
  For Each GetForm In Forms
    If GetForm.hwnd = hwnd Then Exit Function
  Next GetForm
  Set GetForm = Nothing
End Function

' Control Specific Behaviour
' ================================================
Public Sub FlexGridScroll(ByRef FG As MSFlexGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
  Dim NewValue As Long
  Dim Lstep As Single

  On Error Resume Next
  With FG
'    Lstep = .Height / .RowHeight(0)
'    Lstep = Int(Lstep)
'    If .Rows < Lstep Then Exit Sub
'    Do While Not (.RowIsVisible(.TopRow + Lstep))
'      Lstep = Lstep - 1
'    Loop
'
    Lstep = 1
    If Rotation > 0 Then
        NewValue = .TopRow - Lstep
        If NewValue < 1 Then
            NewValue = 1
        End If
    Else
        NewValue = .TopRow + Lstep
        If NewValue > .Rows - 1 Then
            NewValue = .Rows - 1
        End If
    End If
    .TopRow = NewValue
  End With
End Sub

Public Sub PictureBoxZoom(ByRef picBox As PictureBox, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
  picBox.Cls
  picBox.Print "MouseWheel " & IIf(Rotation < 0, "Down", "Up")
End Sub


Sub ConnectDBS()
With Futama
    .DATA1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DATA.mdb;Mode=ReadWrite;Persist Security Info=False"
End With
End Sub

Sub DataFG_clear()
With Futama.DataFG
    .Clear
    .Cols = 5
    .Rows = 1
 
    .Col = 0
    .Font.Bold = True
    .TextMatrix(0, 0) = "NO"
    .ColWidth(0) = 500
    .ColAlignment(0) = flexAlignLeftCenter
 
 
    .Col = 1
    .Font.Bold = True
    .TextMatrix(0, 1) = "NAMA"
    .ColWidth(1) = 3000
    .ColAlignment(1) = flexAlignLeftCenter
 
 
    .Col = 2
    .Font.Bold = True
    .TextMatrix(0, 2) = "NO TLP / HP"
    .ColWidth(2) = 3000
    .ColAlignment(2) = flexAlignLeftCenter
 
 
    .Col = 3
    .Font.Bold = True
    .TextMatrix(0, 3) = "ALAMAT"
    .ColWidth(3) = 3000
    .ColAlignment(3) = flexAlignLeftCenter
 
    .Col = 4
    .TextMatrix(0, 4) = "id"
    .ColWidth(4) = 0
    .Font.Bold = True
    .ColAlignment(4) = flexAlignLeftCenter
 
End With

End Sub


Sub DataFG_Fill(Nsql As String)
Dim A, X As Integer

DataFG_clear
With Futama
    '.Data1.Connect = "Excel 8.0;"
    '.Data1.DatabaseName = App.Path & "\data.xls"
    .DATA1.RecordSource = Nsql
    .DATA1.Refresh
    .LblJml.Caption = Format(.DATA1.Recordset.RecordCount, "#,##0")
    A = 1
    If .DATA1.Recordset.RecordCount > 0 Then .DATA1.Recordset.MoveFirst
    While Not .DATA1.Recordset.EOF
           A = .DataFG.Rows
          .DataFG.Rows = A + 1
         ' MsgBox .Data1.Recordset.Fields(0).Name
          .DataFG.TextMatrix(A, 0) = A 'no
          'If .DATA1.Recordset.Fields(1) <> "" Then .DataFG.TextMatrix(A, 1) = .DATA1.Recordset.Fields(1) 'no
          If .DATA1.Recordset.Fields(2) <> "" Then .DataFG.TextMatrix(A, 1) = .DATA1.Recordset.Fields(2)
          If .DATA1.Recordset.Fields(3) <> "" Then .DataFG.TextMatrix(A, 2) = .DATA1.Recordset.Fields(3)
          If .DATA1.Recordset.Fields(4) <> "" Then .DataFG.TextMatrix(A, 3) = .DATA1.Recordset.Fields(4)
          If .DATA1.Recordset.Fields(0) <> "" Then .DataFG.TextMatrix(A, 4) = .DATA1.Recordset.Fields(0)
       
       
       
          .DATA1.Recordset.MoveNext
    Wend
End With

End Sub

Sub EXPORT_DATA()
Dim Tmp As String
Dim A, B As Integer
Dim App2a As Excel.Application
Dim Wb As Workbook
Dim Wk As Worksheet
Dim Baris As Long, Kolom As Integer
Dim X As Integer

'LblTOP(1).Caption = "Buka Excel Worksheet..."
DoEvents

Set App2a = Excel.Application

Set Wb = App2a.Workbooks.Add
Set Wk = Wb.Worksheets(1)

'
   Range("A1").Font.Size = 14
   Range("A1").Font.Bold = True
   Wk.Cells(1, 1).Value = "DATA ALAMAT"
   Wk.Columns(1).HorizontalAlignment = xlHAlignLeft
 
       
 
   Range("A3").Font.Size = 11
   Range("A3").Font.Bold = True
   Wk.Cells(3, 1).HorizontalAlignment = xlHAlignLeft
   Wk.Cells(3, 1).Value = "NO"
   Wk.Cells(3, 1).ColumnWidth = 5
 
   Range("B3").Font.Size = 11
   Range("B3").Font.Bold = True
   Wk.Cells(3, 2).HorizontalAlignment = xlHAlignLeft
   Wk.Cells(3, 2).Value = "NAMA"
   Wk.Cells(3, 2).ColumnWidth = 20
 
   Range("C3").Font.Size = 11
   Range("C3").Font.Bold = True
   Wk.Cells(3, 3).HorizontalAlignment = xlHAlignLeft
   Wk.Cells(3, 3).Value = "NO TLP / HP"
   Wk.Cells(6, 3).ColumnWidth = 20
 
   Range("D3").Font.Size = 11
   Range("D3").Font.Bold = True
   Wk.Cells(3, 4).HorizontalAlignment = xlHAlignLeft
   Wk.Cells(3, 4).Value = "ALAMAT"
   Wk.Cells(3, 4).ColumnWidth = 50
 
 
   Range("A3:D3").Interior.Color = RGB(127, 187, 199)

   Baris = 4
   Kolom = 1

  If Futama.DataFG.Rows <= 1 Then
     Futama.pb.Max = 10
    Else
     Futama.pb.Max = Futama.DataFG.Rows
  End If
  Futama.pb.Min = 0
  Futama.pb.Value = 0
  Futama.pb.Visible = True

  For X = 1 To Futama.DataFG.Rows - 1
      Futama.pb.Value = X
   
      DoEvents
   
      Wk.Cells(Baris, Kolom).Font.Name = "Arial Narrow"
      Wk.Cells(Baris, Kolom).Font.Size = 10
      Wk.Cells(Baris, Kolom).HorizontalAlignment = xlHAlignLeft
      Kolom = 1
       
      Wk.Cells(Baris, Kolom).Value = X
      Wk.Cells(Baris, Kolom).NumberFormat = "#,##0"
      Wk.Cells(Baris, Kolom).HorizontalAlignment = xlHAlignLeft
   
      Kolom = Kolom + 1
   
   
      Wk.Cells(Baris, Kolom).Value = Futama.DataFG.TextMatrix(X, 1)
      Wk.Cells(Baris, Kolom).HorizontalAlignment = xlHAlignLeft
      Kolom = Kolom + 1
   
      Wk.Cells(Baris, Kolom).Value = Futama.DataFG.TextMatrix(X, 2)
      Wk.Cells(Baris, Kolom).HorizontalAlignment = xlHAlignLeft
      Kolom = Kolom + 1
   
      Wk.Cells(Baris, Kolom).Value = Futama.DataFG.TextMatrix(X, 3)
      Wk.Cells(Baris, Kolom).HorizontalAlignment = xlHAlignLeft
      Kolom = Kolom + 1
   
   
   
      Baris = Baris + 1
   
  Next


App2a.Visible = True

Set Wk = Nothing
Set Wb = Nothing
Set App2a = Nothing

End Sub

'EOF..........................................................................................................................................

Anda boleh COPAS (copy & paste) kode diatas tanpa merubah judul dan pembuat program (d2n92.blogspot.com).

Silahkan download sourcecode data alamat

MSFLEXGRID LEBIH LANJUT ( EDITABLE MSFLEXGRID)

Flexgrid digunakan di pemrograman sebagai tempat menyimpan atau menampilkan data ke layar monitor, kelemahan komponen flexgrid ini adalah
1. Data yang ada di kolom flexgrid tidak bisa dirubah atau di edit.
2. Tidak berfungsinya scroll mouse, hal ini menyulitakan user dalam melihat data selanjutnya.

Pada kesempatan ini saya akan membuat contoh flexgrid yang bisa di edit datanya, dengan menggunakan textbox dan combobox untuk input datanya.

Berikut screenshotnya:

untuk edit data negara saya gunakan textbox, dan untuk edit data benua digunakan combobox. Penggunanan combobox disini untuk mempermudah user untuk memilih data, jadi user tidak harus mengetik nama benuanya.

cara untuk mengedit data negara, klik data yang akan diedit dan tekan tombol 'enter' di keyboard.
untuk mengedit data benua cukup klik datanya dan pilih nama benuanya.

Ada 2 tombol untuk mengurutan data.



Silahkan download sourcecode nya disini

SAMPLE DATABASE 1

Posting kali ini ane berbagi contoh membuat aplikasi database sederhana, tentunya menggunakan VB jadulnya..hehe.
Program ini sederhana, seperti buku telepon saja fungsinya. tidak penting-penting amat ini program justru cenderung terkesan iseng. tapi ga apa lah, yang penting bisa nostalgila dengan vb6 (nostalgia magsudnya hehe).

 Okay sekarang ane jelaskan cara pake nih program. Lihat screencapture programnya

1. Daftar datanya, komponennya pake msflexgrid
2. Tombol untuk menambah data ke daftar

    Pengisian data diakhiri dengan tombol 'enter', dan untuk menutup dialognya pakai tombol 'esc'.
    catatan: jika form input ini masih tampil, aplikasi tidak bisa ditutup pakai tombol exit(no 5).

3. Text untuk mencari data didaftar, bisa cari nama,no telepon dan alamat juga dalam satu textbox. tinggal          ketik saja nanti hasilnya akan di tampilkan di daftar.
 
4. Tombol untuk export data ke microsoft excel, jika akan diprint bisa diedit lagi hasil outputnya
5. Tombol exit...keterlaluan jika tidak tahu fungsinya....hehe...


Silahkan download file setupnya disini


Untuk kode programnya menyusul di posting berikutnya, semoga program alamat ini bermanfaat...amiiin.

Cara Koneksi VB6 Ke Database MySQL

Bagaimana caranya koneksikan vb6 ke database MySQL?.... itulah mungkin salah satu pertanyaan agan agan yang baru terjun ke dunia programming (masih gunakan vb jadulnya...hehe). kali ini saya akan share seputar cara koneksinya yang saya tahu saja. Sebenarnya pemrogramman pakai VB6 sekarang sudah banyak ditinggalkan karena beberapa alasan, tetapi untuk praktisnya masih masuk juga menjadi pemrogramman pembelajaran bagi pemula.

Alasan mengapa Visual Basic 6.0 ditinggalkan antara lain :

1. Waktu, tidak ada yang abadi ....hahaha... seiring waktu lambat laun berkurang pengguna vb6 ini, terutama yang sudah profesional mereka beralih ke versi yang lebih baru yaitu pemrogramman berbasis dotnet.
2. File objek/komponen yang harus diinstall jika didistribusikan, jika sudah jadi file exe aplikasinya tidak bisa di running begitu saja harus diikut sertakan juga file komponennya yang berbentuk OCX (Object Control Activex)...... kaya orang yang sedang tertimpa bencana alam harus ngepak barang barang pentingnya sebelum ngungsi...hehe.
3. Fungsi scroll mouse yang tidak berfungsi di komponen list data, seperti di datagrid dan flexgrid... bagi programmer database tentu tidak asing lagi bukan. walaupun bisa diakali dengan kode program menggunakan fungsi API, tapi hal ini menambah kerja kita.

Nah sekarang alasan kita masih pake vb6 jadul ini kenapa, mungkin :

1. Bahasa pemrogramman yang di rekomendasikan bagi para pemula, tahap belajar gan..... tapi waktu  zaman ane masih kuliah baru versi 5. pada waktu ane belajar pertama kalinya pemrogramman dikasih versi eyangnya QuickBasic.. versi ini berjalan di DOS... dan harus hapal betul sintax2 nya maklum semuanya pake kode diketik gan,... sekarang enak sudah berbasis grafik (GUI) tinggal drag, klik scroll.
2. Sebagai experiment pemrogramman yang melibatkan hardware, seperti microcontroller, sensor dsb. karena vb6 tidak terlalu menyita harddisk, waktu running nya juga terbilang cepat. 

Udah dulu ah tidak baik menilai sesuatu dari satu sudut pandang saja. apalagi pandangan ane...hehehe.

Sekarang ke intinya saja, cara koneksi mysql ke vb6 gan.

MySql ODBC Connector adalah sofware  yang fungsinya untuk koneksi ke file fisik database MySQL. jika agan belum punya sedot nih filenya,   DOWNLOAD... sebagai informasi saja ane pake mysql versi 5, jika belum punya juga boleh sedot lagi filenya disini.

Sekarang setting conneksi mysqlnya di control panel - Administrative Tools - Data Sources (ODBC)

klik "system DSN"

Isi sesuai kebutuhan agan agan sekalian:

Data Source Nama, isi nama koneksi mysqlnya. bebas isi nya gan.
Server, sumber database MySql yang akan di bikin koneksinya.
User, nama pengguna yang diizinkan server mysql
Password, karakter rahasia alias kuncinya supaya bisa masuk ke database server
Database, nama database tujuan, yang akan kita konek lewat vb6


catatan nih untuk setting isi Server, Jika database dilocal komputer textbox diisi dengan 'localhost' atau kosongkan saja, jika diambil dari jaringan maka isi text box dengan  alamat ip server atau nama komputer networknya.

Windows Firewall juga pengaruh loh.... non aktifkan saja Windows Firewall nya, atau masukkan port yang dipakai mysql. port standard unutk mysql adalah 3006.
caranya buka control panel - Windows Firewall






















langkah selanjutnya di mysql nya. database mana yang akan disharing?
di tutorial ini yang akan di sharing adalah database 'newdbs' user yang diijinkan akses database adalah 'user_name' dan passwordnya 'some_pass'. catatan : Database 'newdbs' diasumsikan sudah ada. jika tidak ada maka buat dulu databasenya.

grant untuk komputer mana yang bisa mengakses databse 'newdbs'. sepertinya repot kalau satusatu masukkan ip komputer yang bisa akses databse nya. solusinya pakai karakter wild card '%' supaya semua komputer bisa connect.

 perintah console mysqlnya sebagai berikut:

USE newdbs;
GRANT ALL ON newdbs.* TO 'user_name'@'%';
GRANT ALL ON newdbs TO 'user_name'@'%';
GRANT CREATE ON newdbs TO 'user_name'@'%';
FLUSH PRIVILEGES;

Selanjutnya setting untuk usernya sebagai berikut:
CREATE USER 'user_name'@'%' IDENTIFIED BY 'some_pass';
GRANT ALL PRIVILEGES ON *.* TO 'user_name'@'%' WITH GRANT OPTION;
FLUSH PRIVILEGES;

langkah terakhir stop dan start kembali mysql servernya, jika tidak tahu caranya restart saja...hehe

Alhamdulilah, sudah selesai... semoga bermanfaat...

       .

Numerik karakter yang bisa diinput di textbox

ini adalah trik vb6 untuk mencegah user input karakter selain numeric di textbox, kecuali enter,backspace dan escape.
tombol pengecualian diatas biasanya dipakai untuk event di object tersebut.
source codenya di tulis di event keypress,

Private Sub TxtKomisi_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 27 Then KeyAscii = 0

If KeyAscii = 27 Then Unload Me
If KeyAscii = 13 Then
   TxtDT(0).SetFocus
End If

End Sub

Cara Mudah Aktifkan Mouse Scroll di IDE VB 6.0

Hanya dengan double clik file exe nya saja untuk aktifkan fungsi scroll di IDE VB6.

Langsung saja download  disini

Semoga bermanfaat untuk para programmer yang masih memakai VB Clasic ini….