本文所述為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 |
程序中備有較為詳細的注釋,相信讀者不難理解,讀者可以根據自己的喜好對該程序進行修改,使之更加完善!