formml.ebf

winc下用evb写的MagicLine魔线

      Alignment       =   2
      HideSelection   =   -1  'True
      Locked          =   -1  'True
      MaxLength       =   0
      MultiLine       =   0   'False
      PasswordChar    =   ""
      ScrollBars      =   0
   End
   Begin VBCE.Label Label1 
      Height          =   195
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   420
      _cx             =   741
      _cy             =   344
      AutoSize        =   -1  'True
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "数量"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
End
Attribute VB_Name = "formML"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim x(10, 21) As Integer
'Dim y(pointn, linen)
Dim y(10, 21) As Integer
Dim a(10) As Single
Dim LineColor As Single
Dim LineRed As Integer
Dim LineGreen As Integer
Dim LineBlue As Integer
Dim PointN As Integer
Dim LineN As Integer
Dim LineSpeed As Integer
Dim LineStep As Integer
Dim TimeN As Integer
Dim W0 As Integer
Dim H0 As Integer
Dim W1 As Integer
Dim H1 As Integer
Dim ColorFlag As Integer
Dim Cr As Integer
Dim ColorStep As Integer
Dim BHStyle As Integer
'BHStyle=0 线
'       =1 点

Private Sub cbSelect_Click()
Dim ls As Integer
Dim i As Integer
Dim j As Integer
'If cbSelect.ListIndex = 0 Then
'    For j = 0 To LineN
'        For i = 0 To PointN - 2
'            ls = formML.DrawLine(x(i, j), y(i, j), x(i + 1, j), y(i + 1, j), vbBlack)
'        Next i
'        ls = formML.DrawLine(x(0, j), y(0, j), x(PointN - 1, j), y(PointN - 1, j), vbBlack)
'    Next j
'    BHStyle = 0
'Else
'    BHStyle = 0
'End If
BHStyle = cbSelect.ListIndex
End Sub

'Dim vbColorArr(10) As Integer

Private Sub cmdStart_Click()
Dim ls As Integer
'MsgBox vbBlue
If cmdStart.Caption = "开始" Then

    ls = cbSelect.AddItem("线", 0)
    ls = cbSelect.AddItem("圈", 1)
    ls = cbSelect.AddItem("点", 2)
    ColorStep = 10
    Cr = 5
    BHStyle = 0
    W0 = 38
    W1 = 265
    H0 = 5
    H1 = 235
    'LineN = txtLineNum.Text
    'PointN = txtZD.Text
    'LineSpeed = txtSpeed.Text
    'LineStep = txtStep.Text
    LineN = VScrLineNum.Value
    PointN = VScZD.Value
    LineStep = VScStep.Value
    LineSpeed = VScSpeed.Value
    timMain.Interval = 100 * LineSpeed
    'MsgBox LineN
    'MsgBox PointN
    'MsgBox LineSpeed
    'LineN = 6
    'PointN = 4
    'LineStep = 6
    
    'VScrLineNum.Enabled = False
    'VScZD.Enabled = False
    'VScStep.Enabled = False
    'VScSpeed.Enabled = False
    
    LineRed = 255
    LineGreen = 0
    LineBlue = 0
    LineColor = LineRed + LineGreen * 256 + LineBlue * 65536
'txtShow.Text = txtShow.Text & Str(PointN)
'txtShow.Text = "aaaa"
    TimeN = 0
    Call InitPoint
    
    cmdStart.Caption = "暂停"
    
    timMain.Enabled = True
Else
    If cmdStart.Caption = "暂停" Then
        cmdStart.Caption = "继续"
        timMain.Enabled = False
    Else
        cmdStart.Caption = "暂停"
        timMain.Enabled = True
    End If
End If
End Sub

