Oicq头像自己作

• 自己
• As
• 注释
• To
• Integer
• For
• Next
• D

首先，新建一个工程。在窗体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#p#分页标题#e#

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