一区二区三区在线-一区二区三区亚洲视频-一区二区三区亚洲-一区二区三区午夜-一区二区三区四区在线视频-一区二区三区四区在线免费观看

服務器之家:專注于服務器技術及軟件下載分享
分類導航

PHP教程|ASP.NET教程|Java教程|ASP教程|編程技術|正則表達式|C/C++|IOS|C#|Swift|Android|VB|R語言|JavaScript|易語言|vb.net|

服務器之家 - 編程語言 - VB - VB實現鼠標繪圖實例代碼

VB實現鼠標繪圖實例代碼

2021-10-11 15:37VB教程網 VB

這篇文章主要介紹了VB實現鼠標繪圖實例代碼,很實用的一個功能,需要的朋友可以參考下

本文所述為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

程序中備有較為詳細的注釋,相信讀者不難理解,讀者可以根據自己的喜好對該程序進行修改,使之更加完善!

延伸 · 閱讀

精彩推薦
  • VBVB返回記錄集結果到HTML表格的方法

    VB返回記錄集結果到HTML表格的方法

    這篇文章主要介紹了VB返回記錄集結果到HTML表格的方法,實例分析了VB獲取記錄集與HTML表格生成的相關技巧,需要的朋友可以參考下...

    小卒過河10682021-10-15
  • VB分享如何在VB中調用VC編寫的DLL

    分享如何在VB中調用VC編寫的DLL

    一般來說,VB和VC共同編程有3種方式:一種是VC生成DLL,在VB中調用DLL;一種是VC生成ActiveX控件(.ocx),在VB中插入;還有一種是在VC中生成ActiveX Automation服務器...

    VB教程網4452021-10-07
  • VBVB6實現連接Access數據庫的ADODB代碼實現方法

    VB6實現連接Access數據庫的ADODB代碼實現方法

    這篇文章主要介紹了VB6實現連接Access數據庫的ADODB代碼實現方法,對于初學者掌握VB鏈接access數據庫有著很好的借鑒價值,需要的朋友可以參考下...

    VB教程網9832021-10-11
  • VBVB實現的16位和32位md5加密代碼分享

    VB實現的16位和32位md5加密代碼分享

    這篇文章主要介紹了VB實現的16位和32位md5加密代碼分享,需要的朋友可以參考下...

    VB.NET教程網8592021-10-08
  • VBVB關機惡搞小程序

    VB關機惡搞小程序

    本文給大家匯總了一些使用VB實現的關機惡搞小程序,大家娛樂一下就行了,千萬別做壞事哦...

    VB教程網10142021-10-16
  • VBVB的TextBox文本框實現垂直居中顯示的方法

    VB的TextBox文本框實現垂直居中顯示的方法

    這篇文章主要介紹了VB的TextBox文本框實現垂直居中顯示的方法,比較實用的功能,需要的朋友可以參考下...

    VB教程網15092021-10-11
  • VBVB獲取文件大小的方法

    VB獲取文件大小的方法

    這篇文章主要介紹了VB獲取文件大小的方法,可實現準確獲取文件大小的功能,需要的朋友可以參考下...

    小卒過河13192021-10-15
  • VBVB鍵盤鼠標無動作調用程序的嘗試

    VB鍵盤鼠標無動作調用程序的嘗試

    這篇文章主要介紹了VB鍵盤鼠標無動作調用程序的嘗試,記錄下整個思路和過程,有需要的小伙伴可以參考下。...

    VB教程網4452021-10-15
主站蜘蛛池模板: 日本一区二区视频在线观看 | 亚洲高清在线视频 | 皇上好大好硬好涨好深好爽 | 热久久天天拍天天拍热久久2018 | 香蕉视频在线观看网站 | yellow视频在线观看免费 | 四虎影院在线免费观看 | 天天射夜夜爽 | 亚洲国产在线视频精品 | 国产精品女主播自在线拍 | 天堂资源wwww在线看 | 亚洲精品一线二线三线 | 国产在线观看99 | 亚洲欧美日韩另类精品一区二区三区 | 天堂中文在线观看 | 日本强不卡在线观看 | 亚洲冬月枫中文字幕在线看 | 美女毛片老太婆bbb80岁 | 18未年禁止免费观看 | 国产高清国内精品福利色噜噜 | 亚洲国产精品一区二区首页 | 欧美在线视频一区 | 欧美一级特黄刺激大片视频 | 日本无遮挡吸乳视频看看 | 99精品免费观看 | 欧美男同猛男 videos 同性 | 日韩在线观看一区二区不卡视频 | h肉动漫在线视频无修无遮挡 | 韩国甜性涩爱在线播放 | 女色在线观看免费视频 | 欧美日韩亚洲国内综合网香蕉 | 天天干女人 | 色综合久久中文字幕综合网 | a毛片免费全部在线播放毛 a级在线看 | 1024亚洲精品国产 | 免费观看的毛片 | 紧身牛仔裤美女被啪啪久久网 | 欧美日韩亚洲高清不卡一区二区三区 | 息与子中文字幕在线 | 精品亚洲欧美中文字幕在线看 | 国产精品制服丝袜白丝www |