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

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

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
主站蜘蛛池模板: 国产精品成人麻豆专区 | 国产精品久久久久不卡绿巨人 | 欧美又大又粗又爽视频 | 91久久夜色精品国产九色 | 四虎国产精品免费久久麻豆 | 女被男啪到哭 | 国产网站免费看 | 午夜一级毛片看看 | v视影院 | 14一15sexvideo日本 | 精品视频一区在线观看 | 欧美美女被艹 | 国产一区私人高清影院 | 午夜影院免费观看视频 | 久久热在线视频精品1 | 亚洲精品午夜久久aaa级久久久 | 四虎成人国产精品视频 | 大又大又黄又爽免费毛片 | 香蕉草莓视频 | 视频在线欧美 | 亚洲男人天堂 | 无码精品AV久久久奶水 | 亚洲国产99在线精品一区二区 | 俄罗斯一级成人毛片 | 国产福利一区二区三区 | yin乱被cao系列 | 欧美精品99 | 亚洲国产精品一区二区久久 | 欧美专区综合 | 欧美贵妇videos办公室360 | 97国产蝌蚪视频在线观看 | 日本免费一区二区三区a区 日本免费三片在线观看 | 四虎影视4hutv最新地址在线 | 久草在线福利视频在线播放 | 希岛爱理aⅴ在线中文字幕 午夜综合网 | 久久国产精品高清一区二区三区 | 亚洲国产精品嫩草影院永久 | 色老板在线免费观看 | chinese男男gay| 美女张开下身让男人桶 | 半挠脚心半黄的网站 |