EXCEL VB方法绘图总结

VB方法绘图
绘制点、线、面，以及设置前景、背景色
一、设置当前绘图点
在VB中，可以通过设置窗体或图形框的CurrentX与CurrentY属性来设置当前绘图点。

CurrentX与CurrentY决定了绘制或显示的起始坐标，在设计时，这两个属性不可用。

图片框等对象的绘图模式等参数设置。

对象.Scalemode＝3 为像素模式，ScaleWidth和ScaleWeight就是图片框的水平和垂直像素大小；
Windows系统默认使用Twip (缇，一种逻辑单位，一般15个像素，具体用Screen.TwipsPerPixelX和Screen.TwipsPerPixelY系数转换一个像素多少缇)
被其它窗体挡住后，再显示出来就没有绘制的图；
对象.DrawMode＝7 设置对象绘图模式为异或模式，重复绘制两次即可复原图片原先内容，还有其它一些模式；
对象.DrawWidth＝1 设置对象绘制的线条粗细，也可以设置为其它数据，默认为1。

二、绘制点、线、面的方法
1、点的绘制法
在指定对象（如窗体、图形框）上的指定位置处绘制点，还可以为点指定颜色，语法如下：
对象名.Pset(X,Y)，[Color]
X，Y分别为点的水平与垂直坐标，Color为点的颜色，是可选项。

2、直线的绘制法
在对象上绘制直线，语法如下：
对象名.Line(X1,y1)-(X2,Y2),[Color]
(X1,Y1)是直线的起点，(X2,Y2)是直线的终点，Color为可选项。

3、绘制矩形
用Line方法还可以绘制矩形，语法如下：
对象名.Line(X1,Y1)-(X2,Y2),[Color],B,[F]
其中，(X1,Y1)是矩形的左上角座标，(X2,Y2)是矩形右下角座标，Color为矩形边框的颜色，使用参数B而不用F，那么矩形用当前的填充色（FillColor）与填充方式（FillStyle）对矩形进行填充；如果使用了参数F，那么矩形以边框的颜色进行填充。

特别注意，用Line画矩形框，如果不用其他参数，那么B与坐标(X2,Y2)之间应该有两个逗点，一个是紧跟坐标2，一个表示Color省略了，如：Picture1.Line(500,500)-(1000,1000),,B
4、绘制圆、椭圆、弧
用Circle方法可以绘制圆、椭圆与弧，语法如下：
对象名.Circle(X,Y),Radius,[Color,start,end,aspect]
其中(X,Y)是圆、椭圆或弧的圆心坐标，Radius是半径，这两个参数是必须项；Color是圆的轮廓色，Start与End是弧的起点与终点位置。

其范围是-2-2Pi；Aspect是圆的纵横尺寸比，默认值是1即圆.
5、文字的输出
Print方法可在指定位置显示字符串,如下: Object.Print Outputtext 字体的格式受Object.Font的属性等控制,需要不同格式的字体时候,需要改动Object.Font的属性, 颜色由Object.forcolor控制.
With Picture1.Font
.Size = 12
.Name = "宋体"
.Weight = 56
.Bold = False
.Charset = 43
.Italic = False
.Strikethrough = False
.Underline = False
End With
三、颜色、前景与背景色的设置：
1、颜色函数RGB
色彩设置的方法如下：RGB(Red,Green,Blue)
不要忘了，Red、Green、Blue每种色彩各有0—255种成份，三种色彩不同参数的搭配，就产生了丰富多采的现实世界。

2、前景色的设置
通过对ForeColor（前景色属性）的设置，可以返回或设置对象的前景色。

3、背景色的设置
通过对BackColor（背景色属性）的设置，可以返回或设置对象的背景色。

4、图形的清除
用Cls方法可以清除窗体或图形框在程序运行中绘制的图形，语法如下：对象名.Cls
5、获取像素的颜色值
用Point（x，y）函数可以取得点（x，y）的颜色值，语法如下：Col＝对象名.Point（x，y）
6、颜色分量计算
R=Col And &0xff '获取红色
G＝(Col And &0xff00)/256 '获取黄色
B=(Col and & 0xff0000)/(256*256) '获取蓝色
7.图像颜色处理
(1) 彩色转灰度
Picture.PSet (X, Y), RGB((R + G + B) / 3, (R + G + B) / 3, (R + G + B) / 3)
(2) 底片效果
Picture2.PSet (X, Y), RGB(255 - R, 255 - G, 255 - B)
(3) 木雕效果
If (R+g+b)/3>128 then
Picture2.PSet (X, Y), RGB(255, 255, 255)
Else
Picture2.PSet (X, Y), RGB(0, 0, 0)
End if
(4) 其它, 根据点周边点的颜色值有规律改变而可以得到特殊效果,如果中值滤波,均值滤波,高值滤波,低值滤波,拉普拉斯滤波;根据颜色点阵,可以进行边界追踪以及区域面积等的计算.
四、事例
1. Picture控件上鼠标按下移动可以任意绘制线
一个窗体，一个按钮Exit，名称为Command3，一个Picture控件，名称为Picture1，以下代码放在窗体代码模块内。

