Senin, 08 September 2014

Pemrograman Dasar XI RPL

Materi Pokok : Array 1 Dimensi dan Array Multidimensi

Tugas :

Memahami penggunaan array 1 dimensi untuk penyimpanan data di memori
Memahami penggunaan array 2 dimensi untuk penyimpanan data di memori
Memahami penggunaan array multidimensi untuk penyimpanan data di memori
Menyajikan kumpulan data berdimensi 1 dalam bentuk array
Menyajikan kumpulan data berdimensi 2 dalam bentuk array
Menyajikan kumpulan data berdimensi banyak dalam bentuk array

Hasil pekerjaan dikumpulkan oleh KM

Selamat Mengerjakan.

Rabu, 26 Maret 2014

Paket Program - Mengurutkan Data











Option Explicit
Dim bar, i, j As Integer
Dim newbar As Integer
Dim Totalbar  As Integer
Dim tmpnama() As String
Dim tmpalamat() As String
Dim tmpkelas() As String
Dim tmplahir() As String
Dim tmptxt As String
Dim Pilih As Integer

Private Sub Command1_Click()
LihatSort.Show
End Sub

Private Sub Command6_Click()
Open "sorting.txt" For Output As #1

For i = 1 To Totalbar

   For j = i To Totalbar
   Select Case Pilih
   Case 0
   If tmpnama(i) < tmpnama(j) Then sorting  ' nama ascending
   Case 1
   If tmpnama(i) > tmpnama(j) Then sorting  ' nama descending
  
   Case 2
   If Val(tmpkelas(i)) < Val(tmpkelas(j)) Then sorting  ' kelas ascending
   Case 3
   If Val(tmpkelas(i)) > Val(tmpkelas(j)) Then sorting  ' kelas descending
  
   Case 4
   If tmpalamat(i) < tmpalamat(j) Then sorting  ' alamat ascending
   Case 5
   If tmpalamat(i) > tmpalamat(j) Then sorting  ' alamat descending

   Case 6
   If Val(tmplahir(i)) < Val(tmplahir(j)) Then sorting  ' lahir ascending
   Case 7
   If Val(tmplahir(i)) > Val(tmplahir(j)) Then sorting  ' lahir descending


   End Select
     
  Next j
  Write #1, tmpnama(i), tmpkelas(i), tmpalamat(i), tmplahir(i)

Next i
  Close #1
  LihatRec (bar)

End Sub

Private Sub Form_Load() ' sorting load data
Me.Top = FormUtama.Top
Me.Left = FormUtama.Width + FormUtama.Left + 10
Totalbar = 30
ReDim tmpnama(Totalbar)
ReDim tmpalamat(Totalbar)
ReDim tmpkelas(Totalbar)
ReDim tmplahir(Totalbar)

bar = 1
Open "datasiswa.txt" For Input As #1
Do While Not EOF(1)
  
   Input #1, tmpnama(bar), tmpkelas(bar), tmpalamat(bar), tmplahir(bar)
   bar = bar + 1
  
Loop
   Totalbar = bar - 1
Close #1

  'LihatRec (Totalbar)
End Sub
Sub sorting()
   tmptxt = tmpnama(i)
   tmpnama(i) = tmpnama(j)
   tmpnama(j) = tmptxt
  
   tmptxt = tmpkelas(i)
   tmpkelas(i) = tmpkelas(j)
   tmpkelas(j) = tmptxt
  
   tmptxt = tmpalamat(i)
   tmpalamat(i) = tmpalamat(j)
   tmpalamat(j) = tmptxt
  
   tmptxt = tmplahir(i)
   tmplahir(i) = tmplahir(j)
   tmplahir(j) = tmptxt
End Sub
 Sub LihatRec(bar As Integer)

Text1.Text = tmpnama(bar)
Text2.Text = tmpkelas(bar)
Text3.Text = tmpalamat(bar)
Text4.Text = tmplahir(bar)

End Sub
Private Sub CommandSebelum_Click(Index As Integer)
bar = bar - 1

If bar <= 1 Then bar = 1

LihatRec (bar)

End Sub

Private Sub CommandSelanjutnya_Click(Index As Integer)
bar = bar + 1

If bar >= Totalbar Then bar = Totalbar

LihatRec (bar)

End Sub


Private Sub Option1_Click()
Pilih = 0
End Sub

Private Sub Option2_Click()
Pilih = 1
End Sub

Private Sub Option3_Click()
Pilih = 2
End Sub

Private Sub Option4_Click()
Pilih = 3
End Sub

Private Sub Option5_Click()
Pilih = 4
End Sub

