case 2: '下一效果
if xiaoguo = command1.count - 1 then xiaoguo = 0 else xiaoguo = xiaoguo + 1
command1_click xiaoguo
case 3: '下一颜色系
for i = 0 to option1.count - 1
if option1(i).value = true then exit for
next
if i = option1.count - 1 then option1(0).value = true else option1(i + 1).value = true
case 4: '设置背景
str1 = inputbox("请输入一个颜色代码,“&h蓝绿红”色系,原色参数00-ff之间", "背景设置", hex(p.backcolor))
if str1 = "" then exit sub
on error resume next
oldcolor = p.backcolor: p.backcolor = "&h" & str1
if err.number <> 0 then msgbox "无效的背景颜色参数！", vbcritical, "错误参数": p.backcolor = oldcolor
bcolor = p.backcolor
case 5: p.cls '清除画布
case 6: s.visible = not s.visible '显示/隐藏速度控制
case 8: '保存画布图形为图片
if instr(app.path, "\") = len(app.path) then path1 = app.path else path1 = app.path & "\"
savepicture p.image, path1 & "效果图片" & xiaoguo & ".jpg"
path2 = "file:///" & replace(path1 & "效果图片" & xiaoguo & ".jpg", "\", "/")
shell "explorer " & path2, vbmaximizedfocus '在win2003下无知为何不能正常在浏览器运行
end select
end sub
private sub p_mouseup(button as integer, shift as integer, x as single, y as single)
if button = 2 then popupmenu menu1 '弹出菜单
end sub
private sub s_change() '加快或减慢播放速度
timer1.interval = s.value
end sub
private sub option1_click(index as integer) '颜色效果单选按钮数组的单击
coloris = index
end sub
private sub timer1_timer() '播放循环计时器开始运行,以下39例效果算法未经我仔细检查,完全可以在次优化
randomize
select case coloris
case 0 '应用随机任意色
color1 = rgb(round(rnd * 255), round(rnd * 255), round(rnd * 255))
case 1 '应用随机渐淡色
for i = 0 to 2
if colorstart(i) > 254 then colorstart(i) = round(rnd * 255) else colorstart(i) = colorstart(i) + 1
next
color1 = rgb(colorstart(0), colorstart(1), colorstart(2))
case 2 '应用随机渐浓色
for i = 0 to 2
if colorstart(i) < 1 then colorstart(i) = round(rnd * 255) else colorstart(i) = colorstart(i) - 1
next
color1 = rgb(colorstart(0), colorstart(1), colorstart(2))
case 3 '黑白对比色
if heibai = false then
if heibaicolor > 254 then heibai = true else heibaicolor = heibaicolor + 1
else
if heibaicolor < 1 then heibai = false else heibaicolor = heibaicolor - 1
end if
color1 = rgb(heibaicolor, heibaicolor, heibaicolor)
case 4 '黑白渐淡色
if heibaicolor > 254 then heibaicolor = round(rnd * 255) else heibaicolor = heibaicolor + 1
color1 = rgb(heibaicolor, heibaicolor, heibaicolor)
case 5 '黑白渐浓色
if heibaicolor < 1 then heibaicolor = round(rnd * 255) else heibaicolor = heibaicolor - 1
color1 = rgb(heibaicolor, heibaicolor, heibaicolor)
end select
select case xiaoguo
case 0 '横向线条
rnd1 = round(rnd * hei)
p.line (0, rnd1)-(wid, rnd1), color1
case 1 '竖向线条
rnd1 = round(rnd * wid)
p.line (rnd1, 0)-(rnd1, hei), color1
case 2 '右向辐射
p.line (0, 0)-(round(rnd * wid), round(rnd * hei)), color1
case 3 '密集辐射
rnd1 = round(rnd * wid): rnd2 = round(rnd * hei)
p.line (0, 0)-(rnd1, rnd2), color1
p.line (0, hei)-(rnd1, rnd2), color1
p.line (wid, 0)-(rnd1, rnd2), color1
p.line (wid, hei)-(rnd1, rnd2), color1
case 4 '内部扩散
p.line (wid / 2, hei / 2)-(wid * rnd, hei * rnd), color1
case 5 '左右扩展
if pos1 * 2 < wid then pos1 = pos1 + 25 else pos1 = 1
