form1.frm

采用VB编写的一个电路分析系统

     Case 4
     node(m).noden4 = 0
  End Select
    Else
    If cell(Index).celln1 Mod 10 = 1 Then
     cell(index1).celln1 = 0
     If cell(index1).celln2 = 0 Then
      cell(index1).isnew = 0
      cell(index1).cellstate = 0
     End If
    If cell(index1).main1 = 1 Then
      cell(index1).main1 = 0
    End If
   ElseIf cell(Index).celln1 Mod 10 = 2 Then
      cell(index1).celln2 = 0
     If cell(index1).celln1 = 0 Then
      cell(index1).isnew = 0
        cell(index1).cellstate = 0
     End If
   If cell(index1).main2 = 1 Then
      cell(index1).main2 = 0
    End If
   End If
   End If
'====================================================
   If cell(Index).celln2 < 0 Then
   m = Fix(-cell(Index).celln2 / 10)
   nn = -cell(Index).celln2 Mod 10
   Select Case nn
     Case 1
     node(m).noden1 = 0
     Case 2
     node(m).noden2 = 0
     Case 3
     node(m).noden3 = 0
     Case 4
     node(m).noden4 = 0
  End Select
    Else
   If cell(Index).celln2 Mod 10 = 1 Then
     cell(index2).celln1 = 0
     If cell(index2).celln2 = 0 Then
      cell(index2).isnew = 0
          cell(index2).cellstate = 0
     End If
   If cell(index2).main1 = 1 Then
      cell(index2).main1 = 0
    End If
   ElseIf cell(Index).celln1 Mod 10 = 2 Then
      cell(index2).celln2 = 0
     If cell(index2).celln1 = 0 Then
      cell(index2).isnew = 0
          cell(index2).cellstate = 0
     End If
   If cell(index2).main2 = 1 Then
      cell(index2).main2 = 0
    End If
   End If
 End If
  End If
End Sub
Private Sub changecell(m, n As Integer)
cell(m).cellarc = cell(n).cellarc
cell(m).cellvalue = cell(n).cellvalue
cell(m).cellstate = cell(n).cellstate
cell(m).cellindex = cell(n).cellindex
cell(m).celltype = cell(n).celltype
cell(m).cellinbranch = cell(n).cellinbranch
cell(m).celln1 = cell(n).celln1
cell(m).celln2 = cell(n).celln2
cell(m).cellinhole1 = cell(n).cellinhole1
cell(m).cellinhole2 = cell(n).cellinhole2
cell(m).celltag = cell(n).celltag
cell(m).n1volt = cell(n).n1volt
cell(m).n2volt = cell(n).n2volt
cell(m).cellcurrent = cell(n).cellcurrent
cell(m).isnew = cell(n).isnew
cell(m).main1 = cell(n).main1
cell(m).main2 = cell(n).main2
cell(m).Left = cell(n).Left
cell(m).Top = cell(n).Top
cell(m).Tag = cell(n).Tag
Call cell(m).incall

End Sub

Private Sub 示波器_Click()
waveviewer.Show
End Sub

Private Sub 元件标注_Click()
Call mark(元件.Tag)
End Sub
Private Sub mark(Index As Integer)

cell(Index).Print ("V")
End Sub
Function search(n, d As Integer) As Boolean
For n = 0 To counts - 1
 If cell(n).cellstate = d Then
 search = True
 Exit Function
 End If
Next
search = False
End Function
Private Sub lineab(ltype, c1, c2, n1, n2 As Integer)
Dim mycolor As Variant
Dim flag, nowc As Integer
flag = 0



If n1 = 1 Then
x1 = cell(c1).Left + cell(c1).n1x - 10
y1 = cell(c1).Top + cell(c1).n1y
Else
x1 = cell(c1).Left + cell(c1).n2x
y1 = cell(c1).Top + cell(c1).n2y
End If
If n2 = 1 Then
X2 = cell(c2).Left + cell(c2).n1x - 10
Y2 = cell(c2).Top + cell(c2).n1y
Else
X2 = cell(c2).Left + cell(c2).n2x
Y2 = cell(c2).Top + cell(c2).n2y
End If
If ltype = 0 Then
   mycolor = vbBlack
   

