Gambar Menu Utama yg di atas
Ne listingnya :::
Menu Utama
Program Listingnya :
Dim strgun, lengun, n
Private Sub f1_Click()
fromjabatan.Show
End Sub
Private Sub f2_Click()
fromgolongan.Show
End Sub
Private Sub f3_Click()
Dim a As Integer
a = MsgBox("Anda yakin ingin keluar dari aplikasi ini ?", vbQuestion + vbYesNo, "Keluar")
If a = vbYes Then
End
End If
End Sub
Private Sub fkaryawan_Click()
Karyawan.Show
End Sub
Private Sub MDIForm_Load()
strgun = Me.Caption
n = 1
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
Dim tanya As Integer
tanya = MsgBox("Yakin ingin keluar dari aplikasi ini ?", vbQuestion + vbYesNo, "Keluar")
If tanya = vbYes Then
Cancel = 0
End
Else
Cancel = 1
End If
End Sub
Private Sub Timer1_Timer()
lengun = Len(strgun)
Dim Form As String
lengun = Len(strgun)
Me.Caption = Left(strgun, n) + "_"
n = n + 1
If n > lengun Then
n = 1
End If
End Sub
Ne Gambar form Jabatan Servernya
Ne jg ada program listingnya ===== >>> liat di bawah ya bro
Dim sql As String
Sub mati()
Me.kode.Enabled = False
Me.nama.Enabled = False
Me.tunjangan.Enabled = False
End Sub
Sub hidup()
Me.kode.Enabled = True
Me.nama.Enabled = True
Me.tunjangan.Enabled = True
End Sub
Sub hapus()
Me.kode.Enabled = True
clearform Me
Call aktifcmd(Me, True, False, False, False)
cmdproses(1).Caption = "&Simpan"
End Sub
Sub aktifserver()
ws.LocalPort = 1000
ws.Listen
End Sub
Sub prosesdb(log As Byte)
Select Case log
Case 0
If Me.kode.Text <> "" And Me.nama.Text <> "" And Me.tunjangan.Text <> "" Then
sql = "insert into jabatan(kode,nama,tunjangan)" & _
"values('" & Me.kode.Text & _
"','" & Me.nama.Text & _
"','" & Me.tunjangan.Text & "')"
db.Execute sql, adCmdTable
Adodc1.Refresh
db.BeginTrans
db.CommitTrans
MsgBox "Data telah di proses dengan baik", vbInformation, "Programmer"
Else
MsgBox "maaf masih ada data yang kosong", vbInformation, "Pesan"
Exit Sub
End If
Case 1
sql = "update jabatan set nama='" & Me.nama.Text & "'," & _
"tunjangan='" & Me.tunjangan.Text & "'" & _
"where kode='" & Me.kode.Text & "'"
db.Execute sql, adCmdTable
Adodc1.Refresh
db.BeginTrans
db.CommitTrans
MsgBox "Data telah di proses dengan baik", vbInformation, "Programmer"
Case 2
sql = "delete from jabatan where kode='" & Me.kode.Text & "'"
db.Execute sql, adCmdTable
Adodc1.Refresh
db.BeginTrans
db.CommitTrans
MsgBox "Data telah di proses dengan baik", vbInformation, "Programmer"
End Select
Call hapus
Me.kode.SetFocus
End Sub
Sub tampiljabatan()
On Error Resume Next
With rs
kode.Text = !kode
nama.Text = !nama
tunjangan.Text = !tunjangan
End With
End Sub
Private Sub cmdproses_Click(Index As Integer)
Select Case Index
Case 0
Call hapus
Call hidup
Me.kode.SetFocus
Adodc1.Refresh
Call aktifcmd(Me, False, True, True, True)
Case 1
If cmdproses(1).Caption = "&Simpan" Then
prosesdb 0
Else
prosesdb 1
End If
Adodc1.Refresh
Call hapus
Me.kode.SetFocus
Case 2
a = MsgBox("apakah anda yakin menghapus data ini?", vbQuestion + vbYesNo, "Programmer")
If a = vbYes Then prosesdb 2
Call hapus
Adodc1.Refresh
kode.SetFocus
Case 3
Call hapus
kode.SetFocus
Me.Adodc1.Refresh
Case 4
Unload Me
MsgBox "Thanks", vbInformation, "Keluar"
End Select
End Sub
Private Sub Form_Load()
Call opendb
Call hapus
Call mati
aktifserver
End Sub
Private Sub ws_ConnectionRequest(ByVal requestID As Long)
ws.Close
ws.Accept requestID
Me.Caption = "Server - Client " & ws.RemoteHostIP & " Connect"
End Sub
Private Sub kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If kode.Text = "" Then
MsgBox "Kode Tak bolah kosong", vbInformation, "Programmer"
Me.kode.SetFocus
Exit Sub
End If
sql = "select * from jabatan where kode='" & Me.kode.Text & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open sql, db, adOpenDynamic, adLockOptimistic
If rs.RecordCount <> 0 Then
tampiljabatan
Call aktifcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&Edit"
Me.kode.Enabled = False
Else
b = kode.Text
kode.Text = b
Call aktifcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&Simpan"
End If
nama.SetFocus
End If
End Sub
Private Sub nama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.tunjangan.SetFocus
End If
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim xkirim As String
Dim xdata1() As String
Dim xdata2() As String
ws.GetData xkirim, vbString, bytesTotal
xdata1 = Split(xkirim, "-")
Select Case xdata1(0)
Case "SEARCH"
sql = "select*from jabatan where kode='" & xdata1(1) & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open sql, db, adOpenDynamic, adLockOptimistic
If rs.RecordCount <> 0 Then
ws.SendData "RECORD-" & rs!nama & "/" & rs!tunjangan
Else
ws.SendData "NOTHING-DATA"
End If
Case "INSERT"
db.BeginTrans
db.Execute xdata1(1), adCmdTable
db.CommitTrans
ws.SendData "Insert-Sukses"
Me.Adodc1.Refresh
Case "UPDATE"
db.BeginTrans
db.Execute xdata1(1), adCmdTable
db.CommitTrans
ws.SendData "Edit-Sukses"
Adodc1.Refresh
Case "DELETE"
Me.Adodc1.Recordset.Delete
ws.SendData "Delete-Sukses"
End Select
End Sub
Tu gambar nya form golongan
tu beranimasi lho klu U bsa menganalisa program listingnya
Ne program listingnya
Dim X(100), Y(100), Z(100) As Integer
Dim tmpx(100), tmpy(100), tmpz(100) As Integer
Dim k As Integer
Dim zoom As Integer
Dim kecepatan As Integer
Dim warnabintang As Integer
Dim M$
Dim a As String
Dim b As String
Dim c As String
Dim radius As Integer
Dim i As Integer
Dim sql As String
Option Explicit
Private Sub Form_Activate()
kecepatan = -1
k = 2038
zoom = 356
Me.Timer2.Interval = 1
For i = 0 To 100
X(i) = Int(Rnd * 1024) - 512
Y(i) = Int(Rnd * 1024) - 512
Z(i) = Int(Rnd * 512) - 256
Next i
End Sub
Private Sub golongan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.gapok.SetFocus
End If
End Sub
Private Sub kode_gol_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Me.kode_gol.Text = "" Then
MsgBox "Kode Tak bolah kosong", vbInformation, "Programmer"
Me.kode_gol.SetFocus
Exit Sub
End If
sql = "select * from golongan where kode_gol='" & Me.kode_gol.Text & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open sql, db, adOpenDynamic, adLockOptimistic
If rs.RecordCount <> 0 Then
showgolongan
Call aktifcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&Edit"
Me.kode_gol.Enabled = False
Else
b = Me.kode_gol.Text
Me.kode_gol.Text = b
Call aktifcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&Simpan"
End If
Me.golongan.SetFocus
End If
End Sub
Private Sub Timer1_Timer()
M$ = Right(M$, Len(M$) - 2) + Left(M$, 2)
Me.Caption = M$
End Sub
Private Sub Timer2_Timer()
For i = 0 To 100
Circle (tmpx(i), tmpy(i)), 5, BackColor
Z(i) = Z(i) + kecepatan
If Z(i) > 300 Then Z(i) = -300
If Z(i) < -300 Then Z(i) = 300
tmpz(i) = Z(i) + zoom
tmpx(i) = (X(i) * k / tmpz(i)) + (fromgolongan.Width / 2)
tmpy(i) = (Y(i) * k / tmpz(i)) + (fromgolongan.Height / 2)
radius = 4
warnabintang = 400 - Z(i)
Circle (tmpx(i), tmpy(i)), 5, RGB(warnabintang, _
warnabintang, warnabintang)
Next i
End Sub
Sub gkjalan()
Me.kode_gol.Enabled = False
Me.golongan.Enabled = False
Me.gapok.Enabled = False
End Sub
Sub jalan()
Me.kode_gol.Enabled = True
Me.golongan.Enabled = True
Me.gapok.Enabled = True
End Sub
Sub hapus()
Me.kode_gol.Enabled = True
clearform Me
Call aktifcmd(Me, True, False, False, False)
cmdproses(1).Caption = "&Simpan"
End Sub
Sub mulaiserver()
ws.LocalPort = 1000
ws.Listen
End Sub
Sub prosesdb(log As Byte)
Select Case log
Case 0
If Me.kode_gol.Text <> "" And Me.golongan.Text <> "" And Me.gapok.Text <> "" Then
sql = "insert into golongan(kode_gol,nama_golongan,gapok)" & _
"values('" & Me.kode_gol.Text & _
"','" & Me.golongan.Text & _
"','" & Me.gapok.Text & "')"
Adodc1.Refresh
db.BeginTrans
db.Execute sql, adCmdTable
db.CommitTrans
MsgBox "Data telah di proses dengan baik", vbInformation, "Programmer"
Else
MsgBox "maaf masih ada data yang kosong", vbInformation, "Pesan"
Exit Sub
End If
Case 1
sql = "update golongan set nama_golongan='" & Me.golongan.Text & "'," & _
"gapok='" & Me.gapok.Text & "'" & _
"where kode_gol='" & Me.kode_gol.Text & "'"
db.Execute sql, adCmdTable
Adodc1.Refresh
db.BeginTrans
db.CommitTrans
MsgBox "Data telah di proses dengan baik", vbInformation, "Programmer"
Case 2
sql = "delete from golongan where kode_gol='" & Me.kode_gol.Text & "'"
db.Execute sql, adCmdTable
Adodc1.Refresh
db.BeginTrans
db.CommitTrans
MsgBox "Data telah di proses dengan baik", vbInformation, "Programmer"
End Select
Call hapus
Me.kode_gol.SetFocus
End Sub
Sub showgolongan()
On Error Resume Next
With rs
Me.kode_gol.Text = !kode_gol
Me.golongan.Text = !golongan
Me.gapok.Text = !gapok
End With
End Sub
Private Sub cmdproses_Click(Index As Integer)
Select Case Index
Case 0
Call hapus
Call jalan
Me.kode_gol.SetFocus
Adodc1.Refresh
Call aktifcmd(Me, False, True, True, True)
Case 1
If cmdproses(1).Caption = "&Simpan" Then
prosesdb 0
Else
prosesdb 1
End If
Adodc1.Refresh
Call hapus
Me.kode_gol.SetFocus
Case 2
a = MsgBox("Yakin ingin menghapus data ini?", vbQuestion + vbYesNo, "Programmer")
If a = vbYes Then prosesdb 2
Call hapus
Adodc1.Refresh
Me.kode_gol.SetFocus
Case 3
Call hapus
Me.kode_gol.SetFocus
Me.Adodc1.Refresh
Case 4
Unload Me
MsgBox "Bye - Bye", vbInformation, "Keluar"
End Select
End Sub
Private Sub Form_Load()
M$ = " Golongan Server "
Call opendb
Call hapus
Call gkjalan
mulaiserver
End Sub
Private Sub ws_ConnectionRequest(ByVal requestID As Long)
ws.Close
ws.Accept requestID
Me.Caption = "Server - Client" & ws.RemoteHostIP & "Connect"
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim xkirim As String
Dim xdata1() As String
Dim xdata2() As String
ws.GetData xkirim, vbString, bytesTotal
xdata1 = Split(xkirim, "-")
Select Case xdata1(0)
Case "SEARCH"
sql = "select*from golongan where kode_gol='" & xdata1(1) & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open sql, db, adOpenDynamic, adLockOptimistic
If rs.RecordCount <> 0 Then
ws.SendData "RECORD-" & rs!nama_golongan & "/" & rs!gapok
Else
ws.SendData "NOTHING-DATA"
End If
Case "INSERT"
db.BeginTrans
db.Execute xdata1(1), adCmdTable
db.CommitTrans
ws.SendData "Insert-Sukses"
Me.Adodc1.Refresh
Case "DELETE"
Me.Adodc1.Recordset.Delete
ws.SendData "Delete-Sukses"
Case "UPDATE"
db.BeginTrans
db.Execute xdata1(1), adCmdTable
db.CommitTrans
ws.SendData "EDIT-Sukses"
Me.Adodc1.Refresh
End Select
End Sub
Sampai disini aja dulu y bro
klu soal Clientnya ntar ja lh soalnya Laptop Q ge lobeth ne
Semoga bermanfaat bagi pembacanya
