一个用VB实现的鼠标绘图程序

领测软件测试网

　　 
　　摘要:本文给出了一个用VB5.0实现的鼠标绘图程序,对程序的主要功能及实现细节作 了详细说明,并给出了部分源程序.
关键词:VB5.0,可视化程序设计

1. 引言

MicroSoft公司推出的新一代可视化程序设计语言VB5.0以其功能强大和简单易学而深受广大程序设计人员的喜爱,人们用它开发出了许多绚丽多彩的应用程序,可以这样说,VB5.0将成为最流行的可视化程序设计语言.
笔者在学习和使用VB5.0的过程中编制了一个实用的鼠标绘图程序,现提供给大家,以供大家参考.

2. 程序主要功能
本绘图程序的模块结构图如下所示:
鼠标绘图程序:
文件
新建
装入
保存
退出
绘图
颜色
前景色
背景色
线宽
1象素宽
2象素宽
3象素宽
4象素宽
清除

3. 实现细节
本程序主要是实现用鼠标在窗体上绘图,在绘图过程中可选择颜色及线宽,同时可将所绘图形以位图(.bmp)文件的形式存储在盘上,也可将盘上的其它图形文件调入窗体.
3.1 用鼠标在窗体上绘图
利用窗体对象的MouseDown和MouseMove事件可实现鼠标在窗体上绘图:

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
CurrentX = X
CurrentY = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button Then
Line -(X, Y), forcolor
End If
End Sub

其中forcolor为绘图的前景色,在本程序中前景色由用户选取.

3.2 颜色选取
利用通用对话框控件Commondialog的ShowColor方法可实现前景色和背景色的选取:

Private Sub mnubkcolor_Click()
CommonDialog1.CancelError = True
On Error GoTo errhandler
CommonDialog1.Flags = &H1&
CommonDialog1.ShowColor
BackColor = CommonDialog1.Color
Exit Sub
errhandler:
Exit Sub
End Sub

3.3 线宽的设置
通过设置窗体对象的属性DrawWidth的值可实现绘图时线宽的设置,DrawWidth=1时,线宽为1个象素,以此类推.

3.4 图形的保存
结合使用通用对话框控件Commondialog的ShowSave方法和SavePicture语句可实现图形的保存:

Private Sub mnusave_Click()
On Error GoTo errhandler
CommonDialog1.Filter = "bmp files(*.bmp)"
CommonDialog1.ShowSave
SavePicture Image, CommonDialog1.FileName
Exit Sub
errhandler:
Exit Sub
End Sub

3.5 图形的调入
结合使用通用对话框控件Commondialog的ShowOpen方法和LoadPicture函数可实现图形的调入:

Private Sub mnuload_Click()
On Error GoTo errhandler
CommonDialog1.Filter = "bmp files(*.bmp)"
CommonDialog1.ShowOpen
Picture = LoadPicture(CommonDialog1.FileName)
Exit Sub
errhandler:
Exit Sub
End Sub
4. 源程序清单

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmdraw
AutoRedraw = -1 'True
Caption = "绘图工具软件(嘉兴高专机电系计算中心)"
ClientHeight = 4230
ClientLeft = 1140
ClientTop = 1815
ClientWidth = 6720
BeginProperty Font
Name = "隶书"
Size = 5.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 4230
ScaleWidth = 6720
WindowState = 2 'Maximized
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4920
Top = 2880
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Menu mnufile
Caption = "文件"
Begin VB.Menu mnunew
Caption = "新建"
End
Begin VB.Menu mnustepa
Caption = "-"
End
Begin VB.Menu mnuload
Caption = "装入"
End
Begin VB.Menu mnustepb
Caption = "-"
End
Begin VB.Menu mnusave
Caption = "保存"
End
Begin VB.Menu mnustepc
Caption = "-"
End
Begin VB.Menu mnuexit
Caption = "退出"
End
End
Begin VB.Menu mnudraw
Caption = "绘图"
Begin VB.Menu mnucolor
Caption = "颜色"
Begin VB.Menu mnuforcolor
Caption = "前景色"
End
Begin VB.Menu mnustep1a
Caption = "-"
End
Begin VB.Menu mnubkcolor
Caption = "背景色"
End
End
Begin VB.Menu mnustepg
Caption = "-"
End
Begin VB.Menu mnudrawwidth
Caption = "线宽"
Begin VB.Menu mnupixel1
Caption = "1象素宽"
End
Begin VB.Menu mnustep31
Caption = "-"
End
Begin VB.Menu mnupixel2
Caption = "2象素宽"
End
Begin VB.Menu mnustep32
Caption = "-"
End
Begin VB.Menu mnupixel3
Caption = "3象素宽"
End
Begin VB.Menu mnustep33
Caption = "-"
End
Begin VB.Menu mnupixel4
Caption = "4象素宽"
End
End
Begin VB.Menu mnustepf
Caption = "-"
End
Begin VB.Menu mnuclearz
Caption = "擦除"
Begin VB.Menu mnuclear1
Caption = "全部擦除"
End
Begin VB.Menu mnustepo
Caption = "-"
End
Begin VB.Menu mnuclear2
Caption = "部分擦除"
End
End
End
End
Attribute VB_Name = "frmdraw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim forcolor As Long

Private Sub mnubkcolor_Click()
CommonDialog1.CancelError = True
On Error GoTo errhandler
CommonDialog1.Flags = &H1&
CommonDialog1.ShowColor
BackColor = CommonDialog1.Color
Exit Sub
errhandler:
Exit Sub
End Sub

Private Sub mnuclear1_Click()
Picture = LoadPicture("")
End Sub

Private Sub mnuforcolor_Click()
CommonDialog1.CancelError = True
On Error GoTo errhandler
CommonDialog1.Flags = &H1&
CommonDialog1.ShowColor
forcolor = CommonDialog1.Color
Exit Sub
errhandler:
Exit Sub
End Sub

Private Sub mnuexit_Click()
End
End Sub
Private Sub mnuload_Click()
On Error GoTo errhandler
CommonDialog1.Filter = "All Files(*.*)"
CommonDialog1.ShowOpen
Picture = LoadPicture(CommonDialog1.FileName)
Exit Sub
errhandler:
Exit Sub
End Sub
Private Sub mnunew_Click()
Picture = LoadPicture("")
End Sub
Private Sub mnupixel1_Click()
DrawWidth = 1
End Sub
Private Sub mnupixel2_Click()
DrawWidth = 2
End Sub
Private Sub mnupixel3_Click()
DrawWidth = 3
End Sub
Private Sub mnupixel4_Click()
DrawWidth = 4
End Sub
Private Sub mnusave_Click()
On Error GoTo errhandler
CommonDialog1.Filter = "All Files(*.*)"
CommonDialog1.ShowSave
SavePicture Image, CommonDialog1.FileName
Exit Sub
errhandler:
Exit Sub
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
CurrentX = X
CurrentY = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button Then
Line -(X, Y), forcolor
End If
End Sub

5.结束语
本程序已在VB5.0环境下调试通过,有兴趣的读者可对该程序进行扩充,以完成更强的绘图功能

文章来源于领测软件测试网 https://www.ltesting.net/