Assalamu’alaikum
Wr.Wb
Nantslight –
Masih ingat dengan Ms. Paint..? yupz..Ms. Paint adalah software bawaan
Microsoft Windows, kalau masih kecil dulu aku sering banget mainanama software
yang satu itu.. (^_^). Nah karena
teringat dengan software yang satu itu, aku jadi kepingin buat, langsung aja
aku gogling, eh ketemu.. Ya udah langsung aja aku share di blog aku.. tapi yang
aku share ini tidak sepenuhnya sama dengan yang aku dapatkan.. sudah aku edit
dan tambahin sedikit kode baru..
Langsung aja
ya...
Buka Visual Basic
6.0 dan pilih Standard.Exe..
Tambahkan 4
Command Button, 1 PictureBox, 1 Label( Copy paste-kan 1 label itu sebanyak 14
kali ), 1 frame.
Pada PictureBox
atur propertinya pada bagian AutoRedraw menjadi True dan borderstyle-nya
menjadi fixed single.
Atur tata
letaknya sesuai selera anda, kalau selera saya seperti berikut,,
Setelah itu ubah
caption command Button1=Pensil, caption command button2=hapus, caption command
button3=hapus semua, caption command button4=keluar. Kalau yang frame
captionnya ubah menjadi Warna.
Kemudian masukkan
kode di bawah ini..
----------***-----------------------------------------------------
Dim paintnow As Boolean
Private lngFormWidth As Long
Private
lngFormHeight As Long
Private
Sub Form_Resize()
Dim D(4) As Double
Dim i As Long
Dim TempPoz As Long
Dim StartPoz As Long
Dim Ctl As Control
Dim TempVisible As Boolean
Dim ScaleX As Double
Dim ScaleY As Double
ScaleX = ScaleWidth / lngFormWidth
ScaleY = ScaleHeight / lngFormHeight
On Error Resume Next
For Each Ctl In Me
TempVisible = Ctl.Visible
Ctl.Visible = False
StartPoz = 1
For i = 0 To 4
TempPoz = InStr(StartPoz, Ctl.Tag,
" ", _
vbTextCompare)
If TempPoz > 0 Then
D(i) = Mid(Ctl.Tag, StartPoz, _
TempPoz - StartPoz)
StartPoz = TempPoz + 1
Else
D(i) = 0
End If
Ctl.Move D(0) * ScaleX, D(1) *
ScaleY, _
D(2) * ScaleX, D(3) * ScaleY
Ctl.Width = D(2) * ScaleX
Ctl.Height = D(3) * ScaleY
If ScaleX < ScaleY Then
Ctl.FontSize = D(4) * ScaleX
Else
Ctl.FontSize = D(4) * ScaleY
End If
Next i
Ctl.Visible = TempVisible
Next Ctl
On Error GoTo 0
End
Sub
Private Sub Command2_Click()
Command2.Enabled = False
Command1.Enabled = True
End Sub
Private Sub Command3_Click()
Picture1.Cls
End Sub
Private Sub Command1_Click()
Command1.Enabled = False
Command2.Enabled = True
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 0 To 14
Label1(i).BackColor = QBColor(i)
Next i
Picture1.ForeColor = QBColor(0)
Picture1.BackColor = QBColor(15)
Dim Ctl As Control
lngFormWidth = ScaleWidth
lngFormHeight = ScaleHeight
On Error Resume Next
For Each Ctl In Me
Ctl.Tag = Ctl.Left & " "
& Ctl.Top & " " & _
Ctl.Width & " " &
Ctl.Height & " "
Ctl.Tag = Ctl.Tag &
Ctl.FontSize & " "
Next Ctl
On Error GoTo 0
End Sub
Private Sub Label1_Click(Index As Integer)
Picture1.ForeColor =
Label1(Index).BackColor
End Sub
Private Sub Picture1_MouseDown(Button As
Integer, _
Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
paintnow = True
Picture1.CurrentX = x
Picture1.CurrentY = y
End If
End Sub
Private Sub Picture1_MouseMove(Button As
Integer, _
Shift As Integer, x As Single, y As Single)
If paintnow Then
If Command1.Enabled = False Then
Picture1.Line -(x, y), Picture1.ForeColor
Picture1.MousePointer = 99
End If
If Command2.Enabled = False Then
Picture1.Line -(x, y), RGB(255, 255, 255),
B
Picture1.MousePointer = 12
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As
Integer, _
Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
paintnow = False
End If
End Sub
-----------------------------------------------------------***--------------------------
Setelah itu ya di tekan F5
dulu, kalau sudah gak ada yang error ya di kompilasi aja jadi exe.. ya kurang
lebih seperti inilah tampilannya waktu di jalankan..
Maaf gambarannya kurang
bermanffat.. (^_^). Yang kepengen gak ribet.. bisa langsung di unduh aja
sourcenya di sini..
Selamat Mencoba..
Semoga Bermanfaat..
Wassalamu’alaikum Wr.Wb
Tags:
Visual Basic
Leave a comment