Emely.Net Banner Exchange
Home, Forum diskusi, Chatting, Download

Latihan 3

Judul : Tantangan membuat Mari Menggambar

Buatlah program mari yang mampu menggambar bentuk Lingkaran, Persegi, Garis, Titik, dan dapat menyimpan hasil ke suatu file bmp.

Solusi :

Kita perlu mempersiapkan Enumerated Type yang akan digunakan untukm menunjukkan aksi yang akan dilakukan berdasarkan klik pemakai pada tombol tertentu. Enumerated Type ini kita ketik pada bagian General Declaration :

Private Enum Gambar
None = 0
Lingkar = 1
Persegi = 2
Garis = 3
Titik = 4
End Enum

Catatan :Tujuan pemakaian Enumerated Type untuk membuat program kita menjadi lebih terstruktur dan mudah dibaca.

Selanjutnya kita deklarasikan variabel-variabel Form Level (dideklarasikan pada General Declaration) yang berlaku bagi semua Sub yang ada dalam Form tersebut.

Dim Aksi As Gambar             'Menyimpan aksi yang akan dilakukan
Dim Tahap As Integer           'Menyimpan tahap pengambaran
Dim Pusatx As Integer          'Titik Awal (Persegi, Garis) Titik Pusat (Lingkar)
Dim Pusaty As Integer

Catatan : Untuk gambar lingkaran kita perlu titik pusat (PusatX,PusatY), untuk Persegi dan Garis kita perlu titik Awal.

Untuk melakukan aksi pengambaran kita perlu membuat suatu General Procedure, yang mana akan melakukan penggambaran sesuai dengan Aksi pemakai.

Private Sub Gambar(x, y)
Select Case Aksi               'Periksa Aksi yang akan dilakukan
       Case Lingkar
            jari = Sqr((y - Pusaty) ^ 2 + (x - Pusatx) ^ 2)
            PicKanvas.Circle (Pusatx, Pusaty), jari
       Case Persegi
            PicKanvas.Line (Pusatx, Pusaty)-(x, y), , B
       Case Garis
            PicKanvas.Line (Pusatx, Pusaty)-(x, y)
       Case Titik
            PicKanvas.PSet (x, y)
End Select
End Sub

Catatan : Pada Lingkaran kita perlu menghitung jari-jari pengambaran dengan menggunakan rumus Phytagoras.

Selanjutnya kita lakukan koding pada Event klik masing-masing Command Button :

Private Sub cmdCircle_Click()
Aksi = Lingkar                'Tandai Aksi menggambar Lingkaran
Tahap = 1                     'Tahap inisialisasi titik Awal / Pusat
End Sub

Private Sub cmdDot_Click()
Aksi = Titik
Tahap = 2                     'Kalau titik langsung ketahap akhir
End Sub

Private Sub cmdLine_Click()
Aksi = Garis
Tahap = 1
End Sub

Private Sub cmdRectangle_Click()
Aksi = Kotak
Tahap = 1
End Sub

Catatan : Untuk titik kita langsung ketahap pengambaran akhir, karena tidak diperlukan titik pusat

Melakukan koding terhadap Event MouseDown untuk mendapatkan titik Awal/Pusat, dan membuat Tahap pengambaran ke Tahap berikutnya.

Private Sub PicKanvas_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Aksi = Lingkar Or _
   Aksi = Persegi Or _
   Aksi = Garis Then          'Untuk titik tidak perlu titik Awal / Pusat
   If Tahap = 1 Then          'Jika ditandai sebagai tahap 1 (inisial titik Awal/Pusat)
      Pusatx = x              'Simpan titik Awal / Pusat
      Pusaty = y
      Tahap = 2               'Tandai sebagai tahap Berikutnya
   End If
End If
End Sub

Melakukan koding terhadap Event MouseMove untuk menggambar sementara/tidak permanen

Private Sub PicKanvas_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Aksi = Lingkar Or _
   Aksi = Persegi Or _
   Aksi = Garis And _
   Tahap = 2 Then             'Kalau Tahap 2
   PicKanvas.Refresh          'Hapus gambar sementara sebelumnya
   Call Gambar(x, y)          'Panggil Procedure Gambar
End If
End Sub

Catatan : Metoda Refresh akan menghapus gambar sementara yang dibuat dengan properti AutoRedraw = False

Melakukan koding terhadap Event MouseUp untuk membuat Gambar permanen, dan mereset Aksi pemakai kembali ke None.

Private Sub PicKanvas_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If (Aksi = Lingkar Or _
   Aksi = Persegi Or _
   Aksi = Garis) And _
   Tahap = 2 Then             'Kalau Tahap 2
   PicKanvas.Refresh          'Hapus gambar sementara sebelumnya
   Call Gambar(x, y)          'Panggil Procedure Gambar
End If
End Sub

Akhirnya kita buat Event Klik untuk menyimpan Gambar yang dihasilkan ke sebuah file :

Private Sub cmdSave_Click()
Dim fName As String
fName = InputBox("Masukkan nama file :", "Simpan kanvas")
If fName <> "" Then                         'Kalau tidak kosong
   If UCase(Left(fName, 4)) <> ".bmp" Then  'Kalau tidak ada ekstension .bmp
      fName = fName + ".bmp"                'Tambahkan ekstension
   End If
   SavePicture PicKanvas.Image, fName       'Simpan Gambar
End If
End Sub