Praktikum Bahasa Pemrograman Visual Basic untuk Teknik Sipil

MODUL PRAKTIKUM

BAHASA PEMROGRAMAN TEKNIK SIPIL FAKULT AKULTAS TEKNIK TE KNIK & ILMU KOMPUTER KOMPUTE R

Nasyiin Faqih

- Praktikum Bahasa Pemrograman 1

PRAKTIKUM BAHASA PEMROGRAMAN TEKNIK SIPIL SEMESTER II

FUNGSI VALUE

ATUR PROPERTIESNYA : OBYEK Label1 – Label4 (4 buah)

Text1 – Text4 (4 buah)

PROPERTIES ISINYA Keterangan Caption Nama Siswa, Nilai Teori, Nilai Praktek, Nilai Rata-Rata N am e TextNama, TextTeori, Nama Obyek tidak NilaiPraktek, TextRata boleh pakai "SPASI"

TULISKAN KODENYA SBB: Private Sub TextTeori_Change() TextTeori_Change() TextRata = (Val(TextTeori) + Val(TextPraktek)) / 2 End Sub Private Sub TextPraktek_Change() TextPraktek_Change() TextRata = (Val(TextTeori) + Val(TextPraktek)) / 2 End Sub Private Sub TextRata_Change() TextRata_Change() TextRata = (Val(TextTeori) + Val(TextPraktek)) / 2 End Sub Jalankan Dengan Klik RUN / F5


TOMBOL KEYBOARD :

ATUR PROPERTIESNYA OBYEK

Form

Label1 – Label5 (5 buah)

PROPERTIES ISINYA Caption "Tombol Keyboard"

Caption

Jumlah Unit, Harga per unit, Total, Enter, Enter

Keterangan Klik dulu Form nya (di luar obyek Label maupun Teks) lalu klik pada Caption ... Caption Boleh pakai spasi

Text1 – Text3 (3 buah)

Tidak usah mengubah apapun (Default/Aslinya)

TULISKAN KODENYA SBB: Catatan : Baris pertama dan kedua tanda petik satu ( ' ) harus ditulis karena merupakan komentar (penjelasan) yang tidak akan dijalankan oleh program

'Selain menekan tombol TAB, Anda dapat 'mengakhiri data dengan menekan tombol Enter Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) If Text1 <> "" And KeyCode = 13 Then Text2.SetFocus End If End Sub Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer) If Text2 <> "" And KeyCode = 13 Then Text3 = Val(Text1) * Val(Text2) End If End Sub


PRAKTIKUM 8 BAHASA PEMROGRAMAN PEMROGRAMAN PRODI TEKNIK SIPIL

OPERATOR OPERATOR AND AN D

ATUR PROPERTIES UNTUK MASING-MASING OBYEK OBYEK

Form

Label1 Label2 – Label5 (5 buah) Text1 – Text4 (4 buah)

PROPERTIES ISINYA Caption "Operator 'AND'"

Caption

Na me

Nama Praktikan, Nilai Teori, Nilai Praktek, Keterangan TextPraktikan, TextTeori, TextPraktek, Keterangan

Keterangan Klik dulu Form nya (di luar obyek Label maupun Teks) Teks) lalu klik pada Caption ... Caption Boleh pakai spasi

Sekali lagi : Name tidak boleh pakai spasi dan tanda khusus lainnya

TULISKAN KODE PROGRAM: Private Sub TextPraktek_Change() TextPraktek_Change() If Val(TextTeori) >= 60 And Val(TextPraktek) >= 60 Then TextKeterangan TextKeterangan = "LULUS" Else TextKeterangan TextKeterangan = "GAGAL" End If End Sub Private Sub TextTeori_Change() TextTeori_Change() If Val(TextTeori) >= 60 And Val(TextPraktek) >= 60 Then TextKeterangan TextKeterangan = "LULUS" Else TextKeterangan TextKeterangan = "GAGAL" End If End Sub


PERINTAH GO TO

Private Sub Form_Activate() Form_Activate() Dim i As Integer Do Until i = 10 i = i + 1 Print i If i = 10 Then GoTo Akhir Loop Akhir: Print "Selesai" End Sub

MEMBUAT FUNGSI

'Function digunakan untuk membuat 'fungsi sendiri Function Jumlah() As Currency Jumlah = Val(Text1) + Val(Text2) End Function


Private Sub Text1_Change() Text1_Change() Text3 = Jumlah End Sub Private Sub Text2_Change() Text2_Change() Text3 = Jumlah End Sub

FUNGSI MSG BOX & PENGGABUNGAN STRING (KARAKTER) (KAR AKTER)