'the below is the different kind of drawing the lines
Picture1.DrawMode = 13


Picture1.Line (x1, y1)-(tempx, tempy), vbWhite

If (x1 < X2 And y1 = Y2 And (n1 = 1 Or n2 = 2)) Or (x1 > X2 And y1 = Y2 And (n1 = 2 Or n2 = 1)) Then
    drawtype = 4
   flag = 1
End If
If flag = 0 Then
If n1 = 1 And n2 = 1 And x1 < X2 Then
drawtype = 1
ElseIf n1 = 1 And n2 = 1 And x1 > X2 Then
drawtype = 2
ElseIf n1 = 1 And n2 = 2 And x1 < X2 Then
 drawtype = 3
ElseIf n1 = 1 And n2 = 2 And x1 > X2 Then
 drawtype = 1
ElseIf n1 = 2 And n2 = 1 And x1 < X2 Then
   drawtype = 1
ElseIf n1 = 2 And n2 = 1 And x1 > X2 Then
  drawtype = 3
ElseIf n1 = 2 And n2 = 2 And x1 < X2 Then
   drawtype = 2
ElseIf n1 = 2 And n2 = 2 And x1 > X2 Then
  drawtype = 1
End If
End If

Select Case drawtype
 Case 1
  Picture1.Line (x1, y1)-(x1, Y2), mycolor
   Picture1.Line (x1, Y2)-(X2, Y2), mycolor
 Case 2
  Picture1.Line (x1, y1)-(X2, y1), mycolor
   Picture1.Line (X2, y1)-(X2, Y2), mycolor
 Case 3
 Picture1.Line (x1, y1)-(x1, Fix((y1 + Y2) / 2)), mycolor
   Picture1.Line (x1, Fix((y1 + Y2) / 2))-(X2, Fix((y1 + Y2) / 2)), mycolor
   Picture1.Line (X2, Fix((y1 + Y2) / 2))-(X2, Y2), mycolor
Case 4
   Picture1.Line (x1, y1)-(x1, y1 + 700), mycolor
   Picture1.Line (x1, y1 + 700)-(X2, y1 + 700), mycolor
   Picture1.Line (X2, y1 + 700)-(X2, Y2), mycolor
End Select

Picture1.DrawMode = 7
'=================================================================================
Else
  mycolor = vbWhite
  
 If (x1 < X2 And y1 = Y2 And (n1 = 1 Or n2 = 2)) Or (x1 > X2 And y1 = Y2 And (n1 = 2 Or n2 = 1)) Then
    drawtype = 4
   flag = 1
End If
If flag = 0 Then
If n1 = 1 And n2 = 1 And x1 < X2 Then
drawtype = 1
ElseIf n1 = 1 And n2 = 1 And x1 > X2 Then
drawtype = 2
ElseIf n1 = 1 And n2 = 2 And x1 < X2 Then
 drawtype = 3
ElseIf n1 = 1 And n2 = 2 And x1 > X2 Then
 drawtype = 1
ElseIf n1 = 2 And n2 = 1 And x1 < X2 Then
   drawtype = 1
ElseIf n1 = 2 And n2 = 1 And x1 > X2 Then
  drawtype = 3
ElseIf n1 = 2 And n2 = 2 And x1 < X2 Then
   drawtype = 2
ElseIf n1 = 2 And n2 = 2 And x1 > X2 Then
  drawtype = 1
End If
End If

Select Case drawtype
 Case 1
  Picture1.Line (x1, y1)-(x1, Y2), mycolor
   Picture1.Line (x1, Y2)-(X2, Y2), mycolor
 Case 2
  Picture1.Line (x1, y1)-(X2, y1), mycolor
   Picture1.Line (X2, y1)-(X2, Y2), mycolor
 Case 3
 Picture1.Line (x1, y1)-(x1, Fix((y1 + Y2) / 2)), mycolor
   Picture1.Line (x1, Fix((y1 + Y2) / 2))-(X2, Fix((y1 + Y2) / 2)), mycolor
   Picture1.Line (X2, Fix((y1 + Y2) / 2))-(X2, Y2), mycolor
