module1.bas

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

Attribute VB_Name = "Module1"
'对于节点这一特殊的器件，要有一个不同的对待方式，用以进行生成树等的工作！
'要定义两种数组来完成以后的工作，一个是节点信息，另一个是支路数组n*3！它用来定义树的工作。
Option Explicit
Public Const pi = 3.14159265
 Public syspath As String
  
  'to put the informations about the tools(type,index,arc,content,n1,n2,selfinbranch,selfinhole1,selfinhole2)  n*9
Type acvolt
frequency As Single
initialarc As Single
End Type

Type branch
  index As Integer
  bend(1) As Integer
cellcon() As Integer
End Type

Public Type electruct
   a As Single
   alpha As Single
   frequency As Single
End Type

Public Type nodevolt
a As Single
alpha As Single
End Type

Public Type wave
n0 As Integer
n1 As Integer
n_y As Single
n_v As Single
End Type

Public Type signal
 stype As Integer
 frequency As Single
 volt As Single
 arc As Single
 times As Integer
End Type

Public fpath As String
Public cellcurrentop, cellvoltop, nodevoltop As Integer
Public analysistype As Integer
Dim nodelink() As Variant
Public newfile As Integer
Public formstate As Integer
Public zeronode As Integer
Dim branch1() As branch
Dim tree() As Integer
Dim linkbranch() As Integer
Dim ND() As Integer
Dim a() As Integer
Dim bb() As Integer
Dim c() As Integer
Dim loops() As Integer
Dim resist, lcresist, volt, cvolt As Single
Dim brcounter As Integer

Public circuitstate As Integer
Dim errortype As Integer
Dim tree_node() As Single
Public multisignal As signal
Public nowfrequency() As Single
Dim mat(2) As Single
Dim n, b As Integer
Dim omig As Single
Dim cbmat() As Single
Public frequencytype As Integer
Dim ccbmat() As Single
Public nodevinfo() As nodevolt
Public cellname() As String
Public sourcemat() As electruct
Public sourcecount As Integer
Public counts, nodecounts, zerovoltnode As Integer
Public typecount(6) As Integer
  


'要解决数组下标不统一的问题，不然会太乱的！all the matrix should started from 0!

Public Sub makebranches()
'to make a matriss
errortype = 1
Dim m, p, tempvalue, temp, temp1, temp2 As Integer
Dim celcounter As Integer
brcounter = 0

ReDim ND(nodecounts - 1) As Integer
For m = 0 To nodecounts - 1
  ND(m) = m
Next m
For m = 0 To nodecounts - 1
     
     tempvalue = mapform.node(m).nodestate - 1

  For p = 0 To tempvalue       '我所定义的支路电流方向为从节点号小的到大的
 
    temp = Fix(findnodelink(CInt(m), CInt(p)) / 10)
    temp1 = Fix(mapform.cell(temp).celln1 / 10)
    temp2 = Fix(mapform.cell(temp).celln2 / 10)
    If (temp1 = m And temp1 < temp2) Or (temp2 = m And temp2 < temp1) Then
     
       ReDim Preserve branch1(brcounter)
       ReDim Preserve branch1(brcounter).cellcon(celcounter)
       branch1(brcounter).index = brcounter
       branch1(brcounter).bend(0) = m
       branch1(brcounter).cellcon(celcounter) = temp  '这里少了一个步骤是为了测试，以后再加上，是对元件个数的记录！
       mapform.cell(temp).cellinbranch = brcounter
       celcounter = celcounter + 1                                         '这里要加一个对元件性质的判断，以对元件加以记录！
         
       If temp1 = m Then
      branch1(brcounter).bend(1) = temp2
    Else
     branch1(brcounter).bend(1) = temp1
     End If
    
        brcounter = brcounter + 1
        celcounter = 0
 
    End If
  Next p
Next m
End Sub
Function findnodelink(index As Integer, nport As Integer) As Integer
Select Case nport
 Case 0
  findnodelink = mapform.node(index).noden1
  Case 1
  findnodelink = mapform.node(index).noden2
 Case 2
 findnodelink = mapform.node(index).noden3
 Case 3
 findnodelink = mapform.node(index).noden4
 End Select
