-
一、鸟巢绘制
Private Sub
Form_Click()
Cls
Dim r, xi,
yi, xj, yj, x0, y0, aif As Single
r =
eight / 2
x0 = idth / 2
y0 =
eight / 2
n = 16
aif =
3.14159 * 2 / n
For i = 1 To n
xi = r * Cos(i * aif) + x0
yi = r * Sin(i * aif) + y0
For
j = i To n
xj =
r * Cos(j * aif) + x0
yj = r * Sin(j * aif) + y0
Line (xi, yi)-(xj, yj),
QBColor(i - 1)
PSet (xi, yi)
Print i - 1
Next j
Next i
End Sub
Private Sub
Form_Load()
Print
要求：
Print
将圆周等分成
16
份；
Print <
/p>
每个等分点要标记成
0-16
的数字；<
/p>
Print
按样本图的图案画图。
End Sub
附图：
二、加密
Function
code(ByVal s$$, ByVal key%)
Dim c As
String * 1, iAsc%
code =
For
i = 1 To Len(s)
c = Mid$$(s, i, 1)
Select Case c
Case
iAsc = Asc(c) + key
If iAsc
> Asc(
code = code + Chr(iAsc)
Case
iAsc = Asc(c) + key
If iAsc > Asc(
code = code +
Chr(iAsc)
Case Else
code =
code + c
End Select
Next i
End Function
Private Sub close_Click()
End Sub
Private Sub Jiami_Click()
Text2 = code(Text1, 2)
End
Sub
Private Sub
open_Click()
= 1
=
Open me For Input As #1
Dim
counter As Integer
Dim workarea(25000)
As String
= LBound(workarea)
= UBound(workarea)
e = True
=
For counter =
LBound(workarea) To UBound(workarea)
workarea(counter) =
=
counter
Next counter
Do
While Not EOF(1)
Line Input #1,
inputdata
= + inputdata + vbCrLf
Loop
Close #1
End
Sub
Private Sub
save_Click()
me =
tExt =
= 2
Open me For Output As
#1
Print #1,
Close #1
End Sub
三、解密
Function UnCode(ByVal s$$, ByVal key%)
Dim c As String * 1, iAsc%
UnCode =
For i = 1 To
Len(s)
c = Mid$$(s, i, 1)
Select Case c
Case
iAsc = Asc(
If iAsc <
Asc(
UnCode = UnCode + Chr(iAsc)
Case
iAsc = Asc(c) -
key
If iAsc < Asc(
UnCode = UnCode + Chr(iAsc)
Case Else
UnCode = UnCode
+ c
End Select
Next i
End Function
Private Sub close_Click()
End Sub
Private Sub Jiemi_Click()
Text2 = UnCode(Text1, 2)
End
Sub
Private Sub
open_Click()
= 1
=
Open me For Input As #1
Dim
counter As Integer
Dim workarea(25000)
As String
= LBound(workarea)
= UBound(workarea)
e = True
=
For counter =
LBound(workarea) To UBound(workarea)
workarea(counter) =
=
counter
Next counter
Do
While Not EOF(1)
Line Input #1,
inputdata
= + inputdata + vbCrLf
Loop
Close #1
End
Sub
Private Sub
save_Click()
me =
tExt =
= 2
Open me For Output As
#1
Print #1,
Close #1
End Sub
四、蝴蝶飞舞
Private Sub Form_Load()
Print
蝴蝶飞出窗体后重新定位到左下方再向右上方飞<
/p>
End Sub
Private Sub Timer1_Timer()
Static PickBmp As Integer
If
PickBmp = 0 Then
e = e
PickBmp = 1
Else
e = e
PickBmp = 0
End If
Call mymove
End Sub
Sub mymove()
+ 40, - 25
If <= 0 Then
= 0
= 2325
End If
End Sub
图：
五、文本编辑
Private
Sub Copy_Click()
t t
End Sub
Private
Sub Cut_Click()
t t
t =
End Sub
Private Sub Exit_Click()
End Sub
Private Sub Font_Click()
=
cdlCFBoth Or cdlCFEffects
= 4
me = me
ze = ze
ld = ld
alic = alic
rikethru = rikethru
derline
= derline
lor =
End Sub
Private Sub Form_Load()
Print
注：
Print
打开
'
对话框的初始文件夹应是所要打开文件所在的
Print
文件夹，将提供的
文件打开；
Print <
/p>
要实现将选定的内容格式化，必须在工具箱中添加
Print
控件（
Microsoft Rich
Textbox Comtrol
6.0
）
Print
并在帮助菜单中查阅其字体设置的相关属性。
Prin
t
中要设置垂直滚动条，文本格式化时要将选
Print
定的内容格式化。
End Sub
Private Sub Label1_Click()
End Sub
Private Sub open_Click()
=
1
=
Open me For Input As #1
Do While Not EOF(1)
Line
Input #1, inputdata
= + inputdata +
vbCrLf
Loop
Close #1
End Sub
Private
Sub Paste_Click()
t = t
End
Sub
Private Sub
Print_Click()
= 5
For i = 1
To
Next i
End Sub
Sub
RichTextBox1_MouseDown(Button As Integer, Shift As
Integer, x As Single, y As Single)
If
Button = 2 Then PopupMenu EditMenu,
vbPopupMenuCenterAlign
End Sub
Private Sub save_Click()
= 2
Print #1,
Close #1
End Sub
Private Sub SaveAs_Click()
me =
tExt =
= 2
Open me For Output As #1
Print #1,
Close #1
图：
六、统计
Dim a(0 To
9), i%, min%, max%, ave%
Private Sub
Command1_Click()
Dim j%, imin%, s%, t%
CurrentX = 0
CurrentY = 0
For i = 0 To 9
a(i) = Int(Rnd * 90 + 10)
s
= s + a(i)
Print a(i);
Next
i
ave = s / 10
For i = 0 To
8
imin = i
For j
= i + 1 To 9
If
a(j) < a(imin) Then imin = j
Next j
t = a(i)
a(i) = a(imin)
a(imin) = t
Next i
End Sub