form1.frm

一款电场线的教学软件可以自定义电荷多少

            Else
                min = Calculate_U(i, j)
            End If
        Next j
    Next i
    For k = 0 To 5
        For i = 0 To Picture1.ScaleWidth Step 5
            For j = 0 To Picture1.ScaleHeight Step 5
                If Abs(Calculate_U(i, j) - min + (max - min) * k / 5) <= Abs(Calculate_U(3000, 2000) - Calculate_U(3000, 2005)) Then
                    Picture1.PSet (i, j), QBColor(1)
                End If
            Next j
        Next i
    Next k
End Sub

Private Sub Draw_E()
    For i = 0 To n - 1
        If qq(i).q = 0 Then
            MsgBox "电量不能为零！！！！！"
            Exit Sub
        End If
    Next i
    Picture1.Cls
    Call Draw_Q
    m = 3000
    ds = 75
    Dim gx, gy, DX, DY As Double
    ReDim Rr_E(n), ex_E(n), ey_E(n)
    Picture1.DrawWidth = linewidth
    For i = 0 To n - 1
        For k = 0 To 35
            qq(i).x(k) = qq(i).qx + R * Cos(k * pi / 18 - pi / 36)
            qq(i).y(k) = qq(i).qy - R * Sin(k * pi / 18 - pi / 36)
        Next k
    Next i
    For i = 0 To n - 1
        If qq(i).q > 0 Then
            For k = 0 To 35
                gx = 0#
                gy = 0#
                For j = 0 To m
                    gx = 0#
                    gy = 0#
                    For t = 0 To n - 1
                        Rr_E(t) = Sqr((qq(i).x(k) - qq(t).qx) ^ 2 + (qq(i).y(k) - qq(t).qy) ^ 2)
                        ex_E(t) = qq(t).q * (qq(i).x(k) - qq(t).qx) / Rr_E(t) ^ 3
                        ey_E(t) = qq(t).q * (qq(i).y(k) - qq(t).qy) / Rr_E(t) ^ 3
                        gx = gx + ex_E(t)
                        gy = gy + ey_E(t)
                    Next t
                    e = Sqr(gx ^ 2 + gy ^ 2)
                    DX = ds * gx / e
                    DY = ds * gy / e
                    qq(i).x(k) = qq(i).x(k) + DX
                    qq(i).y(k) = qq(i).y(k) + DY
                    If IsPointValued(i, k) Then
                        Picture1.PSet (qq(i).x(k), qq(i).y(k)), QBColor(1)
                        If qq(i).x(k) < 0 Or qq(i).x(k) > Picture1.ScaleWidth Or qq(i).y(k) < 0 Or qq(i).y(k) > Picture1.ScaleHeight Then
                            ds = 200
                        Else: ds = 75
                        End If
                    End If
                Next j
            Next k
        End If
    Next i
End Sub

Private Function IsPointValued(ByVal ii As Integer, ByVal kk As Integer) As Boolean
    If qq(ii).x(kk) > 0 And qq(ii).x(kk) < Picture1.ScaleWidth And qq(ii).y(kk) > 0 And qq(ii).y(kk) < Picture1.ScaleHeight Then
        IsPointValued = True
    End If
    For j = 0 To n - 1
        If (qq(ii).x(kk) - qq(j).qx) ^ 2 + (qq(ii).y(kk) - qq(j).qy) ^ 2 < (R + 40) ^ 2 Then
            IsPointValued = False
        End If
    Next j
End Function

Private Function Min_cmp(ByVal x As Double, ByVal y As Double) As Double
    If x < y Then
        Min_cmp = x
    Else
        Min_cmp = y
    End If
End Function

Private Function Max_cmp(ByVal x As Double, ByVal y As Double)
    If x >= y Then
        Max_cmp = x
    Else
        Max_cmp = y
    End If
End Function