Private Sub Option6_Click()
Pilih = 5
End Sub

Private Sub Option7_Click()
Pilih = 6
End Sub

Private Sub Option8_Click()
Pilih = 7
End Sub

=======================================






Option Explicit

Private Sub Command1_Click()
  Unload Me
End Sub

Private Sub Form_Load()
Me.Top = FormUtama.Top
Me.Left = FormUtama.Width + FormUtama.Left + 10
Dim nama, kelas, alamat, lahir As String
 Dim bar As Integer
 Dim tinggi
 tinggi = Text_nama(1).Height + 20
 bar = 1
 Label5.Alignment = 2
 Open "d:\sorting.txt" For Input As #1
Do While Not EOF(1)
   Debug.Print "Bar : "; bar
   Input #1, nama, kelas, alamat, lahir
  
   If bar = 1 Then
   Text_nama(1).Text = nama
   Text_kelas(1).Text = kelas
   Text_alamat(1).Text = alamat
   Text_lahir(1).Text = lahir
   End If
  
   If bar > 1 Then
    
    Load Text_nama(bar)
    Text_nama(bar).Visible = True
    Text_nama(bar).Left = Text_nama(bar - 1).Left
    Text_nama(bar).Top = Text_nama(bar - 1).Top + tinggi
    Text_nama(bar).Text = nama '&H00C0E0FF&
       
    Load Text_kelas(bar)
    Text_kelas(bar).Visible = True
    Text_kelas(bar).Left = Text_kelas(bar - 1).Left
    Text_kelas(bar).Top = Text_kelas(bar - 1).Top + tinggi
    Text_kelas(bar).Text = kelas
   
    Load Text_alamat(bar)
    Text_alamat(bar).Visible = True
    Text_alamat(bar).Left = Text_alamat(bar - 1).Left
    Text_alamat(bar).Top = Text_alamat(bar - 1).Top + tinggi
    Text_alamat(bar).Text = alamat
   
    Load Text_lahir(bar)
    Text_lahir(bar).Visible = True
    Text_lahir(bar).Left = Text_lahir(bar - 1).Left
    Text_lahir(bar).Top = Text_lahir(bar - 1).Top + tinggi
    Text_lahir(bar).Text = lahir
    
    Load No(bar)
    No(bar).Visible = True
    No(bar).Left = No(bar - 1).Left
    No(bar).Top = No(bar - 1).Top + tinggi
    No(bar).Caption = bar
    End If
   
    If bar Mod 2 = 0 Then
    Text_nama(bar).BackColor = &H8000000F  '&HC0E0FF
    Text_kelas(bar).BackColor = &H8000000F '&HC0E0FF
    Text_alamat(bar).BackColor = &H8000000F '&HC0E0FF
    Text_lahir(bar).BackColor = &H8000000F '&HC0E0FF
    End If
   
    bar = bar + 1
Loop
  
Close #1
  Me.Height = 1500 + Text_nama(bar - 1).Top
 Command1.Top = Text_nama(bar - 1).Top + 500

End Sub





Rabu, 19 Februari 2014

Paket Program - Pencarian Data









 


Option Explicit
Dim bar
Dim Totalbar  As Integer
Dim tmpnama() As String
Dim tmpalamat() As String
Dim tmpkelas() As String
Dim tmplahir() As String

Private Sub Command6_Click()
Dim pj As Integer
Dim i
pj = Len(Text6.Text)
For i = 1 To Totalbar
 If Mid$(UCase$(tmpnama(i)), 1, pj) = UCase$(Text6.Text) Then
  Debug.Print "Ketemu"
  Exit For
  End If
Next i
  LihatRec (i)

End Sub

Private Sub Form_Load() ' cari data
Me.Top = FormUtama.Top
Me.Left = FormUtama.Width + FormUtama.Left + 10
Totalbar = 1
ReDim tmpnama(Totalbar)
ReDim tmpalamat(Totalbar)
ReDim tmpkelas(Totalbar)
ReDim tmplahir(Totalbar)

bar = 1
Open "d:\datasiswa.txt" For Input As #1

Do While Not EOF(1)
   Input #1, tmpnama(bar), tmpkelas(bar), tmpalamat(bar), tmplahir(bar)
   Debug.Print bar
   bar = bar + 1
   If bar > Totalbar Then
      ReDim Preserve tmpnama(bar)
      ReDim Preserve tmpalamat(bar)
      ReDim Preserve tmpkelas(bar)
      ReDim Preserve tmplahir(bar)
      End If
Loop
    Totalbar = bar - 1
