Oicq头像自己作

2008-04-09 04:41:43来源：互联网阅读 ()

　　本人在用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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有