CREATING GRAPHIC EDITOR
On Visual Basic
Main INTERFACE
Source Code:
Dim EraserColor As Long
Dim EraserSize As Integer
Dim PencilSize As Integer
Dim BoxInversed As Boolean
Dim GradationChanged As Boolean
Dim XX As Double, YY As Double
Dim XX2 As Double, YY2 As Double
Dim CurrentChoice
Dim TheColor As Long
Dim Red As Long
Dim Green As Long
Dim Blue As Long
Dim SecondColor As Long
Dim FirstColor As Long
Private Sub BoxOptionInterior_Click (Index As Integer)
BoxOptionSample. BackStyle = IIf (Index = 2, 0, 1)
If Index = 0 Then BoxOptionSample. BackColor = FirstColor
If Index = 1 Then BoxOptionSample. BackColor = SecondColor
If Index = 3 Then BoxOptionSample. BackColor = &HFFFFFF
End Sub
Private Sub ColorBoard_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo 10
TheColor = ColorBoard. Point (x, y)
If Button <> 1 And Button <> 2 Then Exit Sub
If Button = 1 Then ForeColorSample. BackColor = TheColor: FirstColor = TheColor: g = 0
If Button = 2 Then BackColorSample. BackColor = TheColor: SecondColor = TheColor: g = 3
Scroll(g).Value = TakeRGB (TheColor, 0): Scroll (g + 1).Value = TakeRGB (TheColor, 1): Scroll (g + 2).Value = TakeRGB (TheColor, 2)
10 End Sub
Private Sub Command1_Click()
f$ = InputBox («Input the size of the eraser», «Drawer V1.0», EraserOptionText. Text)
f$ = RTrim$(LTrim$(f$))
If «» + f$ <> Str$(Val (f$)) Then MsgBox «Input error!», vbOKOnly, «Drawer V1.0»: Exit Sub
If Val (f$) <> Int (Val(f$)) Then MsgBox «Input error!», vbOKOnly, «Drawer V1.0»: Exit Sub
If Val (f$) > 500 Or Val (f$) < 100 Then MsgBox «Input error!», vbOKOnly, «Drawer V1.0»: Exit Sub
EraserOptionText. Text = f$
EraserSize = Val (f$)
Shape3. Width = Val (f$): Shape3. Height = Val (f$)
Shape1. Width = Val (f$): Shape1. Height = Val (f$)
End Sub
Private Sub Command2_Click()
f$ = InputBox («Input the border of the line or pencil», «Drawer V1.0», LineOptionText. Text)
f$ = RTrim$(LTrim$(f$))
If «» + f$ <> Str$(Val (f$)) Then MsgBox «Input error!», vbOKOnly, «Drawer V1.0»: Exit Sub
If Val (f$) <> Int (Val(f$)) Then MsgBox «Input error!», vbOKOnly, «Drawer V1.0»: Exit Sub
If Val (f$) > 10 Or Val (f$) < 1 Then MsgBox «Input error!», vbOKOnly, «Drawer V1.0»: Exit Sub
LineOptionText. Text = f$
PencilSize = Val (f$)
Line2. BorderWidth = Val (f$)
End Sub
Private Sub DialogBox_Click (Index As Integer)
Static coloring As Long
On Error GoTo 100
CommonDialog1. ShowColor
coloring = CommonDialog1. Color
Scroll (Index * 3).Value = TakeRGB (coloring, 0)
Scroll (Index * 3 + 1).Value = TakeRGB (coloring, 1)
Scroll (Index * 3 + 2).Value = TakeRGB (coloring, 2)
100
End Sub
Private Sub EraserOptionColor_Click (Index As Integer)
EraserColor = IIf (Index = 0, SecondColor, &HFFFFFF)
End Sub
Private Sub EraserOptionText_GotFocus()
Command1. SetFocus
End Sub
Private Sub Form_Load()
EraserColor = &HFFFFFF
PencilSize = 1
EraserSize = 300
CurrentChoice = 1
FirstColor = &H0
SecondColor = &HFFFFFF
End Sub
Private Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
Shape1. Visible = False
End Sub
Private Sub GradationColor_Click (Index As Integer)
GradationChanged = True
End Sub
Private Sub GradationDirection_Click (Index As Integer)
GradationChanged = True
End Sub
Private Sub LineOptionText_GotFocus()
Command2. SetFocus
End Sub
Private Sub MainPic_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
If Button <> 1 Then Exit Sub
Select Case CurrentChoice
Case 1
Line1.X1 = x: Line1.X2 = x
Line1.Y1 = y: Line1.Y2 = y
Line1. Visible = True
Case 2
XX = x: YY = y
Case 3
MainPic. Line (Shape1. Left, Shape1. Top) - (Shape1. Left + Shape1. Width, Shape1. Top + Shape1. Width), EraserColor, BF
Case 4, 5, 8
XX = x: YY = y
XX2 = x: YY2 = y
Shape2. Shape = IIf (CurrentChoice = 5, 2, 0)
Shape2. Visible = True
Shape2. Left = x: Shape2. Top = y
Shape2. Width = 0: Shape2. Height = 0
End Select
End Sub
Private Sub MainPic_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
If CurrentChoice = 3 Then
Shape1. Left = x - Shape1. Width / 2
Shape1. Top = y - Shape1. Width / 2
Shape1. Visible = True
End If
If Button <> 1 Then GoTo 10
Select Case CurrentChoice
Case 1
Line1.X2 = x: Line1.Y2 = y
Case 2
MainPic. DrawWidth = PencilSize
MainPic. Line (XX, YY) - (x, y), FirstColor: XX = x: YY = y
MainPic. DrawWidth = 1
Case 3
MainPic. Line (Shape1. Left, Shape1. Top) - (Shape1. Left + Shape1. Width, Shape1. Top + Shape1. Width), EraserColor, BF
Case 4, 5, 8
XX2 = x: YY2 = y
Shape2. Left = IIf (x > XX, XX, x)
Shape2. Top = IIf (y > YY, YY, y)
Shape2. Width = Abs (x - XX)
Shape2. Height = Abs (y - YY)
Case 6
Scroll(0).Value = TakeRGB (MainPic. Point (x, y), 0)
Scroll(1).Value = TakeRGB (MainPic. Point (x, y), 1)
Scroll(2).Value = TakeRGB (MainPic. Point (x, y), 2)
End Select
Exit Sub
10 If Button <> 2 Or CurrentChoice <> 6 Then Exit Sub
Scroll(3).Value = TakeRGB (MainPic. Point (x, y), 0)
Scroll(4).Value = TakeRGB (MainPic. Point (x, y), 1)
Scroll(5).Value = TakeRGB (MainPic. Point (x, y), 2)
End Sub
Private Sub MainPic_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
If Button <> 1 Then Exit Sub
Select Case CurrentChoice
Case 1
MainPic. DrawWidth = PencilSize
MainPic. Line (Line1.X1, Line1.Y1) - (Line1.X2, Line1.Y2), FirstColor
MainPic. DrawWidth = 1
Line1. Visible = False
Case 4
If BoxOptionInterior(0).Value = True Then MainPic. Line (XX, YY) - (XX2, YY2), FirstColor, BF
If BoxOptionInterior(1).Value = True Then MainPic. Line (XX, YY) - (XX2, YY2), SecondColor, BF
If BoxOptionInterior(3).Value = True Then MainPic. Line (XX, YY) - (XX2, YY2), &HFFFFFF, BF
MainPic. Line (XX, YY) - (XX2, YY2), FirstColor, B
Shape2. Visible = False
Case 5
Rad = IIf (Abs(YY2 - YY) > Abs (XX2 - XX), Abs (YY2 - YY) / 2, Abs (XX2 - XX) / 2)
If XX2 <> XX Then MainPic. Circle ((XX2 + XX) / 2, (YY2 + YY) / 2), Rad, FirstColor, Abs (YY2 - YY) / Abs (XX2 - XX)
Shape2. Visible = False
Case 8
Dim sc1 As Long
Dim sc2 As Long
sc1 = FirstColor
If GradationColor(0).Value = True Then sc2 = SecondColor
If GradationColor(1).Value = True Then sc2 = &HFFFFFF
If GradationColor(2).Value = True Then sc2 = &H0
f1 = TakeRGB (sc2, 0): f2 = TakeRGB (sc2, 1): f3 = TakeRGB (sc2, 2)
v1 = TakeRGB (sc1, 0): v2 = TakeRGB (sc1, 1): v3 = TakeRGB (sc1, 2)
forstep = 10
If XX2 < XX Then xx3 = XX: XX = XX2: XX2 = xx3
If YY2 < YY Then yy3 = YY: YY = YY2: YY2 = yy3
ForStart = IIf (GradationDirection(0).Value = True, XX, YY)
Endpro = IIf (GradationDirection(0).Value = True, XX2, YY2)
For i = ForStart To Endpro Step forstep
D1 = v1 + (f1 - v1) / (Endpro - ForStart) * (i - ForStart)
D2 = v2 + (f2 - v2) / (Endpro - ForStart) * (i - ForStart)
D3 = v3 + (f3 - v3) / (Endpro - ForStart) * (i - ForStart)
If GradationDirection(0).Value = True Then MainPic. Line (i, YY) - (i, YY2), RGB (D1, D2, D3)
If GradationDirection(1).Value = True Then MainPic. Line (XX, i) - (XX2, i), RGB (D1, D2, D3)
Next i
Shape2. Visible = False
End Select
End Sub
Private Sub Scroll_Change (Index As Integer)
P = Int (Index / 3)
RGBValue(P).Caption = «RGB (» + RTrim$(Str$(Scroll (P * 3).Value)) +»,» + RTrim$(Str$(Scroll (P * 3 + 1).Value)) +»,» + RTrim$(Str$(Scroll (P * 3 + 2).Value)) +»)»
TheColor = RGB (Scroll(P * 3).Value, Scroll (P * 3 + 1).Value, Scroll (P * 3 + 2).Value)
If P = 0 Then FirstColor = TheColor: ForeColorSample. BackColor = TheColor Else SecondColor = TheColor: BackColorSample. BackColor = TheColor
Line2. BorderColor = FirstColor
BoxOptionSample. BorderColor = FirstColor
If BoxOptionInterior(0).Value = True Then BoxOptionSample. BackColor = FirstColor
If BoxOptionInterior(1).Value = True Then BoxOptionSample. BackColor = SecondColor
GradationChanged = True
End Sub
Private Sub Scroll_Scroll (Index As Integer)
P = Int (Index / 3)
RGBValue(P).Caption = «RGB (» + RTrim$(Str$(Scroll (P * 3).Value)) +»,» + RTrim$(Str$(Scroll (P * 3 + 1).Value)) +»,» + RTrim$(Str$(Scroll (P * 3 + 2).Value)) +»)»
TheColor = RGB (Scroll(P * 3).Value, Scroll (P * 3 + 1).Value, Scroll (P * 3 + 2).Value)
If P = 0 Then FirstColor = TheColor: ForeColorSample. BackColor = TheColor Else SecondColor = TheColor: BackColorSample. BackColor = TheColor
Line2. BorderColor = FirstColor
BoxOptionSample. BorderColor = FirstColor
If BoxOptionInterior(0).Value = True Then BoxOptionSample. BackColor = FirstColor
If BoxOptionInterior(1).Value = True Then BoxOptionSample. BackColor = SecondColor
GradationChanged = True
End Sub
Function TakeRGB (Colors As Long, Index As Integer) As Long
IndexColor = Colors
Red = IndexColor - Int (IndexColor / 256) * 256: IndexColor = (IndexColor - Red) / 256
Green = IndexColor - Int (IndexColor / 256) * 256: IndexColor = (IndexColor - Green) / 256
Blue = IndexColor
If Index = 0 Then TakeRGB = Red
If Index = 1 Then TakeRGB = Green
If Index = 2 Then TakeRGB = Blue
End Function
Private Sub SubMenuBlur_Click()
f = 97: f2 = f / 2 - 1
All = (MainPic. ScaleWidth - f) * (MainPic. ScaleHeight - f) / f / f
For i = f2 To MainPic. ScaleWidth - f2 Step f
For j = f2 To MainPic. ScaleHeight - f2 Step f
r = 0: g = 0: b = 0
For k = - f2 To f2 Step f2 / 2: For l = - f2 To f2 Step f2 / 2
r = r + TakeRGB (MainPic. Point (i + k, j + l), 0)
g = g + TakeRGB (MainPic. Point (i + k, j + l), 1)
b = b + TakeRGB (MainPic. Point (i + k, j + l), 2)
Next l, k
MainPic. Line (i - f2, j - f2) - (i + f2, j + f2), RGB (r / 25, g / 25, b / 25), BF
h = h + 1
If h > All Then ProgressBar1. Value = 100 Else ProgressBar1. Value = h / All * 100
Next j
Next i
MsgBox «done!!!»
ProgressBar1. Value = 0
End Sub
Private Sub SubMenuExit_Click()
End
End Sub
Private Sub SubMenuNew_Click()
MainPic. Cls
End Sub
Private Sub SubMenuOpen_Click()
On Error GoTo 10
CommonDialog1. ShowOpen
MainPic. Picture = LoadPicture (CommonDialog1. FileName)
10
End Sub
Private Sub SubMenuSharpen_Click()
All = (MainPic. ScaleWidth - 2) * (MainPic. ScaleHeight - 2)
For i = 1 To MainPic. ScaleWidth - 2
For j = 1 To MainPic. ScaleHeight - 2
r = TakeRGB (MainPic. Point (i, j), 0) + 0.5 * (TakeRGB (MainPic. Point (i, j), 0) - TakeRGB (MainPic. Point (i - 1, j - 1), 0))
g = TakeRGB (MainPic. Point (i, j), 1) + 0.5 * (TakeRGB (MainPic. Point (i, j), 1) - TakeRGB (MainPic. Point (i - 1, j - 1), 1))
b = TakeRGB (MainPic. Point (i, j), 2) + 0.5 * (TakeRGB (MainPic. Point (i, j), 2) - TakeRGB (MainPic. Point (i - 1, j - 1), 2))
If r > 255 Then r = 255 Else If r < 0 Then r = 0
If g > 255 Then g = 255 Else If g < 0 Then g = 0
If b > 255 Then b = 255 Else If b < 0 Then b = 0
h = h + 1
ProgressBar1. Value = h / All * 100
MainPic.PSet (i, j), RGB (r, g, b)
Next j, i
MsgBox «done!»
End Sub
Private Sub Text1_Change()
End Sub
Private Sub Timer1_Timer()
If GradationChanged = False Then Exit Sub
Dim sc1 As Long
Dim sc2 As Long
sc1 = FirstColor
If GradationColor(0).Value = True Then sc2 = SecondColor
If GradationColor(1).Value = True Then sc2 = &HFFFFFF
If GradationColor(2).Value = True Then sc2 = &H0
f1 = TakeRGB (sc2, 0): f2 = TakeRGB (sc2, 1): f3 = TakeRGB (sc2, 2)
v1 = TakeRGB (sc1, 0): v2 = TakeRGB (sc1, 1): v3 = TakeRGB (sc1, 2)
ForStart = 0: forstep = 10
Endpro = IIf (GradationDirection(0).Value = True, Picture1. ScaleWidth, Picture1. ScaleHeight)
For i = ForStart To Endpro Step forstep
D1 = v1 + (f1 - v1) / Endpro * i
D2 = v2 + (f2 - v2) / Endpro * i
D3 = v3 + (f3 - v3) / Endpro * i
If GradationDirection(0).Value = True Then Picture1. Line (i, 0) - (i, Picture1. ScaleHeight), RGB (D1, D2, D3)
If GradationDirection(1).Value = True Then Picture1. Line (0, i) - (Picture1. ScaleWidth, i), RGB (D1, D2, D3)
10 Next i
GradationChanged = False
End Sub
Private Sub Toolbar1_ButtonClick (ByVal Button As ComctlLib. Button)
For i = 1 To 8
If Toolbar1. Buttons(i).Value = tbrPressed Then CurrentChoice = i
Next i
Shape1. Visible = False
Line1. Visible = False
For i = 0 To 4
Optionframe(i).Visible = False
Next i
Select Case CurrentChoice
Case 1 To 2
Optionframe(0).Visible = True
Case 3
Optionframe(2).Visible = True
Case 4
Optionframe(1).Visible = True
Case 5 To 7
Optionframe(3).Visible = True
Case 8
GradationChanged = True
Optionframe(4).Visible = True
End Select
End Sub
Some Graphic Actions with Graphic Editor
|
