form1.frm

屏保爱迪生飞屏保爱迪生飞屏保爱迪生飞屏保爱迪生飞屏保爱迪生飞

      Width           =   375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "3"
      Height          =   255
      Index           =   2
      Left            =   1080
      TabIndex        =   3
      Top             =   120
      Width           =   375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "2"
      Height          =   255
      Index           =   1
      Left            =   600
      TabIndex        =   2
      Top             =   120
      Width           =   375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "1"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   375
   End
   Begin VB.PictureBox p 
      AutoRedraw      =   -1  'True
      Height          =   3790
      Left            =   120
      ScaleHeight     =   3735
      ScaleWidth      =   1275
      TabIndex        =   0
      Top             =   1920
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim xiaoguo As Integer           '选择产生的效果
Dim wid As Long                  '显示器的宽
Dim hei As Long                  '显示器的高
Dim pos1 As Long                 '产生效果所必须的记数游标
Dim coloris As Integer           '由用户选择的颜色效果,0=随机任意色,1=随机渐变色
Dim colorstart(2) As Integer     '当选择随机渐变色时,该数组为了实现随机色彩的记录
Dim heibai As Boolean            '黑白对比色时,决定是否走向黑的或白的一面
Dim heibaicolor As Integer       '范围0-255,为了记录黑白对比色,黑白渐淡色,黑百渐浓色的灰度
Dim lihe As Boolean              '为完成天地之吻,沉睡之心做出离合判断
Dim pos2 As Long                 '为完成地狱之火做出持续的喷放效果
Dim xx() As Long                 '为完成生命繁衍，计算球体向右的移动量
Dim yy() As Long                 '为完成生命繁衍，计算球体向下的移动量
Dim jiaX() As Boolean            '为完成生命繁衍，计算是否增加或减少XX
Dim jiaY() As Boolean            '为完成生命繁衍，计算是否增加或减少YY
Dim rectmax As Integer           '为完成“数据阵列”，计算X，Y的最大阵列
Dim hang As Integer              '为完成“现代言论”，计算到了第几行了
Dim pos3 As Long                 '为完成“旋转光线”，计算第二条线的移动偏差
Dim bcolor As String             '为历史记录保存画布的背景颜色

Private Sub Command1_Click(Index As Integer)   '39个按钮接收到单击事件时（初始化效果）
    p.Cls
    p.CurrentX = 0
    p.CurrentY = 0
    pos1 = 0
    pos2 = 0
    p.FillColor = bcolor
    p.FontSize = 9
    p.FontBold = False
    p.BackColor = bcolor
    lihe = False
    p.FillStyle = 1
    pos3 = 0        '上三行初始化播放器
    Select Case Index
        Case 5
        p.DrawWidth = 10         'DrawWidth定义线段的粗度
        Case 7
        p.DrawWidth = 8
        Case 8
        p.DrawWidth = 9
        Case 9
        p.DrawWidth = 3
        Case 10
        p.DrawWidth = 3
        Case 11
        p.DrawWidth = 3
        Case 12
        p.DrawWidth = 3
        Case 13
        p.DrawWidth = 3
        Case 14
        p.DrawWidth = 6
        Case 15
        p.DrawWidth = 3
        Case 16
        p.DrawWidth = 3
        Case 17
        p.DrawWidth = 3
        Case 18
        p.DrawWidth = 5
        Case 19

        ReDim xx(5)
        ReDim yy(5)
        ReDim jiaX(5)
        ReDim jiaY(5)   '为实现多线程,初始化线程存储数组
        For i = 0 To 4
            Randomize
            xx(i) = wid * Rnd
            yy(i) = hei * Rnd
        Next
        p.DrawWidth = 1
        Case 21
        p.DrawWidth = 3
        Case 22
        rectmax = Round(Rnd * 50)
        p.DrawWidth = 1
        Case 23
        p.FontSize = 12
        p.FontBold = True
        hang = 1
        Case 26
        p.FontSize = 12
        p.FontBold = True
        Case 27
        ReDim xx(5)
        ReDim yy(5)
        ReDim jiaX(5)
        ReDim jiaY(5)
        For i = 0 To 4
            Randomize
            xx(i) = wid * Rnd
            yy(i) = hei * Rnd
        Next
        p.DrawWidth = 1
        p.BackColor = vbBlack
        Case 29
        p.DrawWidth = 50
        Case 31
        ReDim xx(5)
        ReDim yy(5)
        ReDim jiaX(5)
        ReDim jiaY(5)
        xx(0) = wid * Rnd
        yy(0) = hei * Rnd
        p.DrawWidth = 1
        Case 33
        p.DrawWidth = 5
        Case 34
        p.DrawWidth = 1
        Case 37
        p.FillStyle = 0
        p.DrawWidth = 2
        Case Else
        p.DrawWidth = 1
    End Select
    xiaoguo = Index
    Timer1.Enabled = True    '开始运行播放器