Private Sub Draw_U3()
    Dim density As Integer, u As Double
    density = 4
    Dim max, min, limit As Double
    max = Calculate_U(0, 0)
    min = Calculate_U(0, 0)
    Dim i As Integer
    Dim j As Integer
    For i = 0 To Picture1.ScaleWidth Step 10
        For j = 0 To Picture1.ScaleHeight Step 10
            If Calculate_U(i, j) >= max Then
                max = Calculate_U(i, j)
            Else
                min = Calculate_U(i, j)
            End If
        Next j
    Next i
    For i = 1 To density
        u = min + (max - min) * i / (density + 2)
        For j = 20 To 5980 Step 20
            For k = 20 To 3980 Step 20
                limit = Min_cmp(Abs(Calculate_U(j + 20, k) - u), Abs(Calculate_U(j - 20, k) - u))
                limit = Min_cmp(limit, Abs(Calculate_U(j, k + 20) - u))
                limit = Min_cmp(limit, Abs(Calculate_U(j, k - 20) - u))
                If Abs(Calculate_U(j, k) - u) < 0.00000000001 And IsPointValued(j, k) Then
                    Picture1.PSet (j, k), QBColor(10)
                End If
            Next k
        Next j
    Next i
End Sub

Private Sub Draw_U2()
    Dim pos_index, neg_index, density, m As Integer
    Dim U_X1(), U_Y1(), U_X2(), U_Y2() As Double
    ReDim Rr_U(n), ex_U(n), ey_U(n)
    Dim gx, gy, DX, DY As Double
    pos_index = 0
    neg_index = 0
    density = 6
    m = 150
    ds = 20
    For i = 1 To n - 1
        If qq(i).q >= qq(pos_index).q Then
            pos_index = i
        End If
        If qq(i).q < qq(pos_index).q Then
            neg_index = i
        End If
    Next i
    ReDim U_X1(density), U_Y1(density), U_X2(density), U_Y2(density)
    For i = 1 To density
        U_X1(i - 1) = qq(pos_index).qx + (qq(neg_index).qx - qq(pos_index).qx) * i / (density + 1)
        U_Y1(i - 1) = qq(pos_index).qy + (qq(neg_index).qy - qq(pos_index).qy) * i / (density + 1)
        U_X2(i - 1) = qq(pos_index).qx + (qq(neg_index).qx - qq(pos_index).qx) * i / (density + 1)
        U_Y2(i - 1) = qq(pos_index).qy + (qq(neg_index).qy - qq(pos_index).qy) * i / (density + 1)
    Next i
    For i = 0 To density - 1
        For j = 0 To m
            gx = 0#
            gy = 0#
            For t = 0 To n - 1
                    Rr_U(t) = Sqr((qq(t).qx - U_X1(i)) ^ 2 + (qq(t).qy - U_Y1(i)) ^ 2)
                    ex_U(t) = qq(t).q * (U_X1(i) - qq(t).qx) / Rr_U(t) ^ 3
                    ey_U(t) = qq(t).q * (U_Y1(i) - qq(t).qy) / Rr_U(t) ^ 3
                    gx = gx + ex_U(t)
                    gy = gy + ey_U(t)
            Next t
            e = Sqr(gx ^ 2 + gy ^ 2)
            DX = -ds * gy / e
            DY = ds * gx / e
            U_X1(i) = U_X1(i) + DX
            U_Y1(i) = U_Y1(i) + DY
            gx = 0#
            gy = 0#
            For t = 0 To n - 1
                    Rr_U(t) = Sqr((qq(t).qx - U_X2(i)) ^ 2 + (qq(t).qy - U_Y2(i)) ^ 2)
                    ex_U(t) = qq(t).q * (U_X2(i) - qq(t).qx) / Rr_U(t) ^ 3
                    ey_U(t) = qq(t).q * (U_Y2(i) - qq(t).qy) / Rr_U(t) ^ 3
                    gx = gx + ex_U(t)
                    gy = gy + ey_U(t)
            Next t
            e = Sqr(gx ^ 2 + gy ^ 2)
            DX = ds * gy / e
            DY = -ds * gx / e
            U_X2(i) = U_X2(i) + DX
            U_Y2(i) = U_Y2(i) + DY
           Rem If IsPointValued(Int(U_X1(i)), Int(U_Y1(i))) Then
                Picture1.PSet (Int(U_X1(i)), Int(U_Y1(i))), QBColor(10)
                Picture1.PSet (Int(U_X2(i)), Int(U_Y2(i))), QBColor(10)
           Rem End If
        Next j
    Next i