Close #1
LihatRec (Totalbar)
Debug.Print UBound(tmpnama)
End Sub
 Sub LihatRec(bar As Integer)

Text1.Text = tmpnama(bar)
Text2.Text = tmpkelas(bar)
Text3.Text = tmpalamat(bar)
Text4.Text = tmplahir(bar)
Text5.Text = bar


End Sub
Private Sub CommandSebelum_Click(Index As Integer)

bar = bar - 1
If bar <= 1 Then bar = 1
LihatRec (bar)

End Sub

Private Sub CommandSelanjutnya_Click(Index As Integer)

bar = bar + 1
If bar >= Totalbar Then bar = Totalbar
LihatRec (bar)

End Sub

Private Sub Text5_Change()
LihatRec (Val(Text5.Text))
End Sub


Private Sub Text6_Change()  'advance search
Dim pj As Integer
Dim i
pj = Len(Text6.Text)
For i = 1 To Totalbar
 If Mid$(UCase$(tmpnama(i)), 1, pj) = UCase$(Text6.Text) Then
  Debug.Print "Ketemu"
  Exit For
  End If
Next i
  LihatRec (i)
End Sub

Rabu, 05 Februari 2014

Paket Program - Tampilkan Data


 
Option Explicit

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
Me.Top = FormUtama.Top
Me.Left = FormUtama.Width + FormUtama.Left + 10

Dim nama, kelas, alamat, lahir As String
 Dim bar As Integer
 Dim tinggi
 tinggi = Text_nama(1).Height + 20
 bar = 1
 Label5.Alignment = 2
Open "datasiswa.txt" For Input As #1
Do While Not EOF(1)

   Input #1, nama, kelas, alamat, lahir
  
   If bar = 1 Then
   Text_nama(1).Text = nama
   Text_kelas(1).Text = kelas
   Text_alamat(1).Text = alamat
   Text_lahir(1).Text = lahir
   End If
  
   If bar > 1 Then
    Load Text_nama(bar)
    Text_nama(bar).Visible = True
    Text_nama(bar).Left = Text_nama(bar - 1).Left
    Text_nama(bar).Top = Text_nama(bar - 1).Top + tinggi
    Text_nama(bar).Text = nama '&H00C0E0FF&
       
    Load Text_kelas(bar)
    Text_kelas(bar).Visible = True
    Text_kelas(bar).Left = Text_kelas(bar - 1).Left
    Text_kelas(bar).Top = Text_kelas(bar - 1).Top + tinggi
    Text_kelas(bar).Text = kelas
   
    Load Text_alamat(bar)
    Text_alamat(bar).Visible = True
    Text_alamat(bar).Left = Text_alamat(bar - 1).Left
    Text_alamat(bar).Top = Text_alamat(bar - 1).Top + tinggi
    Text_alamat(bar).Text = alamat
   
    Load Text_lahir(bar)
    Text_lahir(bar).Visible = True
    Text_lahir(bar).Left = Text_lahir(bar - 1).Left
    Text_lahir(bar).Top = Text_lahir(bar - 1).Top + tinggi
    Text_lahir(bar).Text = lahir

    
    Load No(bar)
    No(bar).Visible = True
    No(bar).Left = No(bar - 1).Left
    No(bar).Top = No(bar - 1).Top + tinggi
    No(bar).Caption = bar
    End If
   
    If bar Mod 2 = 0 Then
    Text_nama(bar).BackColor = &H8000000F  '&HC0E0FF
    Text_kelas(bar).BackColor = &H8000000F '&HC0E0FF
    Text_alamat(bar).BackColor = &H8000000F '&HC0E0FF
    Text_lahir(bar).BackColor = &H8000000F '&HC0E0FF

    End If
   
    bar = bar + 1
Loop
  
Close #1
  Me.Height = 1500 + Text_nama(bar - 1).Top
  Command1.Top = Text_nama(bar - 1).Top + 500
 End Sub

Rabu, 29 Januari 2014

Paket Program - Menghapus Data



Option Explicit
Dim bar
Dim newbar
Dim Totalbar  As Integer
Dim tmpnama() As String
Dim tmpalamat() As String
Dim tmpkelas() As String
Dim tmplahir() As String

Private Sub Command6_Click()
newbar = 1
Open "d:\datasiswa.txt" For Output As #1
Do While newbar < Totalbar
   If newbar >= bar Then
  
   tmpnama(newbar) = tmpnama(newbar + 1): tmpkelas(newbar) = tmpkelas(newbar + 1)
   tmpalamat(newbar) = tmpalamat(newbar + 1): tmplahir(newbar) = tmplahir(newbar + 1)
   End If
  
   Write #1, tmpnama(newbar), tmpkelas(newbar), tmpalamat(newbar), tmplahir(newbar)

   newbar = newbar + 1