End Sub

Private Sub Form_Load()
    xiaoguo = 0
    p.BackColor = vbWhite
    bcolor = vbWhite
    For i = 0 To 2
        colorstart(i) = Round(Rnd * 255)
    Next   '启动时生成三个随机原色
    Form1.Caption = "39种效果"
End Sub

Private Sub Form_Resize()                  '窗体移动时改变控件布局以及部分参数设置
    On Error Resume Next
    p.Width = Me.ScaleWidth - 200
    Frame1.Top = Me.ScaleHeight - Frame1.Height - 100
    p.Height = Frame1.Top - 100
    If Me.ScaleWidth > Frame1.Width Then
        Frame1.Left = Me.ScaleWidth / 2 - Frame1.Width / 2
    End If
    s.Top = p.Top + p.Height - s.Height
    wid = p.Width
    hei = p.Height
End Sub

Private Sub menu01_Click(Index As Integer)     '控制菜单中菜单列的单击
    Select Case Index
        Case 1
        Timer1.Enabled = Not Timer1.Enabled    '播放/停止
        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
        If pos1 Mod 2 <> 0 Then   '如果是奇数则向右扩展,否则向左
            p.Line (wid / 2 + pos1, 0)-(wid / 2 + pos1, hei), color1
        Else
            p.Line (wid / 2 - pos1, 0)-(wid / 2 - pos1, hei), color1
        End If
        Case 6   '随机线段
        rnd1 = wid * Rnd
        rnd2 = hei * Rnd
        rnd3 = Rnd * 1000
        If rnd3 < 500 Then rnd3 = -rnd3
        rnd4 = Rnd * 1000
        If rnd4 < 500 Then rnd4 = -rnd4
        For i = 0 To 3
            p.Line (rnd1, rnd2)-(rnd1 + rnd3, rnd2 + rnd4), color1
        Next
        Case 7   '随机颗粒
        For i = 0 To 3
            p.PSet (wid * Rnd, hei * Rnd), color1
        Next
        Case 8   '虚拟葫芦
        rnd1 = wid * Rnd
        rnd2 = hei * Rnd
        For i = 0 To 5
            temp1 = 8 + (i * 3)
            p.DrawWidth = temp1
            p.PSet (rnd1 + (temp1 * 6 * i), rnd2 + (temp1 * 6 * i)), color1
        Next
        Case 9   '三维十字
        wid1 = wid / 2
        hei1 = hei / 2
        If pos1 * 2 < wid Then pos1 = pos1 + 7 Else pos1 = 1
        If pos1 Mod 2 = 0 Then
            p.Line (wid1 + pos1, 0)-(wid1 + pos1, hei), color1
            p.Line (0, hei1 + pos1)-(wid, hei1 + pos1), color1
        Else
            p.Line (wid1 - pos1, 0)-(wid1 - pos1, hei), color1
            p.Line (0, hei1 - pos1)-(wid, hei1 - pos1), color1
        End If
        Case 10  'X型极光
        If pos1 * 2 < wid Then pos1 = pos1 + 21 Else pos1 = 1
        If pos1 Mod 2 = 0 Then
            p.Line (0 + pos1, 0)-(wid + pos1, hei), color1
            p.Line (wid + pos1, 0)-(0 + pos1, hei), color1
        Else
            p.Line (0 - pos1, 0)-(wid - pos1, hei), color1
            p.Line (wid - pos1, 0)-(0 - pos1, hei), color1
        End If
        Case 11  '金字魔塔
        wid1 = wid / 2
        hei1 = hei / 2
        If pos1 * 3 < wid Then pos1 = pos1 + 15 Else pos1 = 1
        p.Line (wid1, hei1 - pos1)-(wid1 + (pos1 * 2), hei1 + pos1), color1
        p.Line -(wid1 - (pos1 * 2), hei1 + pos1), color1