form1.frm

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

           cell(n).cellstate = 6
          End If
       Else
         cell(index).cellstate = 2
        cancel.Enabled = True
          cancel.Tag = 2
       End If
   Case 0
    oldx = X
    oldy = Y
    Call copypenline(index)
    cell(index).Drag
   End Select

 Call displaycell(index)
Else
 元件.Tag = index
 PopupMenu 元件
End If
''$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
''$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End Sub
Function findx(X1, X2 As Single) As Single
findx = Fix((X2 + X2) / 2)

End Function
Function findy(Y1, Y2 As Single) As Single
 findy = Fix((Y1 + Y2) / 2)
End Function

Private Sub Form_Resize()
container.left = 0
If mapform.Height > 650 Then
container.Height = mapform.Height - 750
Else
container.Height = anshow.Height - 320
End If
container.Top = 0
 anshow.Height = container.Height + 300
container.Width = anshow.left - 300

Picture1.left = 0
Picture1.Top = 0

VScroll1.Top = 0
VScroll1.left = container.Width
VScroll1.Width = 300
VScroll1.Height = container.Height + 250

HScroll1.Top = container.Height
HScroll1.left = 0
HScroll1.Width = container.Width
VScroll1.Max = Picture1.Height - container.Height
HScroll1.Max = Picture1.Width - container.Width

End Sub

Private Sub Form_Unload(cancel As Integer)
If newfile = 0 And mapform.cell(0).Visible = True Then
ans = MsgBox("文件还没有保存，要离开吗？", 4 + 32 + 256, "提醒您！")
If ans = 6 Then
cancel = 0
Else
cancel = 1 ' this is to save it
End If
ElseIf newfile = 1 And mapform.cell(0).Visible = True Then
ans = MsgBox("确认文件最近更新了吗？点击否更新!", 3 + 32 + 256, "提醒您！")
If ans = 6 Then
cancel = 0
ElseIf ans = 7 Then
Call mapform.save_Click
Else
cancel = 1
End If
ElseIf newfile = 0 And mapform.cell(0).Visible = False Then
cancel = 0
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




Public Sub new_Click()
Dim k As Integer
On Error GoTo marks
CommonDialog1.ShowOpen
Open CommonDialog1.FileName For Random As 1
mapform.Caption = CommonDialog1.FileName
counts = 0
nodecounts = 0
For k = 0 To 6
typecount(k) = 0
Next k
Close #1
marks::
End Sub

Private Sub node_DragDrop(index As Integer, Source As Control, X As Single, Y As Single)
Call redrawnode(index)
End Sub

Private Sub node_GotFocus(index As Integer)
main.StatusBar1.Panels(4).Text = "节点：" + Str(index)
If voltform.Check1.value = 1 Then
  Call voltform.settext(CSng(node(index).Tag))
End If
End Sub

Private Sub node_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'to add a function to check the nport to make sure that it is not 0
Dim n As Integer
If Button = 1 Then

'===============================================
 nport = node(index).nodestate + 1
If search(n, 1) = True Then
 If nport <= 4 Then
   Call linenc(0, index, n, nport, 1)
   cell(n).celln1 = index * 10 + nport
   Call makenodenn(index, nport, n, 1)
   cell(n).cellstate = 5
   cell(n).isnew = 1
 node(index).nodestate = node(index).nodestate + 1
 Else
   MsgBox "无法实现！每个节点只能连接4个支路！"
   Exit Sub
 End If
ElseIf search(n, 2) = True Then
  If nport <= 4 Then
   Call linenc(0, index, n, nport, 2) 'be careful of this model of that marking
   cell(n).celln2 = index * 10 + nport
   Call makenodenn(index, nport, n, 2)
   cell(n).cellstate = 6
   cell(n).isnew = 1
 node(index).nodestate = node(index).nodestate + 1
  Else
    MsgBox "无法实现！每个节点只能连接4个支路！"
    Exit Sub
  End If
 Else
    Call redrawnode(index)
      oldx = X
      oldy = Y
      node(index).Drag
 End If
Else
 '''''$$$$$$$$$$$$$$$$$$$$$$$$''''''''''''''''''''''''
 节点.Tag = index
 PopupMenu 节点
End If
End Sub

Sub redrawnode(index As Integer)
Dim temp1, temp2 As Integer
For k = 0 To node(index).nodestate - 1
  Select Case k
  Case 0
    Call linenc(1, index, Fix(node(index).noden1 / 10), 1, node(index).noden1 Mod 10)
  Case 1
    Call linenc(1, index, Fix(node(index).noden2 / 10), 2, node(index).noden2 Mod 10)
  Case 2
    Call linenc(1, index, Fix(node(index).noden3 / 10), 3, node(index).noden3 Mod 10)
  Case 3
    Call linenc(1, index, Fix(node(index).noden4 / 10), 4, node(index).noden4 Mod 10)
  End Select
Next k
End Sub


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


Private Sub oc_Click()
waveviewer.Show
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 ""   '在是否这里有一点小问题
'================================
'here we should make some improvement


GoTo markx

ElseIf ans = 7 Then

GoTo markx

Else
Exit Sub
End If
End If
markx::
If counts > 0 Then
For nn = 1 To counts - 1
Unload cell(nn)
Next nn
cell(0).Visible = False
End If
If nodecounts > 0 Then
For nn = 1 To nodecounts - 1
Unload node(nn)
Next nn
node(0).Visible = False
End If
Picture1.Cls
newfile = 0

CommonDialog1.ShowOpen

Open CommonDialog1.FileName For Input As 1

mapform.Caption = "PCAS--->" + CommonDialog1.FileName
newfile = 1

On Error GoTo errordo2
Input #1, typecount(0), typecount(1), typecount(2), typecount(3), typecount(4), typecount(5), typecount(6)
 Input #1, counts, sourcecount
If sourcecount > 0 Then
ReDim sourcemat(sourcecount - 1) As electruct
End If
If counts > 0 Then
ReDim cellname(counts - 1) As String
End If
'###########################
main.tbToolBar.Buttons(25).Enabled = True
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
  ElseIf t26 = 6 Then
  Input #1, t28, t29, t30, t31, t32
  main.tbToolBar.Buttons(25).Enabled = False
  multisignal.arc = t28
  multisignal.frequency = t29
  multisignal.volt = t32
  Call signalsource.Command1_Click(CInt(t30))
  signalsource.Text1.Text = t29
  signalsource.Text2.Text = t32
  signalsource.Text3.Text = t28
  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
GoTo errordo2
errordo::
If CommonDialog1.FileName <> "" Then
Open CommonDialog1.FileName For Random As 1
mapform.Caption = CommonDialog1.FileName
Close #1
End If
errordo2::
End Sub
Sub redrawmap()
For n = 0 To counts - 1
Call copypenline(CInt(n))
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



Public Sub displaycell(index As Integer)
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), typecount(6)
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
 If cell(nn).celltype = 6 Then
  Print #1, multisignal.arc, multisignal.frequency, multisignal.stype, multisignal.times, multisignal.volt
 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), typecount(6)
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
  
  If cell(nn).celltype = 6 Then
  Print #1, multisignal.arc, multisignal.frequency, multisignal.stype, multisignal.times, multisignal.volt
 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 sdd_Click()
userplotter.Show
End Sub