End Function
Public Sub maketree() '定义一两个变量来存放b和n,它们是用正常的记录方式来存数据的！
errortype = 2
Dim k, treecounts, lbcounts As Integer
Dim ans As Boolean

'预先定义一下树集数组，由b 和 n 可计算出其维数！
ReDim tree(0 To n - 2) As Integer
ReDim linkbranch(0 To b - n) As Integer

For k = 0 To b - 1
  
   ans = find(branch1(k).bend(0))
     If ans = True Then
  
       tree(treecounts) = k
       Call instead(branch1(k).bend(0), branch1(k).bend(1))

       treecounts = treecounts + 1
     Else
       linkbranch(lbcounts) = k
       lbcounts = lbcounts + 1
    End If
 Next k
'''================ the next to make the node_tree mat to change the branchvolt into nodevolt

End Sub

Public Function find(value As Integer) As Boolean
Dim k As Integer

For k = 0 To n - 1
  If ND(k) = value Then
    find = True
    Exit Function
  End If
Next k
  
  find = False
  End Function
Public Sub instead(value1 As Integer, value2 As Integer)
  Dim k As Integer
  
  For k = 0 To n - 1
    If ND(k) = value1 Then
      ND(k) = value2
    End If
  Next k
  
End Sub

Public Function makeA()
 errortype = 3
 ReDim a(n - 2, b - 1) As Integer
Dim k, m As Integer
 
 For k = 0 To n - 2
   For m = 0 To b - 1
     If branch1(m).bend(0) = k Then
        a(k, m) = 1
     ElseIf branch1(m).bend(1) = k Then
        a(k, m) = -1
     Else: a(k, m) = 0
     End If
   Next m
 Next k
For k = 0 To n - 2
   For m = 0 To b - 1
   Next m
Next k
End Function
Public Function makeBC()
errortype = 4
Dim flag As Boolean
Dim k, m  As Integer
Dim tempc() As Integer
Dim cl() As Integer
Dim bt() As Integer
Dim at() As Integer
Dim al() As Integer
Dim atry() As Single
   ReDim bb(b - n, b - 1) As Integer
   ReDim c(n - 2, b - 1) As Integer
   
   ReDim bt(1 To b - n + 1, 1 To n - 1) As Integer
   
   ReDim cl(1 To n - 1, 1 To b - n + 1) As Integer
   ReDim tempc(1 To n - 1, 1 To b) As Integer
  
   ReDim al(1 To n - 1, 1 To b - n + 1) As Integer
   ReDim at(1 To n - 1, 1 To n - 1) As Integer
   
   For k = 0 To n - 2
      For m = 0 To b - 1
        If m <= n - 2 Then
           at(k + 1, m + 1) = a(k, tree(m))
        Else
           al(k + 1, m - n + 2) = a(k, linkbranch(m - n + 1))
        End If
       Next m
    Next k
flag = MRinv(n - 1, at)
  
Call MMul(n - 1, n - 1, b - n + 1, at, al, cl)
    
    
    For k = 1 To n - 1
      For m = 1 To b
         If m <= n - 1 And k = m Then
            tempc(k, m) = 1
          ElseIf m <= n - 1 And k <> n Then
            tempc(k, m) = 0
          Else
            tempc(k, m) = cl(k, m - n + 1)
        End If
       Next m
     Next k
    
For k = 1 To n - 1
   For m = 1 To b - n + 1
     cl(k, m) = -cl(k, m)
   Next m
Next k



Call MTrans(n - 1, b - n + 1, cl, bt)

For k = 0 To n - 2
   For m = 0 To b - 1
     c(k, m) = tempc(k + 1, m + 1)
   Next m
Next k

For k = 0 To b - n
   For m = 0 To b - 1
     If m <= n - 2 Then
       bb(k, m) = bt(k + 1, m + 1)
     ElseIf m - n + 1 = k Then
        bb(k, m) = 1
     Else
        bb(k, m) = 0
    End If
    Next m
Next k

ReDim atry(n - 2, b - 1) As Single
For k = 0 To n - 2
 For m = 0 To b - 1
  atry(k, m) = CSng(a(k, m))
 Next m
Next k
Call mapform.matshower(0, n - 1, b, atry, "A")

ReDim atry(b - n, b - 1) As Single
For k = 0 To b - n
 For m = 0 To b - 1
   atry(k, m) = CSng(bb(k, m))
 Next m
Next k
Call mapform.matshower(0, b - n + 1, b, atry, "B")

ReDim atry(n - 2, b - 1) As Single
For k = 0 To n - 2
 For m = 0 To b - 1
  atry(k, m) = CSng(a(k, m))
 Next m
Next k
Call mapform.matshower(0, n - 1, b, atry, "C")
circuitstate = 1  'to show that struct is right
End Function


Function checktype(k As Integer, kk As Integer) As Integer 'to check the mapform.cells in a branch and to sum their value
 errortype = 7
 Dim cellcon As Variant
  checktype = -1  'to make a mark if the mapform.cell is a current it will return the index or it will return -1
  resist = 0
  volt = 0
  lcresist = 0
  cvolt = 0
  For Each cellcon In branch1(k).cellcon
    Select Case mapform.cell(cellcon).celltype
     Case 0
       resist = resist + mapform.cell(cellcon).cellvalue
     Case 1
       If omig <> 0 Then
       lcresist = lcresist - 1 / (omig * mapform.cell(cellcon).cellvalue)
       End If
     Case 2
       If omig <> 0 Then
       lcresist = lcresist + omig * mapform.cell(cellcon).cellvalue
       End If
     Case 3
       If mapform.cell(branch1(k).cellcon(0)).celltag = 1 Then
         If nowfrequency(kk) <> sourcemat(mapform.cell(branch1(k).cellcon(0)).cellvalue).frequency Then
         Else
          If mapform.cell(cellcon).celln1 < mapform.cell(cellcon).celln2 Then
           volt = volt + sourcemat(mapform.cell(cellcon).cellvalue).a * Cos(sourcemat(mapform.cell(cellcon).cellvalue).alpha * pi / 180)
           cvolt = cvolt + sourcemat(mapform.cell(cellcon).cellvalue).a * Sin(sourcemat(mapform.cell(cellcon).cellvalue).alpha * pi / 180)
          Else
           volt = volt - sourcemat(mapform.cell(cellcon).cellvalue).a * Cos(sourcemat(mapform.cell(cellcon).cellvalue).alpha * pi / 180)
           cvolt = cvolt - sourcemat(mapform.cell(cellcon).cellvalue).a * Sin(sourcemat(mapform.cell(cellcon).cellvalue).alpha * pi / 180)
          End If
         End If
       ElseIf mapform.cell(branch1(k).cellcon(0)).celltag = 0 Then
         If nowfrequency(kk) = 0 Then
          volt = mapform.cell(k).cellvalue
         End If
       End If
       
     Case 4
      checktype = cellcon
     Case 6
     If kk + 1 <= multisignal.times Then
     If multisignal.stype = 1 Then
     volt = multisignal.volt * 4 / (pi * (2 * kk + 1)) * Cos(multisignal.arc * pi / 180)
     cvolt = multisignal.volt * 4 / (pi * (2 * kk + 1)) * Sin(multisignal.arc * pi / 180)
     ElseIf multisignal.stype = 2 Then
     volt = multisignal.volt * 8 / (pi * pi * (2 * kk + 1) ^ 2) * Cos((multisignal.arc + kk * 180) * pi / 180)
     cvolt = multisignal.volt * 8 / (pi * pi * (2 * kk + 1) ^ 2) * Sin((multisignal.arc + kk * 180) * pi / 180)
     Else
    volt = multisignal.volt * Cos(multisignal.arc * pi / 180)
     cvolt = multisignal.volt * Sin(multisignal.arc * pi / 180)
     End If
    End If
    End Select
   Next cellcon
errortype = 5
End Function
Public Sub wholeanalysis(atype As Integer)
On Error GoTo derror
Dim flag, k As Integer
If atype = 0 Then
   analysistype = 0
   mapform.analysisresult.Clear
   If mapform.Picture2.Tag > 1 Then