Case 4
   Picture1.Line (x1, y1)-(x1, y1 + 700), mycolor
   Picture1.Line (x1, y1 + 700)-(X2, y1 + 700), mycolor
   Picture1.Line (X2, y1 + 700)-(X2, Y2), mycolor
End Select
End If


tempn = 0

End Sub
Private Sub lineabx(c, n, X, Y As Integer)
If n = 1 Then
x1 = cell(c).Left + cell(c1).n1x - 10
y1 = cell(c).Top + cell(c1).n1y
Else
x1 = cell(c).Left + cell(c1).n2x - 10
y1 = cell(c).Top + cell(c1).n2y
End If

  
  If tempn = 1 Then
   Picture1.Line (x1, y1)-(tempx, tempy), vbWhite
   Picture1.Line (x1, y1)-(X, Y), vbWhite
  Else
   Picture1.Line (x1, y1)-(X, Y), vbWhite
End If
  tempx = X
  tempy = Y
  tempn = 1
   
End Sub
Private Sub displaycellinfo()
docform.Text1.Text = ""
For m = 0 To counts - 1
docform.Text1.Text = docform.Text1.Text + CStr(cell(m).celln1) + "////////"
Next m
End Sub

Private Sub linenc(ltype, noden, celln, nport, cport As Integer)
Dim Index As Integer
If cport = 1 Then
x1 = cell(celln).Left + cell(celln).n1x - 10
y1 = cell(celln).Top + cell(celln).n1y
Else
x1 = cell(celln).Left + cell(celln).n2x
y1 = cell(celln).Top + cell(celln).n2y
End If
Select Case nport
Case 1
X2 = node(noden).Left
Y2 = node(noden).Top + 30
Case 2
X2 = node(noden).Left + 30
Y2 = node(noden).Top
Case 3
X2 = node(noden).Left + 60
Y2 = node(noden).Top + 60
Case 4
X2 = node(noden).Left + 30
Y2 = node(noden).Top + 60
End Select
mycolor = vbWhite

If ltype = 0 Then
Picture1.Line (x1, y1)-(tempx, tempy), vbWhite
Picture1.DrawMode = 13
mycolor = vbBlack
End If

 If x1 > X2 And cport = 1 Then
   drawtype = 2
 ElseIf x1 > X2 And cport = 2 Then
   drawtype = 1
 ElseIf x1 < X2 And cport = 1 Then
   drawtype = 1
 ElseIf x1 < X2 And cport = 2 Then
 drawtype = 2
 End If
   
Select Case drawtype
Case 1
 Picture1.Line (x1, y1)-(x1, Y2), mycolor
  Picture1.Line (x1, Y2)-(X2, Y2), mycolor
Case 2
 Picture1.Line (x1, y1)-(X2, y1), mycolor
  Picture1.Line (X2, y1)-(X2, Y2), mycolor
End Select

If ltype = 0 Then
Picture1.DrawMode = 7
End If
tempn = 0
End Sub
Private Sub copypenline(Index As Integer)
If cell(Index).isnew <> 0 Then
      If cell(Index).celln1 Mod 10 = 1 Then  '//////////to redraw the cell lines
          If cell(Index).main1 <> 0 Then
             Call lineab(1, Index, Fix(cell(Index).celln1 / 10), 1, 1)
           Else
            Call lineab(1, Fix(cell(Index).celln1 / 10), Index, 1, 1)
          End If
      ElseIf cell(Index).celln1 Mod 10 = 2 Then   '//////////to redraw the cell lines
           If cell(Index).main1 <> 0 Then
          Call lineab(1, Index, Fix(cell(Index).celln1 / 10), 1, 2)
            Else
             Call lineab(1, Fix(cell(Index).celln1 / 10), Index, 2, 1)
           End If
    End If
      If cell(Index).celln2 Mod 10 = 1 Then   '//////////to redraw the cell lines
          If cell(Index).main2 <> 0 Then
          Call lineab(1, Index, Fix(cell(Index).celln2 / 10), 2, 1)
          Else
            Call lineab(1, Fix(cell(Index).celln2 / 10), Index, 1, 2)
          End If
      ElseIf cell(Index).celln2 Mod 10 = 2 Then   '//////////to redraw the cell lines
          If cell(Index).main2 <> 0 Then
          Call lineab(1, Index, Fix(cell(Index).celln2 / 10), 2, 2)
       Else
          Call lineab(1, Fix(cell(Index).celln2 / 10), Index, 2, 2)
        End If
    End If
