|
|
 |
Oicq头像自己作 |
热 ★★★★ |
|
Oicq头像自己作 |
|
作者：闵涛 文章来源：闵涛的学习笔记 点击数：795 更新时间：2009/4/23 14:58:52  |
|
|
本人在用Oicq聊天时，经常收到一些好友发给我的用文本符号描绘的图像，觉得好羡慕啊，于是一想何不自己编一个程序来解决一下这个问题呢。本人近期正好在学Vb，所以我就打算用Vb来搞定:).
首先，新建一个工程。在窗体Form1上放200个Shape控件（大量的复制粘贴，要有耐心),并让其成为一个从Shape(0)到Shape(199)的数组
.大家也可以先在窗体Form1上放一个Shape控件，然后用Load语句来完成加载。把Shape控件的FillColor属性设置为白色，FillStyle属性设置为Solid(实填充),
BorderColor属性设置为黑色，BorderWidth属性设置为1，Shape属性设置为0(Rectangle),Height和Width属性设置为195。
然后，用"工具"下的"菜单编辑器"加入四个菜单项，标题分New,Save,Char,Exit,名称分别为NewMenu,SaveMenu,CharMenu和ExitMenu.
以上的准备工作完成以后，下面就来写程序代码了。首先介绍一下本程序设计的大体思想。本程序通过用鼠标来描绘图形，当按着鼠标左键在Shape控件上移动时，处在鼠标位置的Shape控件的颜色变为蓝色,当按右键时变为白色（Shape控件按20*10的方式排列）。用一个20*10的字符串数组来纪录各个Shape控件的状态，如着色则对应的数组元素为当前设置的字符串，否则为空格.当存盘时，把字符串数组写入文件。
程序的变量说明为:
Dim
imagearray(1 To 10, 1 To 20) As String
Dim curstr As String '当前的描绘字符串
1.在Form_Load()过程中加入初始化代码,如下:
Private
Sub Form_Load()
Dim i As Integer
Dim j As
Integer
For i = 1 To 10
For j = 1 To
20
imagearray(i, j) = " " '把数组都清为空格
Next
Next
tops =
(Form1.Height - 2000) \ 2 - 500
lefts = (Form1.Width - 4000) \
2
For i = 0 To 199
Shape1(i).Top = tops + (i \ 20) *
200
Shape1(i).Left = lefts + (i Mod 20) * 200
Next
'排列控件,使之按20*10排列
curstr =
"*"
End Sub
2.在MouseDown过程中添加如下代码:
Private Sub
Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As
Single)
Dim i As Integer
Dim j As Integer
If
Button = 1 Then '如果是左键
For i = 1 To 10
For j = 1 To
20
If (X >= lefts + (j - 1) * 200) And (X <= lefts + j *
200) And (Y >= tops + (i - 1) * 200) And (Y <= tops + i * 200)
Then
'以上判断鼠标点在哪个控件上
imagearray(i, j) = curstr
'置相应的数组元素为Curstr
Shape1((i - 1) * 20 +
j - 1).FillColor = vbBlue
'控件颜色变为蓝色
End If
Next
Next
ElseIf
Button = 2 Then '如果是右键
For i = 1 To
10
For j = 1 To 20
If (X >= lefts + (j - 1) * 200)
And (X <= lefts + j * 200) And (Y >= tops + (i - 1) * 200) And (Y <=
tops + i * 200) Then
imagearray(i, j) = " " '置相应的数组元素为空格
Shape1((i - 1) * 20 + j -
1).FillColor = vbWhite
'控件颜色变为白色
End
If
Next
Next
End If
End
Sub
3.在MouseDown过程添加如下代码:
Private Sub Form_MouseMove(Button
As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As
Integer
Dim j As Integer
If Button = 1 Then '按着鼠标左键
For i = 1 To 10
For j = 1
To 20
If (X >= lefts + (j - 1) * 200) And (X <= lefts + j *
200) And (Y >= tops + (i - 1) * 200) And (Y <= tops + i * 200)
Then
imagearray(i, j) = curstr '置相应的数组元素为Curstr
Shape1((i - 1) * 20 + j -
1).FillColor = vbBlue
'控件颜色变为蓝色
End If
Next
Next
ElseIf
Button = 2 Then '按着鼠标右键
For i = 1 To
10
For j = 1 To 20
If (X >= lefts + (j - 1) *
200) And (X <= lefts + j * 200) And (Y >= tops + (i - 1) * 200) And (Y
<= tops + i * 200) Then
imagearray(i, j) = " " '置相应的数组元素为空格
Shape1((i - 1) * 20 + j -
1).FillColor = vbWhite
'控件颜色变为白色
End
If
Next
Next
End If
End
Sub
4.New菜单的Click事件:
Private Sub NewMenu_Click(Index As
Integer)
Dim i As Integer
Dim j As Integer
For
i = 1 To 10
For j = 1 To 20
imagearray(i, j) = " "
'数组全清为空格
Next
Next
For
i = 0 To 199
Shape1(i).FillColor = vbWhite '控件的颜色全置为白色
Next
End
Sub
5.Char菜单的Click事件:
Private Sub CharMenu_Click(Index As
Integer)
Dim str As String
str = InputBox("请输入描绘字符串:",
"输入描绘字符串:", curstr)
If str <> "" Then '如输入的字符串不为空
curstr = str
End
If
End Sub
6.Save菜单的Click事件:
Private Sub
SaveMenu_Click(Index As Integer)
Dim i As Integer
Dim j As
Integer
Dim fso As Object
Dim ts As
TextStream
Dim filename As String
Set fso =
CreateObject("Scripting.FileSystemObject")
filename =
InputBox("请输入文件名:", "输入文件名:", "*.txt") '输入文件名
Set ts =
fso.CreateTextFile(filename, True)
For i = 1 To 10
For j
= 1 To 20
ts.Write imagearray(i,
j)
Next
ts.WriteLine '写一新行
Next
End
Sub
7.Exit菜单的Click事件:
Private Sub ExitMenu_Click(Index As
Integer)
end '程序结束
End Sub
做完以上工作后就可以运行程序了,该程序只是一个简化版本,由许多可以改进的地方.以上代码大家也可到http://cattyxin.yeah.net/下载.
没有相关教程
|
|
| 教程录入：mintao 责任编辑：mintao |
|
|
上一篇教程： 用VB6分离出文本框的单词
下一篇教程： 手把手教你使用VB来创建ASP组件 |
|
|
| 【字体：小 大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】 |
|
 注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] |
| 网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！） |
| |
|
|
|
|
|
 |
同类栏目 |
 |
|
赞助链接 |
|
|
500 - 内部服务器错误。
|
|
|
|
|
|
