Lampiran Uas 0809

  • June 2020
  • PDF

This document was uploaded by user and they confirmed that they have the permission to share it. If you are author or own the copyright of this book, please report to us by using this DMCA report form. Report DMCA


Overview

Download & View Lampiran Uas 0809 as PDF for free.

More details

  • Words: 2,488
  • Pages: 18
LAMPIRAN UJIAN AKHIR SEMESTER T.A. 2008 / 2009  PEMROGRAMAN BERBASIS WINDOWS  TEKNIK INFORMATIKA STMIK MIKROSKIL  KETERANGAN :  Lampiran UAS ini terdiri dari 3 program. Anda diminta untuk mempelajari kode program tersebut sebelum UAS.  Jika ada kode program yang kurang jelas / dimengerti, segera tanyakan kepada dosen pengajar sebelum UAS.     

SOAL 1 :  Program Image Browser. 

    Jenis Objek  Form 

Ng Poi Wong, S.Kom, MTI   

Properties 

Daftar Properties  Nilai 

Name 

FrmImageBrowser 

Text 

“Image Browser” 

Keterangan  ‐ 

Page 1 

Button  Button 

Label 

MaximizeBox 

False 

MinimizeBox 

False 

Name 

BtnBrowse 

Text 

“Browse” 

Name 

BtnExit 

Text 

“Exit” 

Name 

LblPath 

BorderStyle 

Fixed3D 

Text  TextAlign 

ListBox  GroupBox  CheckBox  CheckBox  PictureBox  FolderBrowserDialog 

  Lst 

Name 

GrpExtension 

Name  Text 

“Extension”  ChkBmp  “BITMAP” 

Name 

ChkJpg 

Text 

“JPEG” 

Name  BorderStyle  Name 

‐ 

‐ 

MiddleLeft 

Name  Text 

‐ 

Pic  Fixed3D  FBDlg 