Private Sub Form_Initialize()
Dim ls As Integer
W0 = 25
W1 = 315
H0 = 5
H1 = 235
LineN = Val(txtLineNum.Text)
PointN = Val(txtZD.Text)
LineSpeed = Val(txtSpeed.Text)
LineRed = 255
LineGreen = 0
LineBlue = 0
LineColor = LineRed + LineGreen * 256 + LineBlue * 65536
'txtShow.Text = txtShow.Text & Str(PointN)
'txtShow.Text = "aaaa"
TimeN = 0
'MsgBox "aaa"
cbSelect.List(0) = "线"
cbSelect.List(1) = "点"
ls = cbSelect.AddItem("线", 0)
ls = cbSelect.AddItem("点", 1)
End Sub

Private Sub Form_OKClick()
    App.End
End Sub

Private Sub timMain_Timer()
Dim ls As Integer
Dim i As Integer
Dim j As Integer
'Static n
'Dim n As Integer
'n = 0
If LineRed = 255 And LineGreen = 0 And LineBlue = 0 Then ColorFlag = 0
If LineRed = 255 And LineGreen = 0 And LineBlue = 255 Then ColorFlag = 1
If LineRed = 0 And LineGreen = 0 And LineBlue = 255 Then ColorFlag = 2
If LineRed = 0 And LineGreen = 255 And LineBlue = 255 Then ColorFlag = 3
If LineRed = 0 And LineGreen = 255 And LineBlue = 0 Then ColorFlag = 4
If LineRed = 255 And LineGreen = 255 And LineBlue = 0 Then ColorFlag = 5
Select Case ColorFlag
    Case 0
        LineBlue = LineBlue + ColorStep
    Case 1
        LineRed = LineRed - ColorStep
    Case 2
        LineGreen = LineGreen + ColorStep
    Case 3
        LineBlue = LineBlue - ColorStep
    Case 4
        LineRed = LineRed + ColorStep
    Case 5
        LineGreen = LineGreen - ColorStep
End Select
If LineBlue > 255 Then LineBlue = 255
If LineRed > 255 Then LineRed = 255
If LineGreen > 255 Then LineGreen = 255

If LineBlue < 0 Then LineBlue = 0
If LineRed < 0 Then LineRed = 0
If LineGreen < 0 Then LineGreen = 0

LineColor = LineRed + LineGreen * 256 + LineBlue * 65536

TimeN = TimeN + 1
If TimeN > LineN Then TimeN = LineN
For j = 0 To PointN - 1
    For i = TimeN To 1 Step -1
        x(j, i) = x(j, i - 1)
        y(j, i) = y(j, i - 1)
    Next i
    x(j, 0) = x(j, 0) + LineStep * Cos(a(j))
    y(j, 0) = y(j, 0) + LineStep * Sin(a(j))
    
    If x(j, 0) <= H0 Then
        a(j) = -1.57 + 1.57 * Rnd(1)
        If y(j, 0) <= W0 Then a(j) = 1.57 * Rnd(1)
        If y(j, 0) >= W1 Then a(j) = -1.57 * Rnd(1)
    Else
        If x(j, 0) >= H1 Then
            a(j) = 1.57 + 3.14 * Rnd(1)
            If y(j, 0) <= W0 Then a(j) = 1.57 + 1.57 * Rnd(1)
            If y(j, 0) >= W1 Then a(j) = 3.14 + 1.57 * Rnd(1)
        Else
            If y(j, 0) <= W0 Then a(j) = 3.14 * Rnd(1)
            If y(j, 0) >= W1 Then a(j) = 3.14 + 3.14 * Rnd(1)
        End If
    End If
Next j
For i = 0 To PointN - 2
    Select Case BHStyle
    'If BHStyle = 0 Then
        Case 0
            ls = formML.DrawLine(x(i, 0), y(i, 0), x(i + 1, 0), y(i + 1, 0), LineColor)
            ls = formML.DrawLine(x(i, LineN), y(i, LineN), x(i + 1, LineN), y(i + 1, LineN), vbBlack)
        Case 1
            ls = formML.DrawCircle(x(i, 0), y(i, 0), Cr, LineColor)
            ls = formML.DrawCircle(x(i, LineN), y(i, LineN), Cr, vbBlack)
        Case 2
            ls = formML.PointSet(x(i, 0), y(i, 0), LineColor)
            ls = formML.PointSet(x(i, LineN), y(i, LineN), vbBlack)
    End Select