Rem 窗体级别变量定义，定义鼠标起始两点位置Pstart和Pend
Dim PstartX As Long, PstartY As Long, PendX As Long, PendY As Long, Flag As Boolean
Private Sub Form_Load()
Picture1.ForeColor = RGB(255, 255, 0) '定义绘制的前景色
Picture1.ScaleMode = 3 '定义图片坐标模式,3为像素模式坐标End Sub
Private Sub Command3_Click()
Unload Me '退出
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Not Flag And Button = 1 Then
Picture1.DrawMode = 7 '定义绘制模式为XOR,异或操作,两次即复原
PstartX = X: PstartY = Y
PendX = X: PendY = Y
Flag = True
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Flag And Button = 1 Then
Picture1.Line (PstartX, PstartY)-(PendX, PendY)
Picture1.Line (PstartX, PstartY)-(X, Y)
PendX = X: PendY = Y
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Flag And Button = 1 Then
Picture1.DrawMode = 13 '定义绘制模式为Copy Pen, 不运算就绘制,避免下次绘制异或掉Picture1.Line (PstartX, PstartY)-(X, Y)
Flag = False
End If
End Sub
2. Picture控件上鼠标拖动绘制矩形, 橡皮筋动作
Rem 窗体级别变量定义，定义鼠标起始两点位置Pstart和Pend
Dim Flag1 As Boolean, Flag2 As Boolean
Dim RecX1 As Long, RecX2 As Long, RecY As Long, PicWidth As Long '定义数据限制框的x0-x1 Private Sub Form_Load()
RecX1 = 0: PicWidth = Picture1.ScaleWidth
RecX2 = PicWidth - 2: RecY = Picture1.ScaleHeight
Picture1.ForeColor = RGB(0, 255, 0) '定义绘制的前景色
Picture1.AutoRedraw = True '定义图片坐标模式,3为像素模式坐标
Picture1.ScaleMode = 3 '定义图片坐标模式,3为像素模式坐标
Picture1.DrawMode = 7 '定义绘制模式为XOR,异或操作,两次即复原
Picture1.FillStyle = 0
Picture1.FillColor = RGB(255, 0, 0)
Picture1.Line (0, 0)-(RecX1 + 1, RecY), , BF
Picture1.Line (RecX2, 0)-(RecX2 + 1, RecY), , BF
End Sub
Private Sub Command3_Click()
Unload Me '退出
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Not Flag1 And Button = 1 And X >= RecX1 - 2 And X <= RecX1 + 2 Then
Picture1.DrawMode = 7 '定义绘制模式为XOR,异或操作,两次即复原
Flag1 = True
End If
If Not Flag2 And Button = 1 And X >= RecX2 - 2 And X <= RecX2 + 2 Then
Picture1.DrawMode = 7 '定义绘制模式为XOR,异或操作,两次即复原
Flag2 = True
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Flag1 And Button = 1 Then
If X < RecX2 - 10 And X > 0 Then
Picture1.Line (RecX1, 0)-(RecX1 + 1, RecY), , BF
Picture1.Line (X, 0)-(X + 1, RecY), , BF
RecX1 = X
Else
Picture1.DrawMode = 13 '定义绘制模式为Copy Pen, 不运算就绘制,避免下次绘制异或掉
Picture1.Line (RecX1, 0)-(RecX1 + 1, RecY), , BF
Flag1 = False
End If
End If
If Flag2 And Button = 1 Then
If X < PicWidth - 2 And X > RecX1 + 10 Then
Picture1.Line (RecX2, 0)-(RecX2 + 1, RecY), , BF
Picture1.Line (X, 0)-(X + 1, RecY), , BF
RecX2 = X
Else
Picture1.DrawMode = 13 '定义绘制模式为Copy Pen, 不运算就绘制,避免下次绘制异或掉
Picture1.Line (RecX2, 0)-(RecX2 + 1, RecY), , BF
Flag2 = False
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Flag1 And Button = 1 And X < RecX2 - 5 And X > 0 Then
Picture1.DrawMode = 13 '定义绘制模式为Copy Pen, 不运算就绘制,避免下次绘制异或掉
Picture1.Line (X, 0)-(X + 1, RecY), , BF
Flag1 = False
RecX1 = X
End If
If Flag2 And Button = 1 And X < PicWidth - 2 And X > RecX1 + 5 Then
Picture1.DrawMode = 13 '定义绘制模式为Copy Pen, 不运算就绘制,避免下次绘制异或掉
Picture1.Line (X, 0)-(X + 1, RecY), , BF
Flag2 = False
RecX2 = X
End If
End Sub。