‐  ‐  ‐  ‐  ‐  ‐ 

  Kode Program pada Form :  Imports Microsoft.VisualBasic Public Class FrmImageBrowser Private Function GetShortFileName(ByVal LongFileName As String) As String Dim Pos As Integer Do Pos = InStr(LongFileName, "\") If Pos > 0 Then LongFileName = Mid(LongFileName, Pos + 1) End If Loop Until Pos <= 0 Return LongFileName End Function Private Sub FilteringFileName(ByVal Path As String) Try Dim dirlist() As String = IO.Directory.GetFiles(Path) Lst.Items.Clear() For Each I As String In dirlist If (ChkBmp.Checked And UCase(Strings.Right(I, 4)) = ".BMP") Or (ChkJpg.Checked And UCase(Strings.Right(I, 4)) = ".JPG") Then Lst.Items.Add(GetShortFileName(I))

Ng Poi Wong, S.Kom, MTI   

Page 2 

End If Next Catch ex As Exception Exit Sub End Try End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Pic.SizeMode = PictureBoxSizeMode.StretchImage ChkBmp.Checked = True ChkJpg.Checked = True End Sub Private Sub BtnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBrowse.Click Try FBDlg.ShowDialog() LblPath.Text = FBDlg.SelectedPath FilteringFileName(LblPath.Text) Catch ex As Exception Exit Sub End Try End Sub Private Sub Extension_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChkBmp.CheckedChanged, ChkJpg.CheckedChanged FilteringFileName(LblPath.Text) End Sub Private Sub Lst_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Lst.SelectedIndexChanged If Strings.Right(LblPath.Text, 1) = "\" Then Pic.Image = Image.FromFile(LblPath.Text & Lst.SelectedItem) Else Pic.Image = Image.FromFile(LblPath.Text & "\" & Lst.SelectedItem) End If End Sub Private Sub BtnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnExit.Click End End Sub End Class 

              Ng Poi Wong, S.Kom, MTI   

Page 3 

SOAL 2 :  Program Mini Word Pad. 

    Jenis Objek  Form 

Properties 

Daftar Properties  Nilai 

Name 

FrmMiniWordPad 

Text 

“Mini Word Pad” 

Keterangan  ‐ 

RichTextBox 

Name 

RTB 

‐ 

MenuStrip 

Name 

MS 

Lihat Struktur Menu di bawah 

OpenFileDialog 

Name 

OPDlg 

‐ 

SaveFileDialog 

Name 

SFDlg 

‐ 

FontDialog 

Name 

FontDlg 

‐ 

ColorDialog 

Name 

ClrDlg 

‐ 

 

Ng Poi Wong, S.Kom, MTI   

Page 4 

MenuStrip  File 

Edit 

Format 

New 

Undo 

Font 

Open 

Redo 

Color 

Save 

‐‐‐‐‐‐ 

Bullet

‐‐‐‐‐‐ 

Cut 

Exit 

Copy  Paste 

 

  Nama Menu  File  New  Open  Save 

Name 

MnFile 

Name 

MnFileNew 

ShortcutKeys  Name  ShortcutKeys  Name  ShortcutKeys 

Ctrl + N  MnFileOpen  Ctrl + O  MnFileSave  Ctrl + S 

Keterangan  ‐  ‐  ‐  ‐ 

‐‐‐‐‐‐ 

Name 

MnFileBar 

Separator 

Exit 

Name 

MnFileExit 

‐ 

Edit 

Name 

MnEdit 

‐ 

Name 

MnEditUndo 

Undo  Redo  ‐‐‐‐‐‐  Cut  Copy  Paste 

ShortcutKeys  Name  ShortcutKeys 

Ctrl + Z  MnEditRedo  Ctrl + Y 

Name 

MnEditBar 

Name 

MnEditCut 

ShortcutKeys  Name  ShortcutKeys  Name  ShortcutKeys 

Ctrl + X  MnEditCopy  Ctrl + C  MnEditPaste  Ctrl + V 

‐  ‐  Separator  ‐  ‐  ‐ 

Format 

Name 

MnFormat 

‐ 

Font 

Name 

MnFormatFont 

‐ 

Ng Poi Wong, S.Kom, MTI   

Daftar Properties pada MenuStrip  Properties  Nilai 

Page 5 

Color 

Name 

MnFormatColor 

‐ 

Bullet 

Name 

MnFormatBullet 

‐ 

  Kode Program pada Form :  Public Class FrmMiniWordPad Private Sub MiniWordPad_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.WindowState = FormWindowState.Maximized RTB.Dock = DockStyle.Fill RTB.BulletIndent = 25 OPDlg.Title = "Open RTF File" OPDlg.Filter = "RTF Document (*.RTF)|*.RTF" OPDlg.FileName = "" SFDlg.Title = "Save RTF File As" SFDlg.Filter = "RTF Document (*.RTF)|*.RTF" SFDlg.FileName = "" FontDlg.FontMustExist = True FontDlg.ShowApply = True FontDlg.ShowEffects = True ClrDlg.FullOpen = True End Sub Private Sub MnFileNew_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFileNew.Click RTB.Clear() End Sub Private Sub MnFileOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFileOpen.Click Try OPDlg.ShowDialog() RTB.LoadFile(OPDlg.FileName) RTB.Focus() Catch ex As Exception Exit Sub End Try End Sub Private Sub MnFileSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFileSave.Click Try SFDlg.ShowDialog() RTB.SaveFile(SFDlg.FileName) Catch ex As Exception Exit Sub End Try End Sub Private Sub MnFileExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFileExit.Click End End Sub Private Sub MnEditUndo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnEditUndo.Click

Ng Poi Wong, S.Kom, MTI   

Page 6 

RTB.Undo() End Sub Private Sub MnEditRedo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnEditRedo.Click RTB.Redo() End Sub Private Sub MnEditCut_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnEditCut.Click RTB.Cut() End Sub Private Sub MnEditCopy_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnEditCopy.Click RTB.Copy() End Sub Private Sub MnEditPaste_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnEditPaste.Click RTB.Paste() End Sub Private Sub MnFormatFont_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFormatFont.Click FontDlg.ShowDialog() RTB.SelectionFont = FontDlg.Font End Sub Private Sub FontDlg_Apply(ByVal sender As Object, ByVal e As System.EventArgs) Handles FontDlg.Apply RTB.SelectionFont = FontDlg.Font End Sub Private Sub MnFormatColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFormatColor.Click ClrDlg.ShowDialog() RTB.SelectionColor = ClrDlg.Color End Sub Private Sub MnFormatBullet_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFormatBullet.Click RTB.SelectionBullet = Not RTB.SelectionBullet End Sub End Class 

              Ng Poi Wong, S.Kom, MTI   

Page 7 

SOAL 3 :  Program Data Berat Badan Pasien. Program ini terdiri dari 4 Form dan 1 Modul. 

Form FrmDataPasien 

 

  Daftar Properties pada FrmDataPasien  Properties  Nilai 

Jenis Objek  Form  MenuStrip 

Name 

FrmDataPasien 

Text 

“Data Pasien” 

Name 

MS 

Keterangan  ‐  Lihat Struktur Menu di bawah 

  MenuStrip  File  Master  Laporan  ‐‐‐‐‐‐  Keluar 

 

  Nama Menu  File  Ng Poi Wong, S.Kom, MTI   

Daftar Properties pada MenuStrip  Properties  Nilai  Name 

MnFile 

Keterangan  ‐  Page 8 

Master 

Name 

MnFileMaster 

‐ 

Laporan 

Name 

MnFileLaporan 

‐ 

‐‐‐‐‐‐ 

Name 

MnFileBar 

Separator 

Keluar 

Name 

MnFileKeluar 

‐ 

  Kode Program pada FrmDataPasien :  Public Class FrmDataPasien Private Sub FrmDataPasien_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.IsMdiContainer = True Me.WindowState = FormWindowState.Maximized End Sub Private Sub MnFileMaster_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFileMaster.Click FrmMaster.Show() End Sub Private Sub MnFileLaporan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFileLaporan.Click FrmLaporan.Show() End Sub Private Sub MnFileKeluar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnFileKeluar.Click End End Sub End Class 

   

Form FrmMaster  Ng Poi Wong, S.Kom, MTI   

  Page 9 

  Jenis Objek 

Daftar Properties pada FrmMaster  Properties  Nilai  Name 

Form 

FrmDataPasien  “Master Data Pasien” 

MaximizeBox 

False 

MinimizeBox 

False 

‐ 

Label 

Text 

“Kode Pasien :” 

‐ 

Label 

Text 

“Nama Pasien :” 

‐ 

Label 

Text 

“Alamat :” 

‐ 

Label 

Text 

“Jenis Kelamin :” 

‐ 

Label 

Text 

“Umur :” 

‐ 

Label 

Text 

“Tinggi Badan :” 

‐ 

Label 

Text 

“Berat Badan :” 

‐ 

Label 

Text 

“Berat Ideal :” 

‐ 

Label 

Text 

“Keterangan :” 

‐ 

Label 

Text 

“Tahun” 

‐ 

Label 

Text 

“Cm” 

‐ 

Label 

Text 

“Kg” 

‐ 

Label 

Text 

“Kg” 

‐ 

Label  Label 

Name  Text  Name  Text 

LblIdeal    LblKet   

‐  ‐ 

TextBox 

Name 

TxtKode 

‐ 

TextBox 

Name 

TxtNama 

‐ 

TextBox 

Name 

TxtAlamat 

‐ 

TextBox 

Name 

TxtUmur 

‐ 

TextBox 

Name 

TxtTinggi 

‐ 

TextBox 

Name 

TxtBerat 

‐ 

CheckBox 

Name 

CboJK 

‐ 

Name 

BtnDaftar 

Button  Button  Button  Ng Poi Wong, S.Kom, MTI   

Text 

Keterangan 

Text 

“…” 

Name 

BtnBaru 

Text 

“Baru” 

Name 

BtnSimpan 

‐  ‐  ‐  Page 10 

Button  Button  Button 

Text 

“Simpan” 

Name 

BtnUpdate 

Text 

“Update” 

Name 

BtnHapus 

Text 

“Hapus” 

Name 

BtnKeluar 

Text 

“Keluar” 

‐  ‐  ‐ 

  Kode Program pada FrmMaster :  Imports System.Data.OleDb Public Class FrmMaster Dim Ds As DataSet Dim Da As OleDbDataAdapter Dim SQL As String Dim RecCount As Integer Private Sub FrmMaster_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Try Ds = New DataSet Conn.Open() Catch ex As Exception MessageBox.Show("Tabel Pasien Error...", "Error", MessageBoxButtons.OK, MessageBoxIcon.Information) Me.Close() End Try Me.MdiParent = FrmDataPasien TxtKode.MaxLength = 8 TxtNama.MaxLength = 50 TxtAlamat.MaxLength = 100 CboJK.DropDownStyle = ComboBoxStyle.DropDownList CboJK.Items.AddRange(New String() {"Pria", "Wanita"}) BtnBaru_Click(Nothing, Nothing) End Sub Private Sub FrmMaster_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed Conn.Close() End Sub Private Sub BtnDaftar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnDaftar.Click FrmDaftar.Show() End Sub Private Sub BtnBaru_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBaru.Click TxtKode.Clear() TxtNama.Clear() TxtNama.Enabled = False TxtAlamat.Clear()

Ng Poi Wong, S.Kom, MTI   

Page 11 

TxtAlamat.Enabled = False CboJK.SelectedIndex = 0 CboJK.Enabled = False TxtUmur.Clear() TxtUmur.Enabled = False TxtTinggi.Clear() TxtTinggi.Enabled = False TxtBerat.Clear() TxtBerat.Enabled = False LblIdeal.Text = "" LblKet.Text = "" BtnSimpan.Enabled = False BtnUpdate.Enabled = False BtnHapus.Enabled = False TxtKode.Focus() End Sub Private Sub TxtKode_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TxtKode.TextChanged Dim Brs As DataRow SQL = "Select * From Pasien Where Kode = '" & TxtKode.Text & "'" Try Ds.Clear() Da = New OleDbDataAdapter(SQL, Conn) Da.Fill(Ds, "Pasien") Catch ex As Exception MessageBox.Show("Tabel Pasien Error...", "Error", MessageBoxButtons.OK, MessageBoxIcon.Information) Exit Sub End Try If TxtKode.Text.Trim.Length > 0 Then TxtNama.Clear() TxtNama.Enabled = True TxtAlamat.Clear() TxtAlamat.Enabled = True CboJK.SelectedIndex = 0 CboJK.Enabled = True TxtUmur.Clear() TxtUmur.Enabled = True TxtTinggi.Clear() TxtTinggi.Enabled = True TxtBerat.Clear() TxtBerat.Enabled = True If Ds.Tables("Pasien").Rows.Count > 0 Then Brs = Ds.Tables("Pasien").Rows(0) TxtNama.Text = Brs("Nama") TxtAlamat.Text = Brs("Alamat") CboJK.SelectedIndex = If(Brs("JK") = "L", 0, 1) TxtUmur.Text = Brs("Umur") TxtTinggi.Text = Brs("Tinggi") TxtBerat.Text = Brs("Berat") BtnSimpan.Enabled = False BtnUpdate.Enabled = True BtnHapus.Enabled = True Else BtnSimpan.Enabled = True BtnUpdate.Enabled = False BtnHapus.Enabled = False

Ng Poi Wong, S.Kom, MTI   

Page 12 

End If Else BtnBaru_Click(Nothing, Nothing) End If End Sub Private Sub TxtUmur_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TxtUmur.KeyPress If Not (Asc(e.KeyChar) >= Keys.D0 And Asc(e.KeyChar) <= Keys.D9 Or Asc(e.KeyChar) = Keys.Back) Then e.KeyChar = Chr(Keys.None) End If End Sub Private Sub TxtTinggiBerat_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TxtTinggi.KeyPress, TxtBerat.KeyPress If Not (Asc(e.KeyChar) >= Keys.D0 And Asc(e.KeyChar) <= Keys.D9 Or Asc(e.KeyChar) = Keys.Back Or e.KeyChar = ".") Then e.KeyChar = Chr(Keys.None) End If End Sub Private Sub TxtTinggiBerat_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TxtTinggi.TextChanged, TxtBerat.TextChanged Dim IMT As Single = Val(TxtBerat.Text) / Math.Pow(Val(TxtTinggi.Text) / 100, 2) LblIdeal.Text = (Val(TxtTinggi.Text) - 100) * 0.9 Select Case IMT Case Is < 18.5 LblKet.Text = "KURANG GIZI" Case 18.5 To 22.9 LblKet.Text = "NORMAL" Case 23 To 24.9 LblKet.Text = "NORMAL TINGGI" Case 25 To 29.9 LblKet.Text = "GEMUK" Case Is >= 30 LblKet.Text = "OBESITAS" End Select End Sub Private Sub BtnSimpan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnSimpan.Click SQL = "Insert Into Pasien Values ('" & TxtKode.Text & "', '" & TxtNama.Text & "', '" & TxtAlamat.Text & "', '" & If(CboJK.SelectedIndex = 0, "L", "P") & "', " & TxtUmur.Text & ", " & TxtTinggi.Text & ", " & TxtBerat.Text & ")" Using Cmd = New OleDbCommand(SQL, Conn) RecCount = Cmd.ExecuteNonQuery If RecCount > 0 Then BtnBaru_Click(Nothing, Nothing) Else MessageBox.Show("Data Tidak Dapat Di-Simpan ... !!!", "Data Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End If End Using End Sub

Ng Poi Wong, S.Kom, MTI   

Page 13 

Private Sub BtnUpdate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnUpdate.Click SQL = "Update Pasien Set Nama = '" & TxtNama.Text & "', Alamat = '" & TxtAlamat.Text & "', JK = '" & If(CboJK.SelectedIndex = 0, "L", "P") & "', Umur = " & TxtUmur.Text & ", Tinggi = " & TxtTinggi.Text & ", Berat = " & TxtBerat.Text & " Where Kode = '" & TxtKode.Text & "'" Using Cmd = New OleDbCommand(SQL, Conn) RecCount = Cmd.ExecuteNonQuery If RecCount > 0 Then BtnBaru_Click(Nothing, Nothing) Else MessageBox.Show("Data Tidak Dapat Di-Simpan ... !!!", "Data Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End If End Using End Sub Private Sub BtnHapus_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnHapus.Click Dim Hasil As DialogResult SQL = "Delete From Pasien Where Kode = '" & TxtKode.Text & "'" Using Cmd As New OleDbCommand(SQL, Conn) Hasil = MessageBox.Show("Apakah Anda Yakin ?", "Hapus Data", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2) If Hasil = Windows.Forms.DialogResult.Yes Then RecCount = Cmd.ExecuteNonQuery() If RecCount > 0 Then BtnBaru_Click(Nothing, Nothing) Else MessageBox.Show("Data Tidak Dapat Di-Hapus ... !!!", "Data Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End If End If End Using End Sub Private Sub BtnKeluar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnKeluar.Click Me.Close() End Sub End Class 

   

Ng Poi Wong, S.Kom, MTI   

Page 14 

Form FrmDaftar 

 

  Daftar Properties pada FrmDaftar  Properties  Nilai 

Jenis Objek 

Name  Form 

DataGridView 

Text 

Keterangan 

FrmDaftar  “Daftar Pasien” 

MaximizeBox 

False 

MinimizeBox 

False 

Name 

DGV 

‐ 

‐ 

  Kode Program pada FrmDaftar :  Imports System.Data.OleDb Public Class FrmDaftar Dim Ds As DataSet Dim Da As OleDbDataAdapter Private Sub FrmDaftar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Try Ds = New DataSet Da = New OleDbDataAdapter("Select Kode, Nama, Alamat From Pasien", Conn) Da.Fill(Ds, "Pasien") Catch ex As Exception MessageBox.Show("Tabel Pasien Error...", "Error", MessageBoxButtons.OK, MessageBoxIcon.Information) Me.Close() End Try Me.MdiParent = FrmDataPasien DGV.DataSource = Ds.Tables("Pasien") DGV.Dock = DockStyle.Fill DGV.AllowUserToAddRows = False

Ng Poi Wong, S.Kom, MTI   

Page 15 

DGV.AllowUserToDeleteRows = False DGV.ReadOnly = True DGV.SelectionMode = DataGridViewSelectionMode.FullRowSelect End Sub Private Sub DGV_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles DGV.DoubleClick FrmMaster.TxtKode.Text = DGV.CurrentRow.Cells(0).Value Me.Close() End Sub End Class 

   

 

Form FrmLaporan    Jenis Objek 

Daftar Properties pada FrmLaporan  Properties  Nilai  Name 

Form 

FrmLaporan  “Laporan Data Pasien” 

MaximizeBox 

False 

MinimizeBox 

False 

‐ 

Label 

Text 

“Kode Pasien :” 

‐ 

Label 

Text 

“Berat Ideal :” 

‐ 

Ng Poi Wong, S.Kom, MTI   

Text 

Keterangan 

Page 16 

Label 

Text 

“Keterangan :” 

‐ 

Label 

Text 

“Kg” 

‐ 

Label  Label  TextBox  Button  DataGridView 

Name  Text  Name  Text 

LblIdeal    LblKet   

Name 

TxtKode 

Name 

BtnKeluar 

Text 

“Keluar” 

Name 

DGV 

‐  ‐  ‐  ‐  ‐ 

  Kode Program pada FrmLaporan :  Imports System.Data.OleDb Public Class FrmLaporan Dim Ds As DataSet Dim Da As OleDbDataAdapter Private Sub BeratIdeal(ByVal Tinggi As Single, ByVal Berat As Single) Dim IMT As Single = Berat / Math.Pow(Tinggi / 100, 2) LblIdeal.Text = (Tinggi - 100) * 0.9 Select Case IMT Case Is < 18.5 LblKet.Text = "KURANG GIZI" Case 18.5 To 22.9 LblKet.Text = "NORMAL" Case 23 To 24.9 LblKet.Text = "NORMAL TINGGI" Case 25 To 29.9 LblKet.Text = "GEMUK" Case Is >= 30 LblKet.Text = "OBESITAS" End Select End Sub Private Sub FrmLaporan_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Try Ds = New DataSet Da = New OleDbDataAdapter("Select * From Pasien", Conn) Da.Fill(Ds, "Pasien") Catch ex As Exception MessageBox.Show("Tabel Pasien Error...", "Error", MessageBoxButtons.OK, MessageBoxIcon.Information) Me.Close() End Try Me.MdiParent = FrmDataPasien DGV.DataSource = Ds.Tables("Pasien") DGV.AllowUserToAddRows = False DGV.AllowUserToDeleteRows = False

Ng Poi Wong, S.Kom, MTI   

Page 17 

DGV.ReadOnly = True DGV.SelectionMode = DataGridViewSelectionMode.FullRowSelect End Sub Private Sub TxtKode_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TxtKode.TextChanged Dim Temu As Boolean = False Dim Pos As Long = 0 While Pos < BindingContext(Ds.Tables("Pasien")).Count And Not Temu If Ds.Tables("Pasien").Rows(Pos)("Kode") = TxtKode.Text Then Temu = True Else Pos += 1 End If End While If Temu Then BindingContext(Ds.Tables("Pasien")).Position = Pos BeratIdeal(Ds.Tables("Pasien").Rows(Pos)("Tinggi"), Ds.Tables("Pasien").Rows(Pos)("Berat")) Else LblIdeal.Text = "" LblKet.Text = "" End If End Sub Private Sub DGV_CellClick(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DGV.CellClick BeratIdeal(DGV.CurrentRow.Cells("Tinggi").Value, DGV.CurrentRow.Cells("Berat").Value) End Sub Private Sub BtnKeluar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnKeluar.Click Me.Close() End Sub End Class 

    Kode Program pada Modul :  Imports System.Data.OleDb Module MdlPasien Public ConnStr As String = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & My.Application.Info.DirectoryPath & "\Kesehatan.mdb;" Public Conn As New OleDbConnection(ConnStr) End Module 

   

Ng Poi Wong, S.Kom, MTI   

Page 18 

Related Documents