End Sub


Private Function Exist_pos() As Boolean
    Exist_pos = False
    For i = 0 To n - 1
    If qq(i).q > 0 Then
        Exist_pos = True
    End If
    Next i
End Function

Private Function Exist_neg() As Boolean
    Exist_neg = False
    For i = 0 To n - 1
    If qq(i).q < 0 Then
        Exist_neg = True
    End If
    Next i
End Function

Private Function Exist_pos_neg() As Boolean
    Exist_pos_neg = False
    If Exsit_pos And Exsit_neg Then
        Exist_pos_neg = True
    End If
End Function

Private Function Between_pos(ByVal x As Double, ByVal y As Double, ByVal nn As Integer) As Boolean
    Between_pos = False
    If nn >= 3 Then
        For i = 1 To nn - 1
        If (Calculate_U(x, y) >= u_pos(i) And Calculate_U(x, y) <= u_pos(i + 1)) Or (Calculate_U(x, y) <= u_pos(i) And Calculate_U(x, y) >= u_pos(i + 1)) Then
            Between_pos = True
        End If
        Next i
    End If
End Function

Private Function Between_neg(ByVal x As Double, ByVal y As Double, ByVal nn As Integer) As Boolean
    Between_neg = False
    If nn >= 3 Then
        For i = 1 To nn - 1
        If (Calculate_U(x, y) >= u_neg(i) And Calculate_U(x, y) <= u_neg(i + 1)) Or (Calculate_U(x, y) <= u_neg(i) And Calculate_U(x, y) >= u_neg(i + 1)) Then
            Between_neg = True
        End If
        Next i
    End If
End Function

Private Function U_MIN(ByVal i As Integer) As Integer
    min = Calculate_U(qq(i).qx, qq(i).qy - 200)
    Index = 1
    If min > Calculate_U(qq(i).qx, qq(i).qy + 200) Then
    min = Calculate_U(qq(i).qx, qq(i).qy + 200)
    Index = 2
    End If
    If min > Calculate_U(qq(i).qx - 200, qq(i).qy) Then
    min = Calculate_U(qq(i).qx - 200, qq(i).qy)
    Index = 3
    End If
    If min > Calculate_U(qq(i).qx + 200, qq(i).qy) Then
    min = Calculate_U(qq(i).qx + 200, qq(i).qy)
    Index = 4
    End If
    U_MIN = Index
End Function

Private Function U_MAX(ByVal i As Integer) As Integer
    max = Calculate_U(qq(i).qx, qq(i).qy - 200)
    Index = 1
    If max < Calculate_U(qq(i).qx, qq(i).qy + 200) Then
    min = Calculate_U(qq(i).qx, qq(i).qy + 200)
    Index = 2
    End If
    If max < Calculate_U(qq(i).qx - 200, qq(i).qy) Then
    min = Calculate_U(qq(i).qx - 200, qq(i).qy)
    Index = 3
    End If
    If max < Calculate_U(qq(i).qx + 200, qq(i).qy) Then
    min = Calculate_U(qq(i).qx + 200, qq(i).qy)
    Index = 4
    End If
    U_MAX = Index
End Function

