VB實現(xiàn)鼠標(biāo)繪圖實例代碼
本文所述為VB實現(xiàn)鼠標(biāo)繪圖的實例,該實例實現(xiàn)線條顏色和線寬可自設(shè),當(dāng)按下鼠標(biāo)按鍵時繪圖開始并記錄最初的起點,如果不是處在繪圖狀態(tài)則退出該過程,如果處在繪圖狀態(tài)則從起點到目前鼠標(biāo)所在點繪制直線,然后將當(dāng)前鼠標(biāo)所在點作為新的起點,當(dāng)釋放鼠標(biāo)按鍵時繪圖結(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 '起點X坐標(biāo)
Dim y1 As Integer '起點Y坐標(biāo)
Dim x2 As Integer '終點點X坐標(biāo)
Dim y2 As Integer '終點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)按鍵時繪圖開始并記錄最初的起點
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)則從起點到目前鼠標(biāo)所在點繪制直線
'然后將當(dāng)前鼠標(biāo)所在點作為新的起點
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)按鍵時繪圖結(jié)束
flag = False
End Sub
程序中備有較為詳細(xì)的注釋,相信讀者不難理解,讀者可以根據(jù)自己的喜好對該程序進行修改,使之更加完善!
相關(guān)文章
VB使用shell函數(shù)打開外部exe程序的實現(xiàn)方法
這篇文章主要介紹了VB使用shell函數(shù)打開外部exe程序的實現(xiàn)方法,是非常實用的一個功能,需要的朋友可以參考下2014-07-07
VB的TextBox文本框?qū)崿F(xiàn)垂直居中顯示的方法
這篇文章主要介紹了VB的TextBox文本框?qū)崿F(xiàn)垂直居中顯示的方法,比較實用的功能,需要的朋友可以參考下2014-07-07
VB6實現(xiàn)連接Access數(shù)據(jù)庫的ADODB代碼實現(xiàn)方法
這篇文章主要介紹了VB6實現(xiàn)連接Access數(shù)據(jù)庫的ADODB代碼實現(xiàn)方法,對于初學(xué)者掌握VB鏈接access數(shù)據(jù)庫有著很好的借鑒價值,需要的朋友可以參考下2014-07-07

