form1.frm

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

End If
ElseIf newfile = 0 And cell(0).Visible = False Then
Unload mapform
End If
End Sub

Private Sub helper_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Text1.Text = helper.LocationURL
End Sub

Private Sub HScroll1_Change()
Picture1.Left = -HScroll1.value
Picture1.SetFocus
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Drag
End Sub

p

Private Sub node_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
      oldx = X
      oldy = Y
      node(Index).Drag
'to add a function to check the nport to make sure that it is not 0
 ans = checknstate(Index)
 If ans = 0 Then
 nport = node(Index).nodestate + 1
 Else
 nport = ans
End If
'===============================================
If search(n, 1) = True Then
   Call linenc(0, Index, n, nport, 1)
 If node(Index).nodestate < 3 Then
 node(Index).nodestate = node(Index).nodestate + 1
End If
cell(n).celln1 = -Index * 10 - nport
Call makenodenn(Index, nport, n, 1)
cell(n).cellstate = 5
cell(n).isnew = 1

ElseIf search(n, 2) = True Then
   Call linenc(0, Index, n, nport, 2) 'be careful of this model of that marking
 cell(n).celln2 = -Index * 10 - nport
If node(Index).nodestate < 3 Then
 node(Index).nodestate = node(Index).nodestate + 1
End If
Call makenodenn(Index, nport, n, 2)
cell(n).cellstate = 6
cell(n).isnew = 1

End If

End Sub
Function checknstate(Index As Integer) As Integer
Dim k As Integer
checkstate = 0
For k = 1 To node(Index).nodestate + 1
  If readnnport(Index, k) = 0 Then
  checkstate = k
  Exit Function
  End If
Next k
End Function
Function readnnport(Index, nport As Integer) As Integer
 readnnport = -1
 Select Case nport
     Case 1
      readnnport = node(Index).noden1
     Case 2
      readnnport = node(Index).noden2
     Case 3
      readnnport = node(Index).noden3
     Case 4
      readnnport = node(Index).noden4
  End Select
End Function
Sub makenodenn(Index, nport, n, k As Integer)
Select Case nport
  Case 1
  node(Index).noden1 = n * 10 + k
  Case 2
    node(Index).noden2 = n * 10 + k
  Case 3
   node(Index).noden3 = n * 10 + k
Case 4
   node(Index).noden1 = n * 10 + k
End Select
End Sub

Public Sub open_Click()
On Error GoTo errordo
Picture1.Tag = -1
If newfile = 1 Then
' to clear the existing file infos
ans = MsgBox("原文件要保存吗？点击是保存!", 3 + 32 + 256, "提醒您！")
If ans = 6 Then
Call save_Click
MsgBox ""   '在是否这里有一点小问题
GoTo markx

ElseIf ans = 7 Then

GoTo markx

Else
Exit Sub
End If
markx::
If counts > 0 Then
For n = 1 To counts - 1
Unload cell(nn)
Next n
cell(0).Visible = False
End If
If nodecounts > 0 Then
For n = 1 To nodecounts - 1
Unload node(nn)
Next n
node(0).Visible = False
End If
Picture1.Cls
newfile = 0
End If
CommonDialog1.ShowOpen
Open CommonDialog1.FileName For Input As 1
mapform.Caption = "PCAS--->" + CommonDialog1.FileName
newfile = 1

Input #1, typecount(0), typecount(1), typecount(2), typecount(3), typecount(4), typecount(5)
 Input #1, counts, sourcecount
ReDim sourcemat(sourcecount - 1) As electruct
ReDim cellname(counts - 1) As String
'###########################

For nn = 0 To counts - 1
  
  If nn > 0 Then
   Load cell(nn)
  End If
  
  cell(nn).ToolTipText = nn
   cell(nn).Visible = True
   Input #1, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27
   cell(nn).Left = t1
   cell(nn).Top = t2
   cell(nn).n1tag = t3
   cell(nn).n2tag = t4
   cell(nn).main1 = t5
   cell(nn).main2 = t6
   cell(nn).isnew = t7
   cell(nn).n1x = t8
   cell(nn).n1y = t9
   cell(nn).n2x = t10
   cell(nn).n2y = t11
   cell(nn).mytag = t12
   cell(nn).cellvalue = t13
   cell(nn).cellinbranch = t14
   cell(nn).celln1 = t15
   cell(nn).celln2 = t16
   cell(nn).cellinhole1 = t17
   cell(nn).cellinhole2 = t18
   cell(nn).celltag = t19
   cell(nn).n1volt = t20
   cell(nn).n2volt = t21
   cell(nn).cellcurrent = t22
   cell(nn).cellarc = t23
   cell(nn).cellstate = t24
   cell(nn).cellindex = t25
   cell(nn).celltype = t26
   cell(nn).Tag = t27
  
  If t19 = 1 And (t26 = 3 Or t26 = 4) Then
  Input #1, t28, t29, t30
  sourcemat(cell(nn).cellvalue).a = t28
  sourcemat(cell(nn).cellvalue).alpha = t29
  sourcemat(cell(nn).cellvalue).frequency = t30
  End If
   Call cell(nn).incall