Private Sub Draw_U()
    For i = 0 To n - 1
        If qq(i).q = 0 Then
            MsgBox "电量不能为零！！！！！"
            Exit Sub
        End If
    Next i
    Picture1.DrawWidth = linewidth
    ReDim u_pos(0), u_neg(0) As Double
    Dim un_pos, un_neg As Integer
    Dim x, y As Double
    un_pos = 0
    un_neg = 0
    m = 1000
    ds = 25
    For i = 0 To n - 1
    If qq(i).q > 0 Then
        start = U_MIN(i)
        Select Case start
        Case 1
            start_x = qq(i).qx
            start_y = qq(i).qy - 200
        Case 2
            start_x = qq(i).qx
            start_y = qq(i).qy + 200
        Case 3
            start_x = qq(i).qx - 200
            start_y = qq(i).qy
        Case 4
            start_x = qq(i).qx + 200
            start_y = qq(i).qy
        End Select
        Radius = 1000
        For j = 0 To 4
            If un_pos <= 2 Or j <= 1 Or (Not Between_pos(start_x, start_y, un_pos)) Then
                    x = start_x
                    y = start_y
                    For k = 0 To m
                        gx = 0#
                        gy = 0#
                        For t = 0 To n - 1
                            Rr = Sqr((qq(t).qx - x) ^ 2 + (qq(t).qy - y) ^ 2)
                            ex = qq(t).q * (x - qq(t).qx) / Rr ^ 3
                            ey = qq(t).q * (y - qq(t).qy) / Rr ^ 3
                            gx = gx + ex
                            gy = gy + ey
                        Next t
                        e = Sqr(gx ^ 2 + gy ^ 2)
                        DX = -ds * gy / e
                        DY = ds * gx / e
                        x = x + DX
                        y = y + DY
                        Picture1.PSet (Int(x), Int(y)), QBColor(10)
                    Next k
                    un_pos = un_pos + 1
                    ReDim Preserve u_pos(un_pos)
                    u_pos(un_pos) = Calculate_U(start_x, start_y)
                    gx = 0#
                    gy = 0#
                    For t = 0 To n - 1
                        Rr = Sqr((qq(t).qx - start_x) ^ 2 + (qq(t).qy - start_y) ^ 2)
                        ex = qq(t).q * (start_x - qq(t).qx) / Rr ^ 3
                        ey = qq(t).q * (start_y - qq(t).qy) / Rr ^ 3
                        gx = gx + ex
                        gy = gy + ey
                    Next t
                    e = Sqr(gx ^ 2 + gy ^ 2)
                    DX = -Radius * gy / e
                    DY = Radius * gx / e
                    start_x = start_x + DX
                    start_y = start_y + DY
                    
            End If
        Next j
    Else
        start = U_MAX(i)
        Select Case start
        Case 1
            start_x = qq(i).qx
            start_y = qq(i).qy - 200
        Case 2
            start_x = qq(i).qx
            start_y = qq(i).qy + 200
        Case 3
            start_x = qq(i).qx - 200
            start_y = qq(i).qy
        Case 4
            start_x = qq(i).qx + 200
            start_y = qq(i).qy
        End Select
        Radius = 1000
        For j = 0 To 4
            If un_neg <= 2 Or j <= 1 Or (Not Between_neg(start_x, start_y, un_neg)) Then
                    x = start_x
                    y = start_y
                    For k = 0 To m
                        gx = 0#
                        gy = 0#
                        For t = 0 To n - 1
                            Rr = Sqr((qq(t).qx - x) ^ 2 + (qq(t).qy - y) ^ 2)
                            ex = qq(t).q * (x - qq(t).qx) / Rr ^ 3
                            ey = qq(t).q * (y - qq(t).qy) / Rr ^ 3
                            gx = gx + ex
                            gy = gy + ey
                        Next t
                        e = Sqr(gx ^ 2 + gy ^ 2)
                        DX = -ds * gy / e
                        DY = ds * gx / e
                        x = x + DX
                        y = y + DY

                            Picture1.PSet (Int(x), Int(y)), QBColor(10)


                    Next k
                    un_neg = un_neg + 1
                    ReDim Preserve u_neg(un_neg)
                    u_neg(un_neg) = Calculate_U(start_x, start_y)
                    gx = 0#
                    gy = 0#
                    For t = 0 To n - 1
                        Rr = Sqr((qq(t).qx - start_x) ^ 2 + (qq(t).qy - start_y) ^ 2)
                        ex = qq(t).q * (start_x - qq(t).qx) / Rr ^ 3
                        ey = qq(t).q * (start_y - qq(t).qy) / Rr ^ 3
                        gx = gx + ex
                        gy = gy + ey
                    Next t
                    e = Sqr(gx ^ 2 + gy ^ 2)
                    DX = -Radius * gy / e
                    DY = Radius * gx / e
                    start_x = start_x + DX
                    start_y = start_y + DY
                    
            End If
        Next j
    
    End If
    Next i
End Sub
Rem ####################################################################################




Private Sub Command4_Click()
    Me.Hide
    Load Form4
    Form4.Visible = True
End Sub
Rem ####################################################################################