Rabu, 03 September 2008

HOW TO MAKE APLICATION FOTO EDITOR AND IMAGE EDITOR WITH VISUALBASIC 6.0?

Open the visual basic, klik File and chose New Project, then you will see the dialogbox from New Project, klik Standard EXE and klik OK. Then change form to appear to like this image.

copy this code to visual basic

Private Down As Boolean
Private startX As Long
Private startY As Long

Private Sub about_Click()
MsgBox "Program ini dibuat berdasarkan referensi" & vbCrLf & _
"dari berbagai sumber di internet," & vbCrLf & _
"dan dimodifikasi oleh Aji dan as'ari..." & vbCrLf & _
"", vbInformation, " about this program"
End Sub

Private Sub cmdnew_Click()
new_Click
End Sub

Private Sub cmdopen_Click()
open_Click
End Sub

Private Sub cmdprint_Click()
printt_Click
End Sub

Private Sub cmdredo_Click()
redo_Click
End Sub

Private Sub cmdsave_Click()
save_Click
End Sub

Private Sub changecolor_Click()
'merubah warna
CommonDialog1.ShowColor
Picture1.ForeColor = CommonDialog1.Color
Picture1.FillColor = CommonDialog1.Color
End Sub

Private Sub chkAirBrush_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
chkPencil.Value = 0
chkFill.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\SPRAY.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub

Private Sub chkErase_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkFill.Value = 0
cursor = App.Path + "\gbr\erase.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub

Private Sub chkFill_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\FLOOD.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub

Private Sub chkPencil_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
chkAirBrush.Value = 0
chkFill.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\Pencil.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub

Private Sub cmdundo_Click()
undo_Click
End Sub

Private Sub crsr_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkFill.Value = 0
chkErase.Value = 0
Picture1.MousePointer = 0
End Sub

Private Sub exit_Click()
Dim ma As String
If Paint.Caption = "Image" Then
End
Else
m = MsgBox("Save Image?", vbQuestion + vbYesNoCancel, "Save")
If m = vbYes Then
save_Click
Else
If m = vbNo Then
End
End If
End If
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim m As String
If cmdsave.Enabled = True Then
m = MsgBox("Simpan Image?", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
Else
If m = vbCancel Then
Cancel = -1
End If
End If
Exit Sub
End If
End Sub

Private Sub new_Click()
Dim m As String
If Paint.Caption = "Image" Then
Picture1.Visible = True
Picture1.Picture = LoadPicture()
Paint.Caption = "Image - Image1"
Else
m = MsgBox("Simpan Image?", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
Else
If m = vbNo Then
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
End If
End If
End If
UndoPicBox(0).Picture = Picture1.Image
UndoPicBox(1).Picture = Picture1.Image
UndoPicBox(2).Picture = Picture1.Image
UndoPicBox(3).Picture = Picture1.Image
UndoPicBox(4).Picture = Picture1.Image
End Sub

Private Sub open_Click()
Dim m As String
If Paint.Caption = "Image" Then
op
Else
m = MsgBox("Simpan Image", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
op
Else
If m = vbNo Then
op
End If
End If
End If
If Picture1.Width > 14220 Or Picture1.Height > 10260 Then GoTo toobig
UndoPicBox(0).Picture = Picture1.Image
UndoPicBox(1).Picture = Picture1.Image
UndoPicBox(2).Picture = Picture1.Image
UndoPicBox(3).Picture = Picture1.Image
UndoPicBox(4).Picture = Picture1.Image
GoTo e
toobig:
ans = MsgBox("Image terlalu besar untuk di lihat.", vbInformation, "Memory Error")
Picture1.Visible = True
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
e:
End Sub

Private Sub Picture1_Click()
If chkFill.Value = Checked Then
Picture1.BackColor = CommonDialog1.Color
End If
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
startX = X
startY = Y
Call Oldpic
undo.Enabled = True
cmdundo.Enabled = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If chkPencil.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.Line (startX, startY)-(X, Y)
Else
If chkAirBrush.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.PSet (X, Y)
Else
If chkErase.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.Line (startX, startY)-(X, Y), vbWhite
End If
End If
End If
End If
startX = X
startY = Y
End Sub

Private Sub printt_Click()
CommonDialog2.ShowPrinter
End Sub

Private Sub redo_Click()
Call Oldpic
Picture1.Picture = RedoBox.Image
redo.Enabled = False
cmdredo.Enabled = False
End Sub

Private Sub save_Click()
On Error Resume Next
CommonDialog1.DialogTitle = "Save Current Picture File"
CommonDialog1.Filter = "JPEG Files (*.JPG)|*.JPG|Bitmap Picture (*.BMP)|*.BMP|"
CommonDialog1.ShowSave
SavePicture Picture1.Image, CommonDialog1.FileName
End Sub

Private Sub Text1_Change()
If Text1 = "" Then
Text1 = 1
ElseIf Text1 < 1 Then
Text1 = 1
End If
End Sub

Private Sub Timer1_Timer()
If Picture1.Visible = True Then
cmdsave.Enabled = True
cmdprint.Enabled = True
save.Enabled = True
printt.Enabled = True
Else
If Picture1.Visible = False Then
cmdsave.Enabled = False
cmdprint.Enabled = False
save.Enabled = False
printt.Enabled = False
End If
End If
End Sub

Private Sub toolbar_Click()
If toolbar.Checked = True Then toolbar.Checked = False: Toolbar1.Visible = False Else toolbar.Checked = True: Toolbar1.Visible = True
End Sub

Private Sub toolbox_Click()
If toolbox.Checked = True Then toolbox.Checked = False: Picture2.Visible = False Else toolbox.Checked = True: Picture2.Visible = True
End Sub
Sub op()
CommonDialog1.DialogTitle = "Open a Picture File"
CommonDialog1.Filter = "JPEG Files (*.JPG)|*.JPG|Bitmap Picture (*.BMP)|*.BMP|"
CommonDialog1.ShowOpen
Set Picture1 = LoadPicture(CommonDialog1.FileName)
Paint.Caption = CommonDialog1.FileName
If Paint.Caption = "" Then
Picture1.Visible = False
Paint.Caption = "Image"
Else
Picture1.Visible = True
End If
End Sub

Private Sub undo_Click()
redo.Enabled = True
cmdredo.Enabled = True
RedoBox.Picture = Picture1.Image
Picture1.Picture = UndoPicBox(0).Image
For a = 1 To 4: UndoPicBox(a - 1).Picture = UndoPicBox(a).Image
Next a
End Sub

and add this code to make modul in visual basic

Public Function Oldpic()
Dim a
For a = 4 To 1 Step -1
Paint.UndoPicBox(a).Picture = Paint.UndoPicBox(a - 1).Image
Paint.UndoPicBox(a).Refresh
Next a
Paint.UndoPicBox(0).Picture = Paint.Picture1.Image
Paint.UndoPicBox(0).Refresh
End Function