VB實(shí)現(xiàn)鼠標(biāo)繪圖實(shí)例代碼
本文所述為VB實(shí)現(xiàn)鼠標(biāo)繪圖的實(shí)例,該實(shí)例實(shí)現(xiàn)線條顏色和線寬可自設(shè),當(dāng)按下鼠標(biāo)按鍵時(shí)繪圖開始并記錄最初的起點(diǎn),如果不是處在繪圖狀態(tài)則退出該過程,如果處在繪圖狀態(tài)則從起點(diǎn)到目前鼠標(biāo)所在點(diǎn)繪制直線,然后將當(dāng)前鼠標(biāo)所在點(diǎn)作為新的起點(diǎn),當(dāng)釋放鼠標(biāo)按鍵時(shí)繪圖結(jié)束。
具體的功能代碼如下:
VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" Begin VB.Form Form1 Caption = "鼠標(biāo)繪圖" 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 = "設(shè)置顏色" 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 '起點(diǎn)X坐標(biāo) Dim y1 As Integer '起點(diǎn)Y坐標(biāo) Dim x2 As Integer '終點(diǎn)點(diǎn)X坐標(biāo) Dim y2 As Integer '終點(diǎn)Y坐標(biāo) Dim flag As Boolean '繪圖標(biāo)志 '設(shè)置線的顏色 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 '設(shè)置線寬 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) '當(dāng)按下鼠標(biāo)按鍵時(shí)繪圖開始并記錄最初的起點(diǎn) flag = True x1 = X y1 = Y End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _X As Single, Y As Single) '如果不是處在繪圖狀態(tài)則退出該過程 '如果處在繪圖狀態(tài)則從起點(diǎn)到目前鼠標(biāo)所在點(diǎn)繪制直線 '然后將當(dāng)前鼠標(biāo)所在點(diǎn)作為新的起點(diǎn) 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) '當(dāng)釋放鼠標(biāo)按鍵時(shí)繪圖結(jié)束 flag = False End Sub
程序中備有較為詳細(xì)的注釋,相信讀者不難理解,讀者可以根據(jù)自己的喜好對該程序進(jìn)行修改,使之更加完善!
相關(guān)文章
VB FileSystemObject對象實(shí)例詳解
FileSystemObject對象被用來訪問服務(wù)器上的文件系統(tǒng)。這個(gè)對象能夠處理文件、文件夾和目錄路徑。用它來檢索文件系統(tǒng)信息也是可能的,而且vb與vbs、asp都是差不多的語法2018-12-12VB使用shell函數(shù)打開外部exe程序的實(shí)現(xiàn)方法
這篇文章主要介紹了VB使用shell函數(shù)打開外部exe程序的實(shí)現(xiàn)方法,是非常實(shí)用的一個(gè)功能,需要的朋友可以參考下2014-07-07VB的TextBox文本框?qū)崿F(xiàn)垂直居中顯示的方法
這篇文章主要介紹了VB的TextBox文本框?qū)崿F(xiàn)垂直居中顯示的方法,比較實(shí)用的功能,需要的朋友可以參考下2014-07-07VB6實(shí)現(xiàn)連接Access數(shù)據(jù)庫的ADODB代碼實(shí)現(xiàn)方法
這篇文章主要介紹了VB6實(shí)現(xiàn)連接Access數(shù)據(jù)庫的ADODB代碼實(shí)現(xiàn)方法,對于初學(xué)者掌握VB鏈接access數(shù)據(jù)庫有著很好的借鑒價(jià)值,需要的朋友可以參考下2014-07-07