VB实现鼠标绘图实例代码

技术  /  管理员 发布于 7年前   255

本文所述为VB实现鼠标绘图的实例，该实例实现线条颜色和线宽可自设，当按下鼠标按键时绘图开始并记录最初的起点，如果不是处在绘图状态则退出该过程，如果处在绘图状态则从起点到目前鼠标所在点绘制直线，然后将当前鼠标所在点作为新的起点，当释放鼠标按键时绘图结束。

具体的功能代码如下：

VERSION 5.00Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"Begin VB.Form Form1   Caption     =  "鼠标绘图"  ClientHeight  =  6420  ClientLeft   =  60  ClientTop    =  345  ClientWidth   =  7710  LinkTopic    =  "Form1"  ScaleHeight   =  6420  ScaleWidth   =  7710  StartUpPosition =  3 '窗口缺省  Begin VB.CommandButton Command2    Caption     =  "清除"   Height     =  495   Left      =  5640   TabIndex    =  7   Top       =  1440   Width      =  1335  End  Begin VB.Frame Frame1    Caption     =  "线宽"   Height     =  2655   Left      =  5520   TabIndex    =  2   Top       =  2880   Width      =  1935   Begin VB.OptionButton Option4      Caption     =  "8"     Height     =  495     Left      =  240     TabIndex    =  6     Top       =  1800     Width      =  1215   End   Begin VB.OptionButton Option3      Caption     =  "4"     Height     =  375     Left      =  240     TabIndex    =  5     Top       =  1320     Width      =  1335   End   Begin VB.OptionButton Option2      Caption     =  "2"     Height     =  375     Left      =  240     TabIndex    =  4     Top       =  840     Width      =  1095   End   Begin VB.OptionButton Option1      Caption     =  "1"     Height     =  255     Left      =  240     TabIndex    =  3     Top       =  480     Value      =  -1 'True     Width      =  1335   End  End  Begin VB.CommandButton Command1    Caption     =  "设置颜色"   Height     =  495   Left      =  5640   TabIndex    =  1   Top       =  600   Width      =  1215  End  Begin MSComDlg.CommonDialog CommonDialog1    Left      =  4200   Top       =  3840   _ExtentX    =  847   _ExtentY    =  847   _Version    =  393216  End  Begin VB.PictureBox Picture1    Height     =  5535   Left      =  480   ScaleHeight   =  5475   ScaleWidth   =  4515   TabIndex    =  0   Top       =  480   Width      =  4575  EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseDim x1 As Integer  '起点X坐标Dim y1 As Integer  '起点Y坐标Dim x2 As Integer  '终点点X坐标Dim y2 As Integer  '终点Y坐标Dim flag As Boolean '绘图标志'设置线的颜色Private Sub Command1_Click()  On Error Resume Next  CommonDialog1.CancelError = True  CommonDialog1.DialogTitle = "颜色"  CommonDialog1.ShowColor  If Err <> 32755 Then    Picture1.ForeColor = CommonDialog1.Color  End IfEnd Sub'清除Picture1中的图形Private Sub Command2_Click()  Picture1.ClsEnd Sub'设置线宽Private Sub Option1_Click()  Picture1.DrawWidth = 1End SubPrivate Sub Option2_Click()  Picture1.DrawWidth = 2End SubPrivate Sub Option3_Click()  Picture1.DrawWidth = 4End SubPrivate Sub Option4_Click()  Picture1.DrawWidth = 8End SubPrivate Sub Form_Load()  Picture1.Scale (0, 0)-(400, 400)  flag = FalseEnd SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, _X As Single, Y As Single)'当按下鼠标按键时绘图开始并记录最初的起点  flag = True  x1 = X  y1 = YEnd SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _X As Single, Y As Single)'如果不是处在绘图状态则退出该过程'如果处在绘图状态则从起点到目前鼠标所在点绘制直线'然后将当前鼠标所在点作为新的起点  If flag = False Then    Exit Sub  End If  If flag = True Then    x2 = X    y2 = Y    Picture1.Line (x1, y1)-(x2, y2)    x1 = x2    y1 = y2  End IfEnd SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, _X As Single, Y As Single)'当释放鼠标按键时绘图结束  flag = FalseEnd Sub

程序中备有较为详细的注释，相信读者不难理解，读者可以根据自己的喜好对该程序进行修改，使之更加完善！