VB Implementation of drawing tools

Source: Internet
Author: User

'The user can use the mouse to draw pictures at will, or introduce pictures and then perform simple processing. They mainly add two picture controls and several buttons (the program running interface has been uploaded to the album VB6)

Dim X1 !, V1 !, X2 !, V2 !, A1!
Private sub commandemediclick () 'clear screen button
Picture2.cls clear screen
End sub

Private sub command2_click () 'paint color button
Commondialog1.showcolor: In the general dialog box, call the color palette to select the paint brush color.
End sub

Private sub command3_click () 'specifies the paint brush width.
A1 = Val (inputbox ("Enter the width of the paint brush line (1 <x <20):", "set the width of the paint brush line", 2 ))
If A1 <1 or A1> 20 then
Msgbox "the width of the paint brush line is out of the range. Please reset it! "
Command3.value = true' is equivalent to Mouse clicking command3.
End if
Picture2.drawwidth = A1
End sub

Private sub command4_click () 'Open the image button
Commondialog1.filter = "*. JPG | *. JPG | *. BMP | *. BMP | *. JPEG | *. JPEG | *. ICO | *. ICO | *. icon | *. icon"
Commondialog1.showopen'
If commondialog1.filename <> "" then "loads the selected image file into the image box.
Picture2.picture = loadpicture (commondialog1.filename)
End if
End sub

Private sub command5_click () 'Save image button
Commondialog1.filter = "*. JPG | *. JPG | *. BMP | *. BMP | *. JPEG | *. JPEG | *. ICO | *. ICO | *. icon | *. icon"
Commondialog1.showsave
If commondialog1.filename <> "" then
Savepicture picture2.image, commondialog1.filename 'Save the image
Msgbox "Photo saved! "
End if
End sub

Private sub command6_click ()
End
End sub

Private sub command7_click () 'background color button
Commondialog1.showcolor
Picture2.backcolor = commondialog1.color
End sub

Private sub command8_click ()
Text1 = picture2.point (x, y)
End sub

Private sub form_load ()
A1 = 2' the initial paint width is 2
 
Picture2.left = 0
Picture2.top = 0
Picture2.autosize = true
Vscroll1.max = ABS (picture1.height-picture2.height)
Hscroll1.max = ABS (picture1.width-picture2.width)
End sub

Private sub form_mousedown (button as integer, shift as integer, X as single, y as Single)
X1 = x-120: Y1 = Y-120 'Save the coordinates of the mouse button
X2 = x-120: y2 = Y-120
If Button = 1 then', click the left button.
Picture2.drawwidth = a1'
Elseif button = 2 then
Picture2.drawwidth = 1' set the line width to 1 to draw a solid line
Picture2.drawmode = 7' sets the image frame draw mode to different or
End if
End sub

Private sub form_mousemove (button as integer, shift as integer, X as single, y as Single)
Me. mousepointer = 0' set the mouse pointer shape to the default arrow
End sub

Private sub form_mouseup (button as integer, shift as integer, X as single, y as Single)
If Button = 2 then' right-click
Picture2.line (x1, Y1)-(X2, Y2), B 'clear the traces of the previously drawn rectangle
On Error resume next
Picture2.dragmode = 13 'set the painting mode to copy pen
Picture2.line (x1, Y1)-(x-120, Y-120), picture2.backcolor, BF
End if
 
End sub

Private sub hscroll1_scroll ()
Picture2.left = hscroll1.value
End sub

Private sub picture2_mousemove (button as integer, shift as integer, X as single, y as Single)
Picture2.mousepointer = 99' set the User-Defined mouse pointer icon
Picture2.mouseicon = loadpicture (App. Path + "/pencil2.ico") 'app. path is the current working path of VB.
If Button = 1 then', if you press the left button
Picture2.pset (X-120, Y-120), commondialog1.color 'line
End if
If Button = 2 then', right-click or not
Picture2.line (x1, Y1)-(X2, Y2), and B 'clear the traces drawn by the rectangle
X2 = x-120: y2 = Y-120 'take the current Coordinate
Picture2.line (x1, Y1)-(X2, Y2), and B 'redraw the rectangle with the current Coordinate
End if
End sub

Private sub vscroll1_scroll ()
Picture2.top = vscroll1.value
End sub

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.