Private Sub Command1_Click() Command1_Click() If Text1 = "" Or Text2 = "" Then Beep MsgBox ("Isi dulu dong data Anda!") Else MsgBox ("Nama ("Nama Anda: Anda: " & Text1 & " Alamat: " & Text2) Text2) End If End Sub


MENULISKAN MENULISK AN DATA DATA KE DALAM DAL AM FILE (DATA (DATA BASE)

Private Sub Form_Load() Combo1.AddItem "1", 0 Combo1.AddItem "2", 1 Combo1.AddItem "3", 2 End Sub Private Sub CmdBatal_Click() CmdBatal_Click() TxtNama = "" TxtGaji = "" TxtNama.SetFocus End Sub Private Sub CmdSelesai_Click() CmdSelesai_Click() End End Sub Private Sub CmdSimpan_Click() CmdSimpan_Click() Dim DirAktif As String If TxtNama = "" Or TxtGaji = "" Then GoTo AdaKosong DirAktif = Left(CurDir, 3) ChDir DirAktif Open "C:\VB6\GAJI.DAT" For Append As #1 Write #1, TxtNama, Combo1.Text, TxtGaji Close #1 TxtNama = "" TxtGaji = "" TxtNama.SetFocus Exit Sub AdaKosong: Beep If TxtNama = "" Then TxtNama.SetFocus TxtNama.SetFocus


If TxtGaji = "" Then TxtGaji.SetFocus TxtGaji.SetFocus End Sub

MEMBACA DATA

Private Sub Command1_Click() Command1_Click() Dim Nama, Kode, Gaji As String Dim TotalGaji As Currency Printer.FontSize Printer.FontSize = 12 Open "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" For Input As #1 'JUDUL Printer.Print Tab(10); "NAMA"; Tab(40); "GOLONGAN"; Tab(60); "GAJI" Printer.Print Tab(10); String(45, "=") Do Until EOF(1) Input #1, Nama, Kode, Gaji TotalGaji = TotalGaji + Gaji 'ISI Printer.Print Tab(10); Nama; Tab(40); Kode; Tab(60); Gaji Loop Printer.Print Tab(10); String(45, "=") Printer.Print Tab(10); "TOTAL GAJI"; Tab(57); Format(TotalGaji, Format(TotalGaji, "Currency") Close #1 Printer.EndDoc End Sub Private Sub Form_Load() Dim LI As ListItem Dim Nama, Kode, Gaji As String


Dim TotalGaji As Currency ListView1.View = lvwReport ListView1.Sorted ListView1.Sorted = True 'Membuat Judul Kolom (ColumnHeaders) serta mengatur lebar. ListView1.ColumnHeaders.Add ListView1.ColumnHeaders.Add , , "NAMA", ListView1.Width / 3 ListView1.ColumnHeaders.Add ListView1.ColumnHeaders.Add , , "GOLONGAN", ListView1.Width ListView1.Width / 3 ListView1.ColumnHeaders.Add ListView1.ColumnHeaders.Add , , "GAJI", ListView1.Width / 3 Open "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" For Input As #1 Do Until EOF(1) Input #1, Nama, Kode, Gaji 'Masukkan item dan sub item ke dalam list. Set LI = ListView1.ListItems.Add(, ListView1.ListItems.Add(, , Nama) LI.SubItems(1) LI.SubItems(1) = Kode LI.SubItems(2) LI.SubItems(2) = Gaji TotalGaji = TotalGaji + Gaji Loop Close #1 Label1.Caption = "Total Gaji = " + Format(TotalGaji, Format(TotalGaji, "Currency") End Sub

PROGRAM MENCARI DATA

Private Sub Form_Load() Dim LI As ListItem ListView1.View = lvwReport


ListView1.Sorted ListView1.Sorted = True 'Membuat Judul Kolom (ColumnHeaders) dan mengatur lebar. ListView1.ColumnHeaders.Add ListView1.ColumnHeaders.Add , , "NAMA", ListView1.Width / 3 ListView1.ColumnHeaders.Add ListView1.ColumnHeaders.Add , , "GOLONGAN", ListView1.Width ListView1.Width / 3 ListView1.ColumnHeaders.Add ListView1.ColumnHeaders.Add , , "GAJI", ListView1.Width / 3 End Sub Private Sub CariData() Dim Nama, Kode, Gaji As String Dim Ada As Integer Dim TotalGaji As Currency ListView1.ListItems.Clear Open "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" For Input As #1 Do Until EOF(1) Input #1, Nama, Kode, Gaji If Text1 = Kode Then 'Masukkan data ke dalam list. Set LI = ListView1.ListItems.Add(, ListView1.ListItems.Add(, , Nama) LI.SubItems(1) LI.SubItems(1) = Kode LI.SubItems(2) LI.SubItems(2) = Gaji 'Jumlahkan gaji TotalGaji = TotalGaji + Gaji Ada = Ada + 1 End If Loop Close #1 If Ada = 0 Then MsgBox "Kode golongan tersebut tidak ada (1-3)!" If Ada <> 0 Then Text1 = "" Label2.Caption Label2.Caption = "Total Gaji = " + Format(TotalGaji, Format(TotalGaji, "Currency") End If End Sub Private Sub Text1_KeyDown(KeyCode Text1_KeyDown(KeyCode As Integer, Shift As Integer) If Text1 <> "" And KeyCode = 13 Then CariData End Sub


PROGRAM MENGHAPUS DATA

Private Sub Form_Load() CmdHapus.Enabled CmdHapus.Enabled = False End Sub Private Sub CariData() Dim Nama, Kode, Gaji As String Dim Ada As Integer Open "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" For Input As #1 Do Until EOF(1) Input #1, Nama, Kode, Gaji If UCase(TxtNamaCari) = UCase(Nama) Then TxtNama = Nama TxtKode = Kode TxtGaji = Format(Gaji, "Currency") Ada = Ada + 1 CmdHapus.Enabled CmdHapus.Enabled = True 'Hidupkan tombol Hapus End If Loop Close If Ada <> 0 Then TxtNamaCari.Enabled TxtNamaCari.Enabled = False If Ada = 0 Then MsgBox "Nama '" & TxtNamaCari & "' tidak ada dalam file!" Kosongkan TxtNamaCari.SetFocus End If End Sub Private Sub Kosongkan() TxtNamaCari = "" TxtNama = "" TxtKode = "" TxtGaji = "" - Praktikum Bahasa Pemrograman 11

End Sub Private Sub CmdHapus_Click() CmdHapus_Click() Dim Nama, Kode, Gaji As String Open "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" For Input As #1 Open "C:\VB6\TEMPORER.DAT" "C:\VB6\TEMPORER.DAT" For Append As #2 LEWATKAN: Do Until EOF(1) Input #1, Nama, Kode, Gaji If UCase(Nama) = UCase(TxtNamaCari) UCase(TxtNamaCari) Then GoTo LEWATKAN 'Jangan ditulis ke dalam file End If Write #2, Nama, Kode, Gaji Loop Close Kill "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" Name "C:\VB6\TEMPORER.DAT" As "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" MsgBox "Data sudah dihapus, klik OK!" Kosongkan TxtNamaCari.Enabled TxtNamaCari.Enabled = True TxtNamaCari.SetFocus CmdHapus.Enabled CmdHapus.Enabled = False End Sub Private Sub CmdBatal_Click() CmdBatal_Click() Kosongkan TxtNamaCari.Enabled TxtNamaCari.Enabled = True TxtNamaCari.SetFocus CmdHapus.Enabled CmdHapus.Enabled = False End Sub Private Sub CmdKeluar_Click() CmdKeluar_Click() End End Sub Private Sub TxtNamaCari_KeyDown(KeyCode TxtNamaCari_KeyDown(KeyCode As Integer, Shift As Integer) If TxtNamaCari <> "" And KeyCode = 13 Then CariData If KeyCode = 27 Then End End Sub


PROGRAM MENGGANTI DATA

Private Sub CariData() Dim Nama, Kode, Gaji As String Dim Ada As Integer Open "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" For Input As #1 Do Until EOF(1) Input #1, Nama, Kode, Gaji If UCase(TxtNamaCari) = UCase(Nama) Then TxtNama = Nama TxtKode = Kode TxtGaji = Gaji Ada = Ada + 1 CmdGanti.Enabled CmdGanti.Enabled = True End If Loop Close TxtNama.SetFocus If Ada = 0 Then MsgBox "Nama '" & TxtNamaCari & "' tidak ada dalam file!" Kosongkan End If End Sub Private Sub Kosongkan() TxtNamaCari = "" TxtNama = ""


TxtKode = "" TxtGaji = "" TxtNamaCari.SetFocus CmdGanti.Enabled CmdGanti.Enabled = False End Sub Private Sub CmdBatal_Click() CmdBatal_Click() Kosongkan End Sub Private Sub CmdGanti_Click() CmdGanti_Click() Dim Nama, Kode, Gaji As String Open "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" For Input As #1 Open "C:\VB6\TEMPORER.DAT" "C:\VB6\TEMPORER.DAT" For Append As #2 Do Until EOF(1) Input #1, Nama, Kode, Gaji If UCase(Nama) = UCase(TxtNamaCari) UCase(TxtNamaCari) Then Nama = TxtNama Kode = TxtKode Gaji = TxtGaji End If Write #2, Nama, Kode, Gaji Loop Close Kill "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" Name "C:\VB6\TEMPORER.DAT" As "C:\VB6\GAJI.DAT" "C:\VB6\GAJI.DAT" MsgBox "Data sudah diganti, klik OK!" Kosongkan End Sub Private Sub CmdSelesai_Click() CmdSelesai_Click() End End Sub Private Sub Form_Load() 'Matikan tombol GANTI CmdGanti.Enabled CmdGanti.Enabled = False End Sub Private Sub TxtNamaCari_KeyDown(KeyCode TxtNamaCari_KeyDown(KeyCode As Integer, Shift As Integer) If TxtNamaCari <> "" And KeyCode = 13 Then CariData If KeyCode = 27 Then End End Sub


FUNGSI TIMER

'Deklarasi pencacah Dim Counter As Integer Private Sub Form_Load() Counter = 0 'Menentukan waktu interval timer Timer1.Interval Timer1.Interval = 100 'Mengatur ukuran dan tebal teks lblTeks.FontBold lblTeks.FontBold = True lblTeks.FontSize lblTeks.FontSize = 16 End Sub

Private Sub Timer1_Timer() Timer1_Timer() Counter = Counter + 1 'Jika nilai pencacah 0 sampai 9 If (Counter >= 0) And (Counter < 10) Then lblTeks.Caption lblTeks.Caption = "Selamat Belajar" End If 'Jika nilai pencacah 10 sampai 19 If (Counter >= 10) And (Counter < 20) Then lblTeks.Caption lblTeks.Caption = "Visual Basic 6.0" End If 'Jika nilai pencacah 20 If Counter = 20 Then 'Nilai pencacah kembali ke 0 Counter = 0


End If End Sub

Private Sub cmdKeluar_Click() cmdKeluar_Click() 'Keluar dari form Unload Me End Sub Private Sub Form_Load() 'ukuran teks Label1.FontBold Label1.FontBold = True 'Posisi teks pada form Label1.Left = 240 Label1.Top = 240 'kecepatan timer Timer1.Interval Timer1.Interval = 100 End Sub Private Sub Timer1_Timer() Timer1_Timer() 'Mengeser posisi teks ke kanan Label1.Left = Label1.Left + 100 'mengecek posisi akhir teks If Label1.Left > 4320 Then - Praktikum Bahasa Pemrograman 16

'Kembali ke posisi semua dari teks Label1.Left = 240 End If End Sub

SIMULASI JAM PUTAR

Const PI = 3.14159 Private Sub Form_Load() ' mencari titik tengah di xo, yo untuk sumbu jarum jam xo = ScaleWidth / 2 yo = ScaleHeight / 2 ' menempatkan titik awal kontrol Line sbg jarum di xo , yo jrJam.X1 = xo jrJam.Y1 = yo jrMenit.X1 = xo jrMenit.Y1 = yo jrDetik.X1 = xo jrDetik.Y1 = yo ' menggambar jarum jam dng setiap selang waktu tertentu ' dengan menggeser koordinat kontrol Line pada sisi luar Call tmrQuartz_Timer tmrQuartz_Timer End Sub Private Sub tmrQuartz_Timer() tmrQuartz_Timer() Dim Jam, Menit, Detik Dim TrueJam LblTime.Caption LblTime.Caption = Time Jam = Hour(Time) Menit = Minute(Time) Detik = Second(Time) - Praktikum Bahasa Pemrograman 17

TrueJam = Jam + Menit / 60 ' mencari koordinat luar dari kontrol Line ' sesuai formula yang disampaikan Thaha Hussain jrJam.X2 = 1200 * Cos(PI / 180 * (30 * TrueJam - 90)) + _ jrJam.X1 jrJam.Y2 = 1200 * Sin(PI / 180 * (30 * TrueJam - 90)) + _ jrJam.Y1 jrMenit.X2 = 1600 * Cos(PI / 180 * (6 * Menit - 90)) + _ jrJam.X1 jrMenit.Y2 = 1600 * Sin(PI / 180 * (6 * Menit - 90)) + _ jrJam.Y1 jrDetik.X2 = 1500 * Cos(PI / 180 * (6 * Detik - 90)) + _ jrJam.X1 jrDetik.Y2 = 1500 * Sin(PI / 180 * (6 * Detik - 90)) + _ jrJam.Y1 End Sub


Praktikum Bahasa Pemrograman Visual Basic untuk Teknik Sipil

Recommend Documents