Creating graphic editor
Creating graphic editor
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
|