' to add the code that match with the node and cell links!
      k = -cell(Index).celln1 Mod 10
      If k > 0 Then
      Call linenc(1, Fix(-cell(Index).celln1 / 10), Index, k, 1)
     End If
       k = -cell(Index).celln2 Mod 10
      If k > 0 Then
      Call linenc(1, Fix(-cell(Index).celln2 / 10), Index, k, 2)
     End If
   
End If
End Sub


Public Sub matshower(ftype, a, b As Integer, mat() As Single, strs As String)


If Picture2.Tag = 0 Then
   matshow(0).Height = 400 + 200 * a
 If b >= 4 Then
  matshow(0).Columns = 3
  Else
   matshow(0).Columns = 2
  End If
 If a = 1 Then
 matshow(0).Height = 420
 End If
 matrixname(0).Caption = strs + "矩阵"
 Frame(0).Tag = matshow(0).Height + matrixname(0).Height
'-----------------------------------------------
For k = 0 To b - 1
  For kk = 0 To a - 1
matshow(0).AddItem mat(kk, k)
 Next kk
 Next k

Else

Load matrixname(Picture2.Tag)
 Load matshow(Picture2.Tag)
 matshow(Picture2.Tag).Visible = True
 matrixname(Picture2.Tag).Visible = True
 matrixname(Picture2.Tag).Top = Frame(0).Tag
 matrixname(Picture2.Tag).Caption = strs + "矩阵"
 matshow(Picture2.Tag).Top = Frame(0).Tag + matrixname(0).Height


If ftype = 0 Then
 
  matshow(Picture2.Tag).Height = 400 + 200 * a
 If b >= 4 Then
   matshow(Picture2.Tag).Columns = 3
  Else
   If a = 1 Then
   matshow(Picture2.Tag).Columns = 2
  Else
   matshow(Picture2.Tag).Columns = b
  End If
  End If
If a = 1 Then
  matshow(Picture2.Tag).Height = 420
 End If
 If a = -1 Then
For kk = 0 To b - 1
matshow(Picture2.Tag).AddItem mat(kk)
Next kk
Else
For k = 0 To b - 1
  For kk = 0 To a - 1
matshow(Picture2.Tag).AddItem mat(kk, k)
 Next kk
 Next k
 
 End If
 
ElseIf ftype = 1 Then '==============================
 
 If b >= 3 Then
   matshow(Picture2.Tag).Height = 400 + 200 * a
   matshow(Picture2.Tag).Columns = 3
  Else
   matshow(Picture2.Tag).Height = 400 + 200 * a
   matshow(Picture2.Tag).Columns = b
  End If
 
 If a = -1 Then
  matshow(Picture2.Tag).Height = 420
  For kk = 1 To b
   matshow(Picture2.Tag).AddItem mat(kk)
   Next kk
Else
  For k = 1 To b
   For kk = 1 To a
    matshow(Picture2.Tag).AddItem mat(kk, k)
   Next kk
  Next k
 End If

End If
Frame(0).Tag = Frame(0).Tag + matshow(Picture2.Tag).Height + matrixname(0).Height

End If
Picture2.Tag = Picture2.Tag + 1
Picture2.Height = Frame(0).Tag
End Sub