Pages

Subscribe:

Sunday, November 14, 2010

Pembahasan “UTS Lab. PBO”

Berikut pembahasan dari soal UTS Lab PBO (cont'd Algo), jadikan code berikut hanya sebagai refensi, silahkan dikembangkan jika perlu. Tidak mutlak code harus sama persis seperti di bawah ini.


Source Code :

Imports System.IO
Public Class Form1
    Dim arrJenisMobil() As String
    Dim arrHargaMobil() As Double
    Dim cnt As Integer
    Sub ClearInput()
        txtNama.Text = ""
        txtAlamat.Text = ""
        txtNoHP.Text = ""
        cboJenisMobil.Text = "(Silahkan Pilih)"
        txtHari.Text = 0
        txtNama.Focus()
    End Sub
    Sub fillComboBox()
        cboJenisMobil.Items.Clear()
        For i As Integer = 0 To arrJenisMobil.GetUpperBound(0)
            cboJenisMobil.Items.Add(arrJenisMobil(i).ToString)
        Next
    End Sub
    Sub getJenisMobil()
        Dim sr As StreamReader
        Dim strJenisMobil As String
        Dim dblHargaMobil As Double
        If File.Exists("CarPrice.txt") Then
            sr = File.OpenText("CarPrice.txt")
            Do While sr.Peek <> -1
                strJenisMobil = sr.ReadLine
                dblHargaMobil = sr.ReadLine
                cnt += 1
            Loop
            sr.Close()
            ReDim arrJenisMobil(cnt - 1)
            ReDim arrHargaMobil(cnt - 1)
            sr = File.OpenText("CarPrice.txt")
            cnt = 0
            Do While sr.Peek <> -1
                arrJenisMobil(cnt) = sr.ReadLine
                arrHargaMobil(cnt) = sr.ReadLine
                cnt += 1
            Loop
        End If
    End Sub
    Function getHargaMobil(ByVal carIndex As Integer) As Double
        Return arrHargaMobil(carIndex)
    End Function
    Function ValidateInput() As Boolean
        If txtNama.Text.Trim = "" Then
            MessageBox.Show("Silahkan masukkan Nama")
            txtNama.Focus()
            Return False
        ElseIf txtAlamat.Text.Trim = "" Then
            MessageBox.Show("Silahkan masukkan Alamat")
            txtAlamat.Focus()
            Return False
        ElseIf txtNoHP.Text.Trim = "" Then
            MessageBox.Show("Silahkan masukkan No. HP")
            txtNoHP.Focus()
            Return False
        ElseIf cboJenisMobil.SelectedIndex < 0 Then
            MessageBox.Show("Silahkan pilih mobil yang disewa")
            cboJenisMobil.Focus()
            Return False
        ElseIf txtHari.Text.Trim < 1 Then
            MessageBox.Show("Minimal sewa 1 hari")
            txtHari.Focus()
            Return False
        Else
            Return True
        End If
    End Function
    Private Sub btnHitung_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnHitung.Click
        Dim fmtStr As String = "{0,-20}{1,10}"
        Dim totalHarga As Double
        If ValidateInput() = False Then Exit Sub
        totalHarga = getHargaMobil(cboJenisMobil.SelectedIndex) * CInt(txtHari.Text)
        lstHasil.Items.Clear()
        With lstHasil.Items
            .Add("Customer : Mr./Ms. " & txtNama.Text.Trim)
            .Add("Alamat   : " & txtAlamat.Text.Trim)
            .Add("No NP    : " & txtNoHP.Text.Trim)
            .Add("Jenis Mobil yang disewa : " & cboJenisMobil.SelectedItem)
            .Add("Jumlah Hari penyewaan   : " & txtHari.Text & "hari  Total Rp. " & totalHarga)
        End With
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        getJenisMobil()
        fillComboBox()
        ClearInput()
    End Sub

    Private Sub txtHari_KeyPress(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtHari.KeyPress
        If Not ((e.KeyChar >= "0" And e.KeyChar <= "9") Or e.KeyChar = vbBack) Then
            e.Handled = True
        End If
    End Sub

    Private Sub btnSimpan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSimpan.Click
        If lstHasil.Items.Count < 1 Then
            Exit Sub
        End If
        Dim sw As StreamWriter
        If File.Exists("History.txt") Then
            File.Delete("History.txt")
        End If
        sw = File.CreateText("History.txt")
        With sw
            .WriteLine("Nama        : " & txtNama.Text)
            .WriteLine("Alamat      : " & txtAlamat.Text)
            .WriteLine("No HP       : " & txtNoHP.Text)
            .WriteLine("Jenis Mobil : " & cboJenisMobil.SelectedItem)
            .WriteLine("Lama Sewa   : " & txtHari.Text & " hari")
            .WriteLine("Harga Sewa  : " & arrHargaMobil(cboJenisMobil.SelectedIndex))
            .WriteLine("Total       : " & CDbl(arrHargaMobil(cboJenisMobil.SelectedIndex)) * CInt(txtHari.Text))
        End With
        sw.Close()
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim sr As StreamReader
        If File.Exists("History.txt") Then
            sr = File.OpenText("History.txt")
            Form2.ListBox1.Items.Clear()
            While sr.Peek <> -1
                Form2.ListBox1.Items.Add(sr.ReadLine)
            End While
            Me.Hide()
            Form2.Show()
        End If
    End Sub
End Class

Berikut form untuk menampilkan hasil:


Source Code:

Public Class Form2
    Private Sub btnTutup_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTutup.Click
        Form1.Close()
    End Sub
End Class

~ Semoga Bermanfaat  ~

Pembahasan "UTS Lab. Algoritma & Pemrograman"

Berikut pembahasan dari soal UTS Lab Algoritma dan Pemrograman, jadikan code berikut hanya sebagai refensi, silahkan dikembangkan jika perlu. Tidak mutlak code harus sama persis seperti di bawah ini.


Source Code:

Public Class Form1
    Sub ClearInput()
        txtNama.Text = ""
        txtAlamat.Text = ""
        txtNoHP.Text = ""
        cboJenisMobil.Text = "(Silahkan Pilih)"
        txtHari.Text = 0
        txtNama.Focus()
    End Sub
    Function getHargaMobil(ByVal JenisMobil As String) As Double
        Dim hrgMobil As Double
        Select Case JenisMobil
            Case Is = "Toyota Avanza"
                hrgMobil = 250000
            Case Is = "Toyota Innova"
                hrgMobil = 350000
            Case Is = "Toyota Corolla"
                hrgMobil = 200000
            Case Is = "Honda Jazz"
                hrgMobil = 300000
            Case Is = "Honda Accord"
                hrgMobil = 250000
            Case Is = "Nissan Sunny"
                hrgMobil = 200000
            Case Else
                hrgMobil = 180000
        End Select
        Return hrgMobil
    End Function
    Function ValidateInput() As Boolean
        If txtNama.Text.Trim = "" Then
            MessageBox.Show("Silahkan masukkan Nama")
            txtNama.Focus()
            Return False
        ElseIf txtAlamat.Text.Trim = "" Then
            MessageBox.Show("Silahkan masukkan Alamat")
            txtAlamat.Focus()
            Return False
        ElseIf txtNoHP.Text.Trim = "" Then
            MessageBox.Show("Silahkan masukkan No. HP")
            txtNoHP.Focus()
            Return False
        ElseIf cboJenisMobil.SelectedIndex < 0 Then
            MessageBox.Show("Silahkan pilih mobil yang disewa")
            cboJenisMobil.Focus()
            Return False
        ElseIf txtHari.Text.Trim < 1 Then
            MessageBox.Show("Minimal sewa 1 hari")
            txtHari.Focus()
            Return False
        Else
            Return True
        End If
    End Function
    Private Sub btnHitung_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnHitung.Click
        Dim fmtStr As String = "{0,-20}{1,10}"
        Dim totalHarga As Double
        If ValidateInput() = False Then Exit Sub
        totalHarga = getHargaMobil(cboJenisMobil.SelectedItem) * CInt(txtHari.Text)
        lstHasil.Items.Clear()
        With lstHasil.Items
            .Add("Customer : Mr./Ms. " & txtNama.Text.Trim)
            .Add("Alamat   : " & txtAlamat.Text.Trim)
            .Add("No NP    : " & txtNoHP.Text.Trim)
            .Add("Jenis Mobil yang disewa : " & cboJenisMobil.SelectedItem)
            .Add("Jumlah Hari penyewaan   : " & txtHari.Text & "hari  Total Rp. " & totalHarga)
        End With
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ClearInput()
    End Sub

    Private Sub txtHari_KeyPress(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtHari.KeyPress
        If Not ((e.KeyChar >= "0" And e.KeyChar <= "9") Or e.KeyChar = vbBack) Then
            e.Handled = True
        End If
    End Sub
End Class

~ Semoga Bermanfaat ~

Friday, November 12, 2010

Menghitung Umur (Tahun, Bulan, Hari)

Berikut merupakan function untuk mengembalikan Umur berdasarkan apa yang diinput oleh user, dengan asumsi bahwa tiap bulan mempunyai 30 hari.

    Function getUmur(ByVal tglLahir As Date) As String
        Dim y, m, d As Integer

        d = Now.Day - tglLahir.Day
        m = Now.Month - tglLahir.Month
        y = Now.Year - tglLahir.Year

        'jika tanggal minus
        'berarti tanggal hari ini
        'lebih kecil dari tanggal lahir
        If Math.Sign(d) = -1 Then 'untuk mengenali jika tanggal dalam bentuk minus
            d = 30 - Math.Abs(d) 'membuat absolut |-2| = 2
            m -= 1
        End If
        If Math.Sign(m) = -1 Then
            m = 12 - Math.Abs(m)
            y -= 1
        End If
        Return y & " tahun, " & m & " bulan, " & d & " hari."
    End Function

Function di atas hanya berupa contoh, dapat dimodifikasi sesuai dengan kebutuhan

Saturday, November 6, 2010

Menyimpan Data ke Database (Module, Function dan Procedure)

Program berikut menggunakan Module untuk menampung VARIABLE, FUNCTION dan PROCEDURE yang sifatnya digunakan secara umum.

Adapun contoh aplikasi yang dibuat sebagai berikut

Contoh Code pada module:
(Code pada module ini menggunakan Connection String ke database yang berasal dari file notepad “ClientObject.ini”, dan menggunakan form koneksi pada postingnya yang lalu)

Imports System.IO
Imports System.Data
Imports System.Data.SqlClient
Module mdlRef4General
    Public sqlConn As New SqlConnection
    Public sqlCmd As New SqlCommand
    Public sqlDA As New SqlDataAdapter
    Private m_ConnString As String
    Private m_SR As StreamReader

    'mengambil PATH atau lokasi,
    'dimana file EXE berada (akar program)
    Private m_BasePath As String = _
            AppDomain.CurrentDomain.BaseDirectory

    Private Sub openDbConnApp()
        If File.Exists(m_BasePath & "Database Connect.exe") Then
            'membuka program untuk menyimpan Connection String
            Shell(m_BasePath & "Database Connect.exe", _
                    AppWinStyle.NormalFocus)
        Else
            MessageBox.Show("Aplikasi untuk menyimpan Connection String " & _
                        vbCrLf & _
                  "TIDAK DITEMUKAN, silahkan letakan pada tempatnya", "ERROR", _
                 MessageBoxButtons.OK, MessageBoxIcon.Error)
        End If
    End Sub
    'mengambil connection string
    'untuk melakukan koneksi ke SQL Server
    Private Function getConnectionString() As String
        'Dim strConnString As String = ""
        'mengecek apakah file ClientObject.ini ada
        If File.Exists(m_BasePath & "ClientObject.ini") Then
            'membuka file ClientObject.ini jika filenya ada
            m_SR = File.OpenText(m_BasePath & "ClientObject.ini")
            'membaca baris connection string dan menampung ke variabel
            m_ConnString = m_SR.ReadLine
            'menutup Stream Reader
            m_SR.Close()
        Else
            openDbConnApp()
            'jika file ClientObject.ini tidak ada,
            'maka variabel akan dikosongkan
            m_ConnString = ""
        End If
        Return m_ConnString
    End Function
    Public Function tryConnection() As Boolean
        m_ConnString = getConnectionString()
        Try
            'memasukan isi dari m_ConnString ke property Connection
            sqlConn.ConnectionString = m_ConnString
            'membuka koneksi
            sqlConn.Open()
            'jika berhasil maka akan mengembalikan nilai TRUE
            Return True
        Catch ex As Exception
            MessageBox.Show(ex.Message, "ERROR", _
            MessageBoxButtons.OK, MessageBoxIcon.Error)

            openDbConnApp()
            'koneksi gagal, maka akan mengembalikan nilai FALSE
            Return False
        Finally
            'jika sqlConn(Connection) dalam keadaan BUKA,
            'maka koneksi harus ditutup
            If sqlConn.State = ConnectionState.Open Then
                sqlConn.Close()
            End If
        End Try
    End Function

    'function ini dapat digunakan untuk
    'INSERT, UPDATE dan DELETE data
    Public Function InUpDeData(ByVal strQuery As String) As Boolean
        m_ConnString = getConnectionString()
        If m_ConnString = "" Then
            Return False
            Exit Function
        End If

        Try
            sqlConn.ConnectionString = m_ConnString
            sqlCmd.CommandText = strQuery
            sqlCmd.Connection = sqlConn
            sqlConn.Open()
            sqlCmd.ExecuteNonQuery()
            Return True
        Catch ex As Exception
            MessageBox.Show(ex.Message, "ERROR", _
                            MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        Finally
            If sqlConn.State = ConnectionState.Open Then
                sqlConn.Close()
            End If
        End Try
    End Function

    Public Function GetData(ByVal strQuery As String) As DataSet
        Dim dtsResult As New DataSet
        m_ConnString = My.Settings.ConnString
   
        Try
            sqlConn = New SqlConnection(m_ConnString)
            sqlDA.SelectCommand = New SqlCommand(strQuery, sqlConn)
            sqlDA.SelectCommand.CommandText = strQuery
            sqlDA.Fill(dtsResult)
   
        Catch ex As Exception
            MessageBox.Show(ex.Message, "ERROR", _
                            MessageBoxButtons.OK, MessageBoxIcon.Error)
        Finally
            If sqlConn.State = ConnectionState.Open Then
                sqlConn.Close()
            End If
        End Try
        Return dtsResult
    End Function
End Module

Contoh Code pada Form:
Public Class frmRegister
    Dim AddEdit As String
    Private Sub AllowInput(ByVal tf As Boolean)
        txtNPM.ReadOnly = Not tf
        txtNama.ReadOnly = Not tf
        txtAlamat.ReadOnly = Not tf
        txtNoHP.ReadOnly = Not tf
        DataGridView1.Enabled = Not tf
    End Sub
    Private Sub ClearInput()
        txtNPM.Text = ""
        txtNama.Text = ""
        txtAlamat.Text = ""
        txtNoHP.Text = ""
        txtNPM.Focus()
    End Sub
    Private Sub frmRegister_Load(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load

        If tryConnection() = False Then
            Me.Close()
        End If
        AllowInput(False)
        refreshDataGrid()
    End Sub

    Private Sub btnSave_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnSave.Click
        Try
            If AddEdit = "add" Then
                If InUpDeData("INSERT INTO tblStudent " & _
                          "(NPM, Nama, Alamat, NoHP, CreateDate) " & _
                          "VALUES ('" & txtNPM.Text & "','" & txtNama.Text & _
                            "','" & txtAlamat.Text & "','" & _
                          txtNoHP.Text & "','" & Now & "')") = True Then
                    MessageBox.Show("Data Berhasil disimpan", "SUCCEED", _
                                           MessageBoxButtons.OK, MessageBoxIcon.Information)
                End If


            ElseIf AddEdit = "edit" Then
                If InUpDeData("UPDATE tblStudent " & _
                           "SET Nama='" & txtNama.Text & "', Alamat='" & txtAlamat.Text & _
                           "', NoHP='" & txtNoHP.Text & "', CreateDate='" & Now & _
                           "' WHERE NPM='" & txtNPM.Text & "'") = True Then
                    MessageBox.Show("Data Berhasil diubah", "SUCCEED", _
                                           MessageBoxButtons.OK, MessageBoxIcon.Information)
                End If

            End If
            refreshDataGrid()
            AllowInput(False)
        Catch ex As Exception
            MessageBox.Show(ex.Message, "ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try



    End Sub
    Private Sub btnAdd_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnAdd.Click
        AddEdit = "add"
        AllowInput(True)
        ClearInput()
    End Sub
    Private Sub btnEdit_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnEdit.Click
        AddEdit = "edit"
        AllowInput(True)
        txtNPM.ReadOnly = True
    End Sub
    Private Sub refreshDataGrid()
        Dim dtsResult As New DataSet
        Try
            dtsResult.Tables.Clear()
            dtsResult = GetData("SELECT * FROM tblStudent ORDER BY ID ASC")
            DataGridView1.DataSource = dtsResult.Tables(0)
        Catch ex As Exception
            MessageBox.Show(ex.Message, "ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try

    End Sub
    Private Sub DataGridView1_CurrentCellChanged(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles DataGridView1.CurrentCellChanged
        On Error Resume Next
        Dim intCRow As Integer
        intCRow = DataGridView1.CurrentRow.Index
        If intCRow < 0 Then Exit Sub
        txtNPM.Text = DataGridView1(1, intCRow).Value
        txtNama.Text = DataGridView1(2, intCRow).Value
        txtAlamat.Text = DataGridView1(3, intCRow).Value
        txtNoHP.Text = DataGridView1(4, intCRow).Value
    End Sub


    Private Sub btnCancel_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnCancel.Click
        AllowInput(False)
        refreshDataGrid()
    End Sub

    Private Sub btnDelete_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnDelete.Click
        If MessageBox.Show("Apakah Anda yakin ingin menghapus data ini?", "Cofirmation", _
        MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
            If InUpDeData("DELETE FROM tblStudent WHERE NPM='" & txtNPM.Text & "'") = True Then
                MessageBox.Show("Data berhasil dihapus")
                refreshDataGrid()
            End If
        End If
    End Sub
End Class

Download Source Lengkap : DOWNLOAD

NB: Bagi yang kurang mengerti silahkan comment pada post ini atau email

Silahkan modifikasi sesuai dengan kebutuhan.