Braincode
11th November 2011, 02:17 PM
Agan yang master VB6 mau tanya source code ane gan......
ini codenya
Code:
Option Explicit
Dim rstTrans As ADODB.Recordset
Public Sub LoadData()
Set rstTrans = New ADODB.Recordset
gstrSQL = "Select * From pelajaran"
gstrSQL = "Select A.idgm, A.idguru, B.nama As namaguru, A.idkelas AS idkelas, C.namakelas AS namakelas, A.idmatpel, D.matapelajaran " & vbCrLf _
& "From gurumatpel A " & vbCrLf _
& "Left Outer Join guru B On B.idguru = A.idguru " & vbCrLf _
& "Left Outer Join kelas C On C.idkelas = A.idkelas " & vbCrLf _
& "Left Outer Join matpel D On D.idmatpel = A.idmatpel " & vbCrLf _
& "Order By A.idgm, A.idguru, A.idkelas, A.idmatpel "
Set rstTrans = Cn.Execute(gstrSQL)
Set dgrData.DataSource = rstTrans
End Sub
Private Sub btnAdd_Click()
frmCreate.pTransJns = "ADD"
frmCreate.Show
End Sub
Private Sub btnEdit_Click()
If rstTrans.State = adStateClosed Then
MsgBox "Data kosong"
Exit Sub
End If
If (rstTrans.BOF And rstTrans.EOF) Then
MsgBox "Data kosong"
Exit Sub
End If
frmCreate.pTransJns = "EDIT"
frmCreate.pTransID = rstTrans![idgm]
frmCreate.Show
End Sub
Private Sub btnExit_Click()
End
End Sub
Private Sub Form_Load()
If IsConnectDB("localhost", "root", "", "akademik") = False Then
MsgBox "Tidak terkoneksi"
End
Exit Sub
End If
Call LoadData
End Sub
Penampakannya gini gan
http://u.kaskus.us/4/kqq4atbv.jpg
yang ke dua ini gan kodenya
Code:
Option Explicit
Public pTransJns As String
Public pTransID As String
Dim rstGuru As ADODB.Recordset
Dim rstKelas As ADODB.Recordset
Dim rstMatPel As ADODB.Recordset
Dim rstTrans As ADODB.Recordset
Private Sub loadGuru()
Set rstGuru = New ADODB.Recordset
If rstGuru.State = adStateOpen Then rstGuru.Close
gstrSQL = "Select idguru, nip, nama, alamat From guru"
Set rstGuru = Cn.Execute(gstrSQL)
Set dcbGuru.RowSource = rstGuru
dcbGuru.ListField = "nama"
dcbGuru.DataField = "idguru"
dcbGuru.BoundColumn = "idguru"
dcbGuru.BoundText = vbNullString
End Sub
Private Sub loadKelas()
Set rstKelas = New ADODB.Recordset
If rstKelas.State = adStateOpen Then rstKelas.Close
gstrSQL = "Select idkelas, nama, jurusan From kelas"
Set rstKelas = Cn.Execute(gstrSQL)
Set dcbKelas.RowSource = rstKelas
dcbKelas.ListField = "nama"
dcbKelas.DataField = "idkelas"
dcbKelas.BoundColumn = "idkelas"
dcbKelas.BoundText = vbNullString
End Sub
Private Sub loadTrans()
Set rstTrans = New ADODB.Recordset
If rstTrans.State = adStateOpen Then rstTrans.Close
gstrSQL = "Select A.idgm, A.idguru, A.kelas, A.idmatpel " & vbCrLf _
& "From gurumatpel A " & vbCrLf _
& "Left Outer Join Kelas B On B.namakelas = A.kelas " & vbCrLf _
& "Where idgm = '" & pTransID & "'"
Set rstTrans = Cn.Execute(gstrSQL)
If Not (rstTrans.BOF And rstTrans.EOF) Then
txtID.Text = rstTrans![idgm]
If IsNull(rstTrans![idguru]) Then
dcbGuru.BoundText = vbNullString
Else
dcbGuru.BoundText = rstTrans![idguru]
End If
If IsNull(rstTrans![kelas]) Then
cboKelas.ListIndex = -1
Else
cboKelas.Text = rstTrans![kelas]
End If
If IsNull(rstTrans![idmatpel]) Then
dcbMatPel.BoundText = vbNullString
Else
dcbMatPel.BoundText = rstTrans![idmatpel]
End If
Else
txtID.Text = vbNullString
dcbGuru.BoundText = vbNullString
cboKelas.ListIndex = -1
dcbMatPel.BoundText = vbNullString
End If
If UCase$(pTransJns) = "ADD" Then
txtID.Locked = False
Else
txtID.Locked = True
End If
End Sub
Private Sub clearComponent()
dcbGuru.BoundText = vbNullString
cboKelas.ListIndex = -1
dcbMatPel.BoundText = vbNullString
pTransID = vbNullString
End Sub
Private Sub btnClose_Click()
Unload Me
End Sub
'---------------------------------------------------------------------------------------
' Procedure : btnSave_Click
' Author : admin
' Date : 5/7/2010
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub btnSave_Click()
On Error GoTo btnSave_Click_Error
If txtID.Text = vbNullString Then
MsgBox "Isi ID"
txtID.SetFocus
Exit Sub
End If
If dcbGuru.BoundText = vbNullString Then
MsgBox "Pilih Guru"
dcbGuru.SetFocus
Exit Sub
End If
If cboKelas.Text = vbNullString Then
MsgBox "Pilih Kelas"
cboKelas.SetFocus
Exit Sub
End If
If dcbMatPel.BoundText = vbNullString Then
MsgBox "Pilih MatPel"
dcbMatPel.SetFocus
Exit Sub
End If
If UCase$(pTransJns) = "ADD" Then
gstrSQL = "Insert Into gurumatpel (idguru, kelas, idmatPel) Values ('" & dcbGuru.BoundText & "', '" & cboKelas.Text & "', '" & dcbMatPel.BoundText & "')"
Cn.Execute (gstrSQL)
ElseIf UCase$(pTransJns) = "EDIT" Then
gstrSQL = "Update gurumatpel Set idguru = '" & dcbGuru.BoundText & "', kelas = '" & cboKelas.Text & "', idmatpel = '" & dcbMatPel.BoundText & "' Where idgm = '" & pTransID & "'"
Cn.Execute (gstrSQL)
End If
txtID.Locked = True
pTransJns = "EDIT"
frmView.LoadData
MsgBox "Sukses..."
On Error GoTo 0
Exit Sub
btnSave_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure btnSave_Click of Form frmCreate"
End Sub
Private Sub Form_Load()
If UCase$(pTransJns) = "ADD" Then
Call loadGuru
Call loadKelas
'Call loadMatPel
Call clearComponent
ElseIf UCase$(pTransJns) = "EDIT" Then
Call loadGuru
Call loadKelas
'Call loadMatPel
Call loadTrans
End If
End Sub
Penampakannya ini gan
http://u.kaskus.us/4/peteddfy.jpg
ini kode mudulnya
Code:
Option Explicit
Public gstrSQL As String
Public Cn As New ADODB.Connection
Public Function IsConnectDB(ByVal psServer As String, ByVal psUser As String, ByVal psPass As String, ByVal psDB As String) As Boolean
On Error GoTo isConnectDB_Error
IsConnectDB = False
Dim strConn As String
Set Cn = New ADODB.Connection
Cn.CursorLocation = adUseClient
'strConn = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & psServer & "; UID=" & psUser & "; PWD=" & psPass & "; DATABASE=" & psDB & "; PORT=3306; OPTION=3 "
strConn = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & psServer & ";DATABASE=" & psDB & ";UID=" & psUser & ";PWD=" & psPass & ";PORT=3306;OPTION=3"
With Cn
.ConnectionString = strConn
.Open
End With
IsConnectDB = True
On Error GoTo 0
Exit Function
isConnectDB_Error:
MsgBox "Gak connect..."
End Function
errornya kayak gini gan
http://u.kaskus.us/4/eytlpmqx.jpg
error yang ada merah-merahnya,,,
ini databasenya namanya akademik, tabel yang dipakek guru,kelas,matpel
tolong ya gan,,,nanti pasti dikasih :melonndan:
:loveindonesia:loveindonesia:loveindonesia
</div>
ini codenya
Code:
Option Explicit
Dim rstTrans As ADODB.Recordset
Public Sub LoadData()
Set rstTrans = New ADODB.Recordset
gstrSQL = "Select * From pelajaran"
gstrSQL = "Select A.idgm, A.idguru, B.nama As namaguru, A.idkelas AS idkelas, C.namakelas AS namakelas, A.idmatpel, D.matapelajaran " & vbCrLf _
& "From gurumatpel A " & vbCrLf _
& "Left Outer Join guru B On B.idguru = A.idguru " & vbCrLf _
& "Left Outer Join kelas C On C.idkelas = A.idkelas " & vbCrLf _
& "Left Outer Join matpel D On D.idmatpel = A.idmatpel " & vbCrLf _
& "Order By A.idgm, A.idguru, A.idkelas, A.idmatpel "
Set rstTrans = Cn.Execute(gstrSQL)
Set dgrData.DataSource = rstTrans
End Sub
Private Sub btnAdd_Click()
frmCreate.pTransJns = "ADD"
frmCreate.Show
End Sub
Private Sub btnEdit_Click()
If rstTrans.State = adStateClosed Then
MsgBox "Data kosong"
Exit Sub
End If
If (rstTrans.BOF And rstTrans.EOF) Then
MsgBox "Data kosong"
Exit Sub
End If
frmCreate.pTransJns = "EDIT"
frmCreate.pTransID = rstTrans![idgm]
frmCreate.Show
End Sub
Private Sub btnExit_Click()
End
End Sub
Private Sub Form_Load()
If IsConnectDB("localhost", "root", "", "akademik") = False Then
MsgBox "Tidak terkoneksi"
End
Exit Sub
End If
Call LoadData
End Sub
Penampakannya gini gan
http://u.kaskus.us/4/kqq4atbv.jpg
yang ke dua ini gan kodenya
Code:
Option Explicit
Public pTransJns As String
Public pTransID As String
Dim rstGuru As ADODB.Recordset
Dim rstKelas As ADODB.Recordset
Dim rstMatPel As ADODB.Recordset
Dim rstTrans As ADODB.Recordset
Private Sub loadGuru()
Set rstGuru = New ADODB.Recordset
If rstGuru.State = adStateOpen Then rstGuru.Close
gstrSQL = "Select idguru, nip, nama, alamat From guru"
Set rstGuru = Cn.Execute(gstrSQL)
Set dcbGuru.RowSource = rstGuru
dcbGuru.ListField = "nama"
dcbGuru.DataField = "idguru"
dcbGuru.BoundColumn = "idguru"
dcbGuru.BoundText = vbNullString
End Sub
Private Sub loadKelas()
Set rstKelas = New ADODB.Recordset
If rstKelas.State = adStateOpen Then rstKelas.Close
gstrSQL = "Select idkelas, nama, jurusan From kelas"
Set rstKelas = Cn.Execute(gstrSQL)
Set dcbKelas.RowSource = rstKelas
dcbKelas.ListField = "nama"
dcbKelas.DataField = "idkelas"
dcbKelas.BoundColumn = "idkelas"
dcbKelas.BoundText = vbNullString
End Sub
Private Sub loadTrans()
Set rstTrans = New ADODB.Recordset
If rstTrans.State = adStateOpen Then rstTrans.Close
gstrSQL = "Select A.idgm, A.idguru, A.kelas, A.idmatpel " & vbCrLf _
& "From gurumatpel A " & vbCrLf _
& "Left Outer Join Kelas B On B.namakelas = A.kelas " & vbCrLf _
& "Where idgm = '" & pTransID & "'"
Set rstTrans = Cn.Execute(gstrSQL)
If Not (rstTrans.BOF And rstTrans.EOF) Then
txtID.Text = rstTrans![idgm]
If IsNull(rstTrans![idguru]) Then
dcbGuru.BoundText = vbNullString
Else
dcbGuru.BoundText = rstTrans![idguru]
End If
If IsNull(rstTrans![kelas]) Then
cboKelas.ListIndex = -1
Else
cboKelas.Text = rstTrans![kelas]
End If
If IsNull(rstTrans![idmatpel]) Then
dcbMatPel.BoundText = vbNullString
Else
dcbMatPel.BoundText = rstTrans![idmatpel]
End If
Else
txtID.Text = vbNullString
dcbGuru.BoundText = vbNullString
cboKelas.ListIndex = -1
dcbMatPel.BoundText = vbNullString
End If
If UCase$(pTransJns) = "ADD" Then
txtID.Locked = False
Else
txtID.Locked = True
End If
End Sub
Private Sub clearComponent()
dcbGuru.BoundText = vbNullString
cboKelas.ListIndex = -1
dcbMatPel.BoundText = vbNullString
pTransID = vbNullString
End Sub
Private Sub btnClose_Click()
Unload Me
End Sub
'---------------------------------------------------------------------------------------
' Procedure : btnSave_Click
' Author : admin
' Date : 5/7/2010
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub btnSave_Click()
On Error GoTo btnSave_Click_Error
If txtID.Text = vbNullString Then
MsgBox "Isi ID"
txtID.SetFocus
Exit Sub
End If
If dcbGuru.BoundText = vbNullString Then
MsgBox "Pilih Guru"
dcbGuru.SetFocus
Exit Sub
End If
If cboKelas.Text = vbNullString Then
MsgBox "Pilih Kelas"
cboKelas.SetFocus
Exit Sub
End If
If dcbMatPel.BoundText = vbNullString Then
MsgBox "Pilih MatPel"
dcbMatPel.SetFocus
Exit Sub
End If
If UCase$(pTransJns) = "ADD" Then
gstrSQL = "Insert Into gurumatpel (idguru, kelas, idmatPel) Values ('" & dcbGuru.BoundText & "', '" & cboKelas.Text & "', '" & dcbMatPel.BoundText & "')"
Cn.Execute (gstrSQL)
ElseIf UCase$(pTransJns) = "EDIT" Then
gstrSQL = "Update gurumatpel Set idguru = '" & dcbGuru.BoundText & "', kelas = '" & cboKelas.Text & "', idmatpel = '" & dcbMatPel.BoundText & "' Where idgm = '" & pTransID & "'"
Cn.Execute (gstrSQL)
End If
txtID.Locked = True
pTransJns = "EDIT"
frmView.LoadData
MsgBox "Sukses..."
On Error GoTo 0
Exit Sub
btnSave_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure btnSave_Click of Form frmCreate"
End Sub
Private Sub Form_Load()
If UCase$(pTransJns) = "ADD" Then
Call loadGuru
Call loadKelas
'Call loadMatPel
Call clearComponent
ElseIf UCase$(pTransJns) = "EDIT" Then
Call loadGuru
Call loadKelas
'Call loadMatPel
Call loadTrans
End If
End Sub
Penampakannya ini gan
http://u.kaskus.us/4/peteddfy.jpg
ini kode mudulnya
Code:
Option Explicit
Public gstrSQL As String
Public Cn As New ADODB.Connection
Public Function IsConnectDB(ByVal psServer As String, ByVal psUser As String, ByVal psPass As String, ByVal psDB As String) As Boolean
On Error GoTo isConnectDB_Error
IsConnectDB = False
Dim strConn As String
Set Cn = New ADODB.Connection
Cn.CursorLocation = adUseClient
'strConn = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & psServer & "; UID=" & psUser & "; PWD=" & psPass & "; DATABASE=" & psDB & "; PORT=3306; OPTION=3 "
strConn = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & psServer & ";DATABASE=" & psDB & ";UID=" & psUser & ";PWD=" & psPass & ";PORT=3306;OPTION=3"
With Cn
.ConnectionString = strConn
.Open
End With
IsConnectDB = True
On Error GoTo 0
Exit Function
isConnectDB_Error:
MsgBox "Gak connect..."
End Function
errornya kayak gini gan
http://u.kaskus.us/4/eytlpmqx.jpg
error yang ada merah-merahnya,,,
ini databasenya namanya akademik, tabel yang dipakek guru,kelas,matpel
tolong ya gan,,,nanti pasti dikasih :melonndan:
:loveindonesia:loveindonesia:loveindonesia
</div>