Next i
Select Case BHStyle
Case 0
    ls = formML.DrawLine(x(0, 0), y(0, 0), x(PointN - 1, 0), y(PointN - 1, 0), LineColor)
    ls = formML.DrawLine(x(0, LineN), y(0, LineN), x(PointN - 1, LineN), y(PointN - 1, LineN), vbBlack)
Case 1
    ls = formML.DrawCircle(x(PointN - 1, 0), y(PointN - 1, 0), Cr, LineColor)
    ls = formML.DrawCircle(x(PointN - 1, LineN), y(PointN - 1, LineN), Cr, vbBlack)
Case 2
    ls = formML.PointSet(x(PointN - 1, 0), y(PointN - 1, 0), LineColor)
    ls = formML.PointSet(x(PointN - 1, LineN), y(PointN - 1, LineN), vbBlack)
End Select

'将第一根线变成第二根,第二变第三
'取第一根线的值
'判断第一根线的值是否超范围
'  超:换算出新的角度
'再取第一根线的值
'画出第一根线,消除第N根线
End Sub

Private Sub VScrLineNum_Change()
Dim i As Integer
Dim ls As Integer
txtLineNum.Text = VScrLineNum.Value
If VScrLineNum.Value > LineN Then
    LineN = VScrLineNum.Value
Else
    Select Case BHStyle
    'If BHStyle = 0 Then
    Case 0
        For i = 0 To PointN - 2
            ls = formML.DrawLine(x(i, LineN - 1), y(i, LineN - 1), x(i + 1, LineN - 1), y(i + 1, LineN - 1), vbBlack)
        Next i
        ls = formML.DrawLine(x(0, LineN - 1), y(0, LineN - 1), x(PointN - 1, LineN - 1), y(PointN - 1, LineN - 1), vbBlack)
    Case 1
        For i = 0 To PointN - 1
            ls = formML.DrawCircle(x(i, LineN - 1), y(i, LineN - 1), Cr, vbBlack)
        Next i
    Case 2
        For i = 0 To PointN - 1
            ls = formML.PointSet(x(i, LineN - 1), y(i, LineN - 1), vbBlack)
        Next i
    End Select
    LineN = VScrLineNum.Value
End If
'LineN = VScrLineNum.Value
End Sub


Private Sub VScSpeed_Change()
txtSpeed.Text = VScSpeed.Value
LineSpeed = VScSpeed.Value
timMain.Interval = 100 * LineSpeed
End Sub

Private Sub VScStep_Change()
txtStep.Text = VScStep.Value
LineStep = VScStep.Value
End Sub

Private Sub VScZD_Change()
Dim i As Integer
If VScZD.Value > PointN Then
    txtZD.Text = VScZD.Value
    For i = 0 To LineN - 1
        x(PointN, i) = x(PointN - 1, i)
        y(PointN, i) = y(PointN - 1, i)
        a(PointN) = 6.28 * Rnd(1)
    Next i
    PointN = VScZD.Value
End If
End Sub
Private Sub InitPoint()
Dim i As Integer
Dim ls As Integer
'txtShow.Text = txtShow.Text & PointN
For i = 0 To PointN - 1
    Randomize Timer
    x(i, 0) = H0 + (H1 - H0) * Rnd(i)
    y(i, 0) = W0 + (W1 - W0) * Rnd(i)
    a(i) = 6.28 * Rnd(i)
    'ls = formML.PointSet(x(i, 0), y(i, 0), vbRed)
    'txtShow.Text = txtShow.Text & x(i, 0) & "=" & y(i, 0)
Next i
    'ls = formML.PointSet(100, 100, vbRed)
    
End Sub