Call addlist(nn, CInt(t26))
Next nn
'###########################
Input #1, nodecounts
'###########################
For nn = 0 To nodecounts - 1
 If nn > 0 Then
 Load node(nn)
 End If
 node(nn).Visible = True
 
 Input #1, t1, t2, t3, t4, t5, t6, t7, t8
 node(nn).Left = t1
 node(nn).Top = t2
 node(nn).nodestate = t3
 node(nn).noden1 = t4
 node(nn).noden2 = t5
 node(nn).noden3 = t6
 node(nn).noden4 = t7
 node(nn).isnew = t8
Next nn
'###########################
Close 1
Call redrawmap
errordo::
End Sub
Sub redrawmap()
For n = 0 To counts - 1
If cell(n).celln1 > 0 Then
  If cell(n).main1 = 1 Then
   Call lineab(1, n, Fix(cell(n).celln1 / 10), 1, cell(n).celln1 Mod 10)
 End If
ElseIf cell(n).celln1 < 0 Then
  Call linenc(1, Fix(-cell(n).celln1 / 10), n, (-cell(n).celln1) Mod 10, 1)
 End If
 
If cell(n).celln2 > 0 Then
   If cell(n).main2 = 1 Then
   Call lineab(0, n, Fix(cell(n).celln2 / 10), 2, cell(n).celln2 Mod 10)
 End If
ElseIf cell(n).celln2 < 0 Then
  Call linenc(1, Fix(-cell(n).celln2 / 10), n, (-cell(n).celln2) Mod 10, 2)
 End If
Next n

End Sub
Private Sub Picture1_DblClick()

Call drawnet


End Sub

Private Sub drawnet()

For I = 0 To Picture1.Height Step 300

For j = 0 To Picture1.Width Step 400
Picture1.PSet (j, I), vbWhite
Next j
Next I
End Sub



Private Sub displaycell(Index As Integer)
If formstate = 1 Then
Load properform
properform.Show
properform.Top = 6045
properform.Left = 20 + currentform.Width
formstate = 0
End If

Select Case cell(Index).celltype
 Case 0
   properform.Label1.Caption = "电阻"
   properform.Label4.Caption = "|     电阻值"
   properform.Label5.Caption = "Ω"
  Case 1
   properform.Label1.Caption = "电容"
   properform.Label4.Caption = "|     电容值"
   properform.Label5.Caption = "F"
  Case 2
  properform.Label1.Caption = "电感"
   properform.Label4.Caption = "|     电感值"
   properform.Label5.Caption = "H"
  Case 3
  properform.Label1.Caption = "电压源"
   properform.Label4.Caption = "|     电压值"
   properform.Label5.Caption = "V"
  Case 4
  properform.Label1.Caption = "电流源"
   properform.Label4.Caption = "|     电流值"
   properform.Label5.Caption = "A"
  Case 5
  properform.Label1.Caption = "节点"
 properform.Label4.Caption = ""
   properform.Label5.Caption = ""
Case Else
  MsgBox ("not this cell")
End Select
properform.Label3.Caption = cell(Index).cellindex
properform.Text1.Text = cell(Index).cellvalue
properform.Label7.Caption = cell(Index).cellinhole1
properform.Label8.Caption = cell(Index).cellinhole2
properform.Label9.Caption = cell(Index).cellinbranch
'properform.Image1.Picture = LoadPicture(bmps(cell(Index).cellarc, cell(Index).celltype))
If cell(Index).cellarc = 1 Then
 properform.Option2.SetFocus
Else: properform.Option1.SetFocus
End If
properform.Tag = Index
mapform.SetFocus

If frmoptions.Visible = True Then
  frmoptions.Combo1.ListIndex = Index
  Call frmoptions.Combo1_Click
End If
End Sub

Private Sub Picture1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Source.Move (X - oldx), (Y - oldy)
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
  PopupMenu 电路
ElseIf Button = 1 And mmovestate = 1 Then
Call addnode
node(nodecounts - 1).Left = X - 15
node(nodecounts - 1).Top = Y - 15
Shape1.Visible = False
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim n As Integer
If Picture1.Tag <> -1 Then
 If cell(Picture1.Tag).mytag <> 0 Then
Call cell(Picture1.Tag).incall
cell(Picture1.Tag).mytag = 0
End If

If search(n, 1) = True Then
 Call lineabx(n, 1, CInt(X), CInt(Y))  'draw the inner state line



ElseIf search(n, 2) = True Then
 Call lineabx(n, 2, CInt(X), CInt(Y))


End If



End If

End Sub