Loop
  Totalbar = Totalbar - 1
  Close #1
       Text1.Text = " ": Text2.Text = " ": Text3.Text = " ": Text4.Text = " "

 End Sub

Private Sub Form_Load()
Me.Top = FormUtama.Top
Me.Left = FormUtama.Width + FormUtama.Left + 10
Totalbar = 30
ReDim tmpnama(Totalbar + 1)
ReDim tmpalamat(Totalbar + 1)
ReDim tmpkelas(Totalbar + 1)
ReDim tmplahir(Totalbar + 1)

bar = 1
Open "datasiswa.txt" For Input As #1
Do While Not EOF(1)
  
   Input #1, tmpnama(bar), tmpkelas(bar), tmpalamat(bar), tmplahir(bar)
   bar = bar + 1
  
Loop
    Totalbar = bar - 1
Close #1
LihatRec (Totalbar)
End Sub
 Sub LihatRec(bar As Integer)

Text1.Text = tmpnama(bar)
Text2.Text = tmpkelas(bar)
Text3.Text = tmpalamat(bar)
Text4.Text = tmplahir(bar)

End Sub
Private Sub CommandSebelum_Click(Index As Integer)
bar = bar - 1

If bar <= 1 Then bar = 1

LihatRec (bar)

End Sub

Private Sub CommandSelanjutnya_Click(Index As Integer)
bar = bar + 1

If bar >= Totalbar Then bar = Totalbar

LihatRec (bar)

End Sub

Rabu, 22 Januari 2014

Paket Program - Perbaikan Data




Option Explicit
Dim bar
Dim Totalbar  As Integer
Dim tmpnama() As String
Dim tmpalamat() As String
Dim tmpkelas() As String
Dim tmplahir() As String

Private Sub Command6_Click()
tmpnama(bar) = Text1.Text
tmpkelas(bar) = Text2.Text
tmpalamat(bar) = Text3.Text
tmplahir(bar) = Text4.Text
Dim newbar As Integer
newbar = 1
Open "d:\datasiswa.txt" For Output As #1
Do While newbar <= Totalbar
  
   Write #1, tmpnama(newbar), tmpkelas(newbar), tmpalamat(newbar), tmplahir(newbar)
   newbar = newbar + 1

Loop
Close #1
LihatRec (bar)

End Sub

Private Sub Form_Load() ' perbaikan data
Me.Top = FormUtama.Top
Me.Left = FormUtama.Width + FormUtama.Left + 10
Totalbar = 30
ReDim tmpnama(Totalbar + 1)
ReDim tmpalamat(Totalbar + 1)
ReDim tmpkelas(Totalbar + 1)
ReDim tmplahir(Totalbar + 1)

bar = 1
Open "datasiswa.txt" For Input As #1

  Do While Not EOF(1)
   Input #1, tmpnama(bar), tmpkelas(bar), tmpalamat(bar), tmplahir(bar)
   bar = bar + 1
    Loop
Totalbar = bar - 1
Close #1
LihatRec (Totalbar)
End Sub

Sub LihatRec(bar As Integer)

Text1.Text = tmpnama(bar)
Text2.Text = tmpkelas(bar)
Text3.Text = tmpalamat(bar)
Text4.Text = tmplahir(bar)
Text5.Text = bar


End Sub

Private Sub CommandSebelum_Click(Index As Integer)

bar = bar - 1
If bar <= 1 Then bar = 1
LihatRec (bar)

End Sub

Private Sub CommandSelanjutnya_Click(Index As Integer)

bar = bar + 1
If bar >= Totalbar Then bar = Totalbar
LihatRec (bar)

End Sub

Private Sub Text5_Change()
LihatRec (Val(Text5.Text))
End Sub

Rabu, 15 Januari 2014

Paket Program - Masukan Data


 


Option Explicit
Private Sub Command5_Click()
  Dim nama As String
  Dim kelas As String
  Dim alamat As String
  Dim lahir As String

nama = Text1.Text
kelas = Text2.Text
alamat = Text3.Text
lahir = Text4.Text

    Open "datasiswa.txt" For Append As #1
    Write #1, nama, kelas, alamat, lahir
    Close #1
   
     Text1.Text = " ": Text2.Text = " ": Text3.Text = " ": Text4.Text = " "

End Sub

 
Design by Wordpress Theme Template Blog Free | Bloggerized by Free Blogger Templates | coupon codes