本文所述为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 |
程序中备有较为详细的注释,相信读者不难理解,读者可以根据自己的喜好对该程序进行修改,使之更加完善!