Public Sub save_Click()
On Error GoTo errordo
If newfile = 0 Then
CommonDialog1.DialogTitle = "保存"
CommonDialog1.ShowSave
End If
mapform.Caption = "PCAS--->" + CommonDialog1.FileName
Open CommonDialog1.FileName For Output As 1
newfile = 1
Print #1, typecount(0), typecount(1), typecount(2), typecount(3), typecount(4), typecount(5)
Print #1, counts, sourcecount
'###########################
For nn = 0 To counts - 1
   Print #1, cell(nn).Left, cell(nn).Top, cell(nn).n1tag, cell(nn).n2tag, cell(nn).main1, cell(nn).main2, cell(nn).isnew, cell(nn).n1x, cell(nn).n1y, cell(nn).n2x, cell(nn).n2y, cell(nn).mytag, cell(nn).cellvalue, cell(nn).cellinbranch, cell(nn).celln1, cell(nn).celln2, cell(nn).cellinhole1, cell(nn).cellinhole2, cell(nn).celltag, cell(nn).n1volt, cell(nn).n2volt, cell(nn).cellcurrent, cell(nn).cellarc, cell(nn).cellstate, cell(nn).cellindex, cell(nn).celltype, cell(nn).Tag
 
 If cell(nn).celltag = 1 And (cell(nn).celltype = 3 Or cell(nn).celltype = 4) Then
   Print #1, sourcemat(cell(nn).cellvalue).a, sourcemat(cell(nn).cellvalue).alpha, sourcemat(cell(nn).cellvalue).frequency
 End If
 
 Next nn
'###########################
Print #1, nodecounts
'###########################
For nn = 0 To nodecounts - 1
Print #1, node(nn).Left, node(nn).Top, node(nn).nodestate, node(nn).noden1, node(nn).noden2, node(nn).noden3, node(nn).noden4, node(nn).isnew
Next nn
'###########################
Close 1
errordo::
End Sub

Public Sub saveas_Click()
On Error GoTo errordo
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As 1
mapform.Caption = "PCAS--->" + CommonDialog1.FileName
Print #1, typecount(0), typecount(1), typecount(2), typecount(3), typecount(4), typecount(5)
Print #1, counts, sourcecount
'###########################
For nn = 0 To counts - 1
   Print #1, cell(nn).Left, cell(nn).Top, cell(nn).n1tag, cell(nn).n2tag, cell(nn).main1, cell(nn).main2, cell(nn).isnew, cell(nn).n1x, cell(nn).n1y, cell(nn).n2x, cell(nn).n2y, cell(nn).mytag, cell(nn).cellvalue, cell(nn).cellinbranch, cell(nn).celln1, cell(nn).celln2, cell(nn).cellinhole1, cell(nn).cellinhole2, cell(nn).celltag, cell(nn).n1volt, cell(nn).n2volt, cell(nn).cellcurrent, cell(nn).cellarc, cell(nn).cellstate, cell(nn).cellindex, cell(nn).celltype, cell(nn).Tag
  
  If cell(nn).celltag = 1 And (cell(nn).celltype = 3 Or cell(nn).celltype = 4) Then
   Print #1, sourcemat(cell(nn).cellvalue).a, sourcemat(cell(nn).cellvalue).alpha, sourcemat(cell(nn).cellvalue).frequency
 End If
 
 Next nn
'###########################
Print #1, nodecounts
'###########################
For nn = 0 To nodecounts - 1
Print #1, node(nn).Left, node(nn).Top, node(nn).nodestate, node(nn).noden1, node(nn).noden2, node(nn).noden3, node(nn).noden4, node(nn).isnew
Next nn
'###########################
Close 1
errordo::
End Sub

Private Sub VScroll1_Change()
Picture1.Top = -VScroll1.value
Picture1.SetFocus
End Sub

Private Sub VScroll2_Change()
Picture2.Top = -VScroll2.value
Picture2.SetFocus
End Sub

Private Sub VScroll2_Scroll()
Picture2.Top = -VScroll2.value
Picture2.SetFocus
End Sub

Private Sub 删除元件_Click()
'删除元件时，要做到去元件，清连接，清记录，重新定义它
Call deletecell
End Sub
Sub deletecell()
If Picture1.Tag <> 0 Then
Call copypenline(Picture1.Tag)
If Picture1.Tag < counts - 1 And Picture1.Tag <> -1 Then
 For nn = Picture1.Tag To counts - 2
    Call changecell(n, n + 1)
 Next nn
  Call checklinks(counts - 1)
   Unload cell(counts - 1)
   counts = counts - 1
Else
  Call checklinks(counts - 1)
 Picture1.Tag = -1
 Unload cell(counts - 1)
 counts = counts - 1
End If
End If

End Sub
Private Sub checklinks(Index As Integer)
 index1 = Fix(cell(Index).celln1 / 10)
 index2 = Fix(cell(Index).celln2 / 10)
 
 If cell(Index).isnew = 1 Then
'==============================================================
If cell(Index).celln1 < 0 Then
   m = Fix(-cell(Index).celln1 / 10)
   nn = -cell(Index).celln1 Mod 10
   Select Case nn
     Case 1
     node(m).noden1 = 0
     Case 2
     node(m).noden2 = 0
     Case 3
     node(m).noden3 = 0