020202.htm
来自「提供一个VB学习教程,入门级。来源于网上」· HTM 代码 · 共 168 行
HTM
168 行
<html>
<head>
<meta http-equiv="Content-Language" content="zh-cn">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>vb study</title><style>
<!--
td {font-size: 9pt}
A:link {text-decoration: none; color: #0033cc;font-size: 9pt}
A:visited {text-decoration: none; color: #0066CC;font-size: 9pt}
A:active {text-decoration: none; color: #ff0000; font-size: 9pt}
A:hover {text-decoration: underline; color: #000000;font-size: 9pt}
-->
</style>
</head>
<body>
<div align="center">
<center>
<table border="0" cellpadding="0" cellspacing="0" width="98%">
<tr>
<td width="100%"><a href="#">你的位置</a>：<a href="http://www.xxby.com" target="_blank">华生小屋</a>--<a href="#">VB学习</a>--<a href="#">ActiveX控件</a></td>
</tr>
<tr>
<td width="100%">
<p align="center"><font size="2">图形</font></td>
</tr>
<tr>
<td width="100%"><br>
<font size="2">VB的图形控制能力：三，Image图片框对象的特殊效果。<br>
1，图形柔化（朦胧化）：基本思路是减小相邻象素的色差，用求象素块平均值的办法，凡是对图片象素进行操作，先要将对象的scalemode属性改为3（使它的内部宽度scalewidth和内高scaleheight以象素为度量单位），不要以缇为单位，这样数字会很大，要处理的"点"会非常多，而以象素作单位，"象素点"只有"缇点"的百分之一。<br>
第一步，用point方法读取每一个象素点的颜色值，转换成RGB表示法存储在一个多维数组中，（可将此法用来变图象信号成数组信号）。<br>
第二步，重新设置每一个象素点的色值，要使它"朦胧"，可以这样：将九个象素点组成一个正方形小象素块，平均值为中间那个象素点的值，对每一个象素色值都如此求得，就可以"模糊"化了。程序如下：<br>
Dim lxn(2, 500, 500) As Integer
在（通用）声明一个存储图象全部象素的数组<br>
Private Sub Command2_Click()<br>
x = Picture1.ScaleWidth <br>
y = Picture1.ScaleHeight<br>
For i = 0 To y - 1 用FOR循环读取每个象素颜色<br>
For j = 0 To x - 1<br>
a = Picture1.Point(j, i)<br>
red = a Mod 256 转换成RGB值<br>
green = ((a And &HFF00) / 256) Mod 256<br>
blue = (a And &HFF0000) / 65536<br>
lxn(0, i, j) = red 用数组存储每个象素<br>
lxn(1, i, j) = green<br>
lxn(2, i, j) = blue<br>
Next j<br>
Next i<br>
For ii = 1 To y - 2 用PSET重新绘制每个象素点<br>
For jj = 1 To x - 2 求相邻九个象素点的平均值<br>
red = lxn(0, ii - 1, jj - 1) + lxn(0, ii - 1, jj) + lxn(0, ii - 1, jj +
1) + lxn(0, ii, jj - 1) + _<br>
lxn(0, ii, jj) + lxn(0, ii, jj + 1) + lxn(0, ii + 1, jj - 1) + lxn(0, ii
+ 1, jj) + lxn(0, ii + 1, jj + 1)<br>
green = lxn(1, ii - 1, jj - 1) + lxn(1, ii - 1, jj) + lxn(1, ii - 1, jj
+ 1) + lxn(1, ii, jj - 1) + _<br>
lxn(1, ii, jj) + lxn(1, ii, jj + 1) + lxn(1, ii + 1, jj - 1) + lxn(1, ii
+ 1, jj) + lxn(1, ii + 1, jj + 1)<br>
blue = lxn(2, ii - 1, jj - 1) + lxn(2, ii - 1, jj) + lxn(2, ii - 1, jj +
1) + lxn(2, ii, jj - 1) + _<br>
lxn(2, ii, jj) + lxn(2, ii, jj + 1) + lxn(2, ii + 1, jj - 1) + lxn(2, ii
+ 1, jj) + lxn(2, ii + 1, jj + 1)<br>
Picture1.PSet (jj, ii), RGB(red / 9, green / 9, blue / 9)<br>
Next jj<br>
Next ii<br>
End Sub<br>
2,浮雕效果：基本思路是取相邻象素差值作为新象素色值，就可形成浮雕效果，<br>
Private Sub Command3_Click()<br>
x = Picture1.ScaleWidth<br>
y = Picture1.ScaleHeight<br>
For i = 0 To y - 1<br>
For j = 0 To x - 1<br>
a = Picture1.Point(j, i)<br>
red = a Mod 256<br>
green = ((a And &HFF00) / 256) Mod 256<br>
blue = (a And &HFF0000) / 65536<br>
lxn(0, i, j) = red<br>
lxn(1, i, j) = green<br>
lxn(2, i, j) = blue<br>
Next j<br>
Next i
这以上和上例一样都是读取图象的象素色值存进数组中<br>
For ii = 1 To y - 2<br>
For jj = 1 To x - 2 以下为重画每个象素，以防太暗加上128<br>
red = Abs(lxn(0, ii, jj) - lxn(0, ii + 1, jj + 1) + 128)<br>
green = Abs(lxn(1, ii, jj) - lxn(1, ii + 1, jj + 1) + 128)<br>
blue = Abs(lxn(2, ii, jj) - lxn(2, ii + 1, jj + 1) + 50)<br>
Picture1.PSet (jj, ii), RGB(red, green, blue)<br>
Next jj<br>
Next ii<br>
End Sub<br>
<br>
下面是将一个位图象素信号转换为数字信号并以文本方式存储的例子：<br>
Dim lxn(200, 200) As Long<br>
<br>
Private Sub Command1_Click()<br>
For a = 0 To Picture1.ScaleHeight - 1 这个"减1"不能丢，到边线上就没象素了<br>
For b = 0 To Picture1.ScaleWidth - 1<br>
lxn(b, a) = Picture1.Point(b, a) 取得每点的颜色值放到数组lxn中<br>
Next b<br>
Next a<br>
Open "c:\windows\desktop\lxn.txt" For Output As #1 将数组lxn存到文件中<br>
For a = 0 To Picture1.ScaleHeight - 1<br>
For b = 0 To Picture1.ScaleWidth - 1<br>
Print #1, lxn(b, a)<br>
Next b<br>
Next a<br>
Close #1<br>
End Sub<br>
<br>
Private Sub Command2_Click()<br>
Open "c:\windows\desktop\lxn.txt" For Input As #1<br>
For a = 0 To Picture1.ScaleHeight - 1<br>
For b = 0 To Picture1.ScaleWidth - 1<br>
Line Input #1, s$ <br>
lxn(b, a) = CLng(s$) 因为文件中存的是字符串，所以要用clng转换<br>
Next b<br>
Next a<br>
For a = 0 To Picture1.ScaleHeight - 1<br>
For b = 0 To Picture1.ScaleWidth - 1<br>
red = lxn(b, a) Mod 256 变成RGB值<br>
green = ((lxn(b, a) And &HFF00) / 256) Mod 256<br>
blue = (lxn(b, a) And &HFF0000) / 65536<br>
Picture1.PSet (b, a), RGB(red, green, blue)<br>
Next b<br>
Next a<br>
Close #1<br>
End Sub<br>
不过，好象一幅很小的位图存起来都很大，有100多K呢，搞得记事本都打不开，我只好将其扩展名改为bmp,不大好。<br>
下面是一个"画板"的例子，可在按下鼠标移动时画出一连串的点，组成一条条线，有一个新属性：drawwidth：指定画点的宽度。缺省为1，比较细，可改为其他自然数，要达到按下鼠标就画而抬起鼠标就停的效果，设一个布尔变量，使按下时变量布尔值为真，抬起时布尔变量赋假，然后在mousemove事件中检测该变量真假而是否在当前鼠标位置画点，如下：<br>
Dim lxn As Boolean 声明一个布尔变量<br>
Private Sub Form_Load()<br>
Picture1.DrawWidth = 3 指定画线的宽度<br>
End Sub<br>
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)<br>
lxn = True 按下鼠标<br>
End Sub<br>
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)<br>
If lxn Then 如果按下鼠标就画点（是lxn=true的缩写）<br>
Picture1.PSet (X, Y), RGB(255, 0, 0)<br>
End If<br>
End Sub<br>
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)<br>
lxn = False 抬起鼠标<br>
End Sub<br>
绘图方法中的step：定义相对坐标，如下：<br>
Pset(100,100) 先在某坐标画一个点<br>
pset step(5,-8) 在上一点位置向右5个单位向上8个单位再画一点，（即相当于pset(105,92)）.</font>
<p align="center">
<br>
< <a href="020201.htm">上一页</a>--<a href="http://www.xxby.com" target="_blank">华生小屋</a>--<a href="020203.htm">下一页</a>
><br>
</td>
</tr>
</table>
</center>
</div>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?