本文所述為VB實現滑鼠繪圖的實例,該實例實現線條顏色和線寬可自設,當按下滑鼠按鍵時繪圖開始並記錄最初的起點,如果不是處在繪圖狀態則退出該過程,如果處在繪圖狀態則從起點到目前滑鼠所在點繪製直線,然後將目前滑鼠所在點作為新的起點,當釋放滑鼠按鍵時繪圖結束。
具體的功能代碼如下:
VERSION 5.00的7710 LinkTopic = "Form1" ScaleHeight = 6420 ScaleWidth = 7710 StartUpPosition = 3 '視窗缺省Begin VB. TabButton Command2 Caption = "清除" Height = 495 Left = 5640 TabIndex = Frame B70" Height = 495 Left = 5640 TabIndex Caption = "線寬" Height = 2655 Left = 5520 TabIndex = 2 Top = 2880 Width = 1935 Begin VB.OptionButton Option4 Caption = "8" Height = 495 Left = 240 TabginIndex = 6 Tabgin = 1800 Widd. 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 End6695 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 = 60021Com = 1ComginD. CommonDialog CommonDialog1 Left = 4200 Top = 3840 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.PictureBox Picture1 Height = 5535 Left = 480 ScaleHeight = 5475 Scight = 5535 Left = 480 ScaleHeight = 5475 Scights = 5535 Left = 480 ScaleHeight = 5475 ScidInbde = 4075054x 4505475 Sc EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseDim x1 As Integer 'XXXX 起始點座標Integer '終點Y座標Dim flag As Boolean '繪圖標誌'設定線的顏色Private Sub Command1_Click() On Error Resume Next CommonDialog1.CancelError = True CommonDialog1.DialogTitle = "顏色" CommonDialog1.Showor If Error> 327555F = CommonDialog1.Color End IfEnd Sub'清除Picture1中的圖形Private Sub Command2_Click() Picture1.ClsEnd Sub'設定線寬Private Sub Option1_Click() Picture1.DrawWidth = 1End SubPrivate Sub Option2_Click()p Picture1.DrawWidth = 1End SubPrivate Sub Option2_Click()p Picture1.DrawWidth = 1End SubPrivate Sub Option2_Click()p Picture1.DrawWidth = 2End SubPrivate Sub Option3p. 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 AInteger, Integer Integer Integer Integer_X SInteger, Integer_X SInteger, Integer Integers 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 Integer, Shift Int Picture As Integer , _X As Single, Y As Single)'當釋放滑鼠按鍵時繪圖結束flag = FalseEnd Sub
程式中備有較為詳細的註釋,相信讀者不難理解,讀者可以根據自己的喜好對該程式進行修改,使其更加完善!