正文

VB实现鼠标绘图实例代码

︶ㄣSDDLL学院 メ
SDDLL学院V管理员 / 阅读
0630
这篇文章主要介绍了VB实现鼠标绘图实例代码,很实用的一个功能,需要的朋友可以参考下

这篇文章主要介绍了VB实现鼠标绘图实例代码,很实用的一个功能,需要的朋友可以参考下

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

具体的功能代码如下：

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
VERSION 5.00
Object = "{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
  End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim 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 If
End Sub
'清除Picture1中的图形
Private Sub Command2_Click()
  Picture1.Cls
End Sub
'设置线宽
Private Sub Option1_Click()
  Picture1.DrawWidth = 1
End Sub
Private Sub Option2_Click()
  Picture1.DrawWidth = 2
End Sub
Private Sub Option3_Click()
  Picture1.DrawWidth = 4
End Sub
Private Sub Option4_Click()
  Picture1.DrawWidth = 8
End Sub
Private Sub Form_Load()
  Picture1.Scale (0, 0)-(400, 400)
  flag = False
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, _X As Single, Y As Single)
'当按下鼠标按键时绘图开始并记录最初的起点
  flag = True
  x1 = X
  y1 = Y
End Sub
Private 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 If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, _X As Single, Y As Single)
'当释放鼠标按键时绘图结束
  flag = False
End Sub

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