form1.frm

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

   End
   Begin VB.Menu view 
      Caption         =   "查看"
      WindowList      =   -1  'True
      Begin VB.Menu cf 
         Caption         =   "电流表"
      End
      Begin VB.Menu vf 
         Caption         =   "电压表"
      End
      Begin VB.Menu oc 
         Caption         =   "示波器"
      End
      Begin VB.Menu bd 
         Caption         =   "波特仪"
      End
      Begin VB.Menu 打印结果 
         Caption         =   "打印结果"
      End
      Begin VB.Menu sgn 
         Caption         =   "信号发生器"
      End
      Begin VB.Menu sdd 
         Caption         =   "自定义绘图仪"
      End
   End
   Begin VB.Menu analysis 
      Caption         =   "电路分析"
      Begin VB.Menu 普通分析 
         Caption         =   "普通分析"
      End
      Begin VB.Menu 电路示波 
         Caption         =   "电路示波"
      End
      Begin VB.Menu 波特分析 
         Caption         =   "波特分析"
      End
      Begin VB.Menu 自定义分析 
         Caption         =   "自定义分析"
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助"
      Begin VB.Menu userguide 
         Caption         =   "使用说明"
      End
      Begin VB.Menu contactme 
         Caption         =   "与我联系"
      End
      Begin VB.Menu about 
         Caption         =   "关于"
      End
   End
   Begin VB.Menu 节点 
      Caption         =   "节点"
      Visible         =   0   'False
      Begin VB.Menu 添加到 
         Caption         =   "添加到"
         Begin VB.Menu nodeto示波器 
            Caption         =   "示波器"
            Begin VB.Menu A通道 
               Caption         =   "A通道"
            End
            Begin VB.Menu B通道 
               Caption         =   "B通道"
            End
            Begin VB.Menu A通道共地端 
               Caption         =   "A通道共地端"
            End
            Begin VB.Menu B通道共地端 
               Caption         =   "B通道共地端"
            End
         End
         Begin VB.Menu nodeto波特仪 
            Caption         =   "波特仪"
            Begin VB.Menu 测量端 
               Caption         =   "测量端"
            End
            Begin VB.Menu 共地端 
               Caption         =   "共地端"
            End
         End
         Begin VB.Menu nodeto自定义绘图仪 
            Caption         =   "自定义绘图仪"
            Begin VB.Menu self测量端 
               Caption         =   "测量端"
            End
            Begin VB.Menu self共地端 
               Caption         =   "共地端"
            End
         End
      End
      Begin VB.Menu 设为零电势点 
         Caption         =   "设为零电势点"
      End
   End
End
Attribute VB_Name = "mapform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Const WM_NCLBUTTONDBLCLK = &HA3
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Const MF_STRING = &H0&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060
Private hMenu As Long
Private CloseStr As String '纪录Close MenuItem的字符串Option Explicit
Const ra = 25
Dim urlcounts As Integer
Dim tempn, tempx, tempy, mmovestate As Integer
Dim oldx, oldy As Single





'  there is a bug that i decide the cellstate is 5 or 6 there will be somethig no good in it !
'////////////////////////////////////////////////////////////////////////////////
'[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[

Private Sub cell_Change(index As Integer)
Call displaycellinfo
End Sub



Sub addcell(index As Integer)

typecount(index) = typecount(index) + 1
If counts = 0 Then
   ReDim cellname(0) As String
   cell(0).Visible = True
   cell(0).celltype = index
   cell(0).cellindex = typecount(index)
   Call addlist(0, index)
Else
   Load cell(counts)
    ReDim Preserve cellname(counts) As String
    cell(counts).Visible = True
  cell(counts).left = Rnd * 5000
   cell(counts).isnew = 0
   cell(counts).Top = Rnd * 5000
  cell(counts).celltype = index
   cell(counts).ToolTipText = counts
   cell(counts).cellindex = typecount(index)
  cell(counts).cellvalue = 1
  cell(counts).celltag = 0
  cell(counts).celln1 = 0
  cell(counts).celln2 = 0
  Call addlist(counts, index)
End If
counts = counts + 1
End Sub
Sub addlist(index, cltype As Integer)
Select Case cltype
  Case 0
  ccc = "电阻"
  Case 1
  ccc = "电容"
  Case 2
  ccc = "电感"
  Case 3
  ccc = "电压源"
  Case 4
 ccc = "电流源"
  Case 5
  cell(index).celltag = 1
  ccc = "受控源"
  Case 6
  ccc = "信号发生器"
End Select
cellname(index) = ccc + Str(index)
frmoptions.Combo1.AddItem ccc + "(" + Str(index) + ")", index
frmoptions.Combo2.AddItem ccc + "(" + Str(index) + ")", index
End Sub


Sub addnode()
If nodecounts = 0 Then
    node(0).Visible = True
    node(0).Height = 60
    node(0).Width = 60
    node(0).nodestate = 0
Else
Load node(nodecounts)
 node(nodecounts).left = Rnd * 1000
   node(nodecounts).Top = Rnd * 1000
node(nodecounts).Visible = True
node(nodecounts).Height = 60
    node(nodecounts).Width = 60
   node(nodecounts).nodestate = 0
  node(nodecounts).ToolTipText = nodecounts
End If
nodecounts = nodecounts + 1
End Sub



Private Sub about_Click()
aboutform.Show (1)
End Sub



Private Sub addcells_Click()
addcellform.Show (1)
End Sub


Private Sub anshow_Click()
Select Case anshow.SelectedItem.index
Case 1
  Frame(2).Visible = True
  Frame(1).Visible = False
  Frame(0).Visible = False
Case 2
  Frame(1).Visible = True
  Frame(2).Visible = False
  Frame(0).Visible = False
Case 3
  Frame(0).Visible = True
  Frame(1).Visible = False
  Frame(2).Visible = False

End Select

End Sub


Private Sub A通道_Click()
waveviewer.a1.Text = 节点.Tag
Call waveviewer.a1_Change
End Sub

Private Sub A通道共地端_Click()
waveviewer.a0.Text = 节点.Tag
Call waveviewer.a0_Change
End Sub



Private Sub bd_Click()
bodeplotter.Show
End Sub

Private Sub B通道_Click()
waveviewer.b1.Text = 节点.Tag
Call waveviewer.b1_Change
End Sub

Private Sub B通道共地端_Click()
waveviewer.b0.Text = 节点.Tag
Call waveviewer.b0_Change
End Sub

Private Sub cancel_Click()
cell(cancel.Tag).cellstate = 0
cancel.Enabled = False
Call clearmap_Click
End Sub

Private Sub cell_DblClick(index As Integer)
If cell(index).celltype = 6 Then
signalsource.Show
Else
frmoptions.Show
frmoptions.Combo1.ListIndex = index
Call frmoptions.Combo1_Click
End If
End Sub

Private Sub cell_DragDrop(index As Integer, Source As Control, X As Single, Y As Single)
Call copypenline(index)
End Sub



Private Sub cell_GotFocus(index As Integer)
main.StatusBar1.Panels(4).Text = "元件：" + Str(index)
Picture1.Tag = index
 cell(index).ForeColor = vbBlue
 Call cell(index).incall
If currentform.Check1.value = 1 Then
   Call currentform.settext(cell(index).cellcurrent)
 End If
End Sub


Private Sub cell_LostFocus(index As Integer)
 cell(index).ForeColor = vbBlack
 Call cell(index).incall
End Sub

Private Sub cf_Click()
currentform.Show
End Sub

Public Sub clearmap_Click()
Picture1.Cls
Call redrawmap
End Sub

Private Sub Command_Click(index As Integer)
On Error GoTo marks
Select Case index
Case 0
  helper.GoBack
  urlcounts = urlcounts - 1
Case 1
  helper.GoForward
urlcounts = urlcounts + 1
Case 2
 helper.Navigate fpath + "\help\contents.htm"
 urlcounts = 1
End Select
marks::
End Sub



Private Sub contactme_Click()
MsgBox "Please Email To:[e-mail]"
End Sub


Private Sub Form_Load()
counts = 0

'--------------------------------------------------------
Dim hMenu As Long
    hMenu = GetSystemMenu(Me.hwnd, 0)
CloseStr = String(255, 0)
'SC_CLOSE即是"关闭"的MenuItem ID
Call GetMenuString(hMenu, SC_CLOSE, CloseStr, 256, MF_BYCOMMAND)
CloseStr = left(CloseStr, InStr(1, CloseStr, Chr(0)) - 1)
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
'将"关闭"的那个MenuItem重新加入
Call AppendMenu(hMenu, MF_STRING, SC_CLOSE, CloseStr)
'令"X"出现Enable的颜色
Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
 '-------------------------------------------------------
 fpath = App.Path
CommonDialog1.InitDir = App.Path + "\pcas"
  anshow.left = main.Width - anshow.Width
  For k = 0 To 2
  Frame(k).Top = 360
  Frame(k).left = anshow.left + 20
  Frame(k).Width = anshow.Width - 100
  Frame(k).Height = anshow.Height + 1800
  Next k
  
  helper.Top = 700
  helper.left = 50
  helper.Width = anshow.Width - 200
  helper.Height = anshow.Height - 250
  Text1.Top = 400
  Text1.left = 50
  Text1.Width = anshow.Width - 200
  
  
  analysisresult.Top = 150
  analysisresult.left = 50
  analysisresult.Width = anshow.Width - 200
  analysisresult.Height = anshow.Height - 250

  container2.Top = 150
  container2.left = 50
  container2.Width = anshow.Width - 450
  container2.Height = anshow.Height - 250
  
  Picture2.Top = 0
  Picture2.left = 0
  Picture2.Width = container2.Width
  Picture2.Height = 10000
  
   
  VScroll2.Top = 150
  VScroll2.left = 50 + Picture2.Width
  VScroll2.Width = 250
  VScroll2.Height = anshow.Height - 250
  
  matrixname(0).Top = 0
  matrixname(0).left = 0
  matrixname(0).Width = Picture2.Width
  
  matshow(0).Top = matrixname(0).Height
  matshow(0).left = 0
  matshow(0).Width = Picture2.Width
  
  
  Frame(1).Visible = False
  Frame(0).Visible = False

helper.Navigate fpath + "\help\contents.htm"
urlcounts = 1
End Sub
Private Sub cell_Mousemove(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Tag = index
End Sub
Private Sub cell_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
''$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
''$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Dim n As Integer
container.Tag = index
If Button = 1 Then

  
   Select Case cell(index).mytag
      Case 1
       If search(n, 1) = True Then
         If cell(index).celln1 Mod 10 = 0 Then
           Call addnode
           node(nodecounts - 1).left = findx(cell(index).left + cell(index).n1x, cell(n).left + cell(n).n1x)
           node(nodecounts - 1).Top = findy(cell(index).Top + cell(index).n1y, cell(n).Top + cell(n).n1y)
           Call linenc(1, nodecounts - 1, index, 1, 1)
           Call linenc(0, nodecounts - 1, n, 2, 1)
           cell(index).celln1 = 10 * (nodecounts - 1) + 1
           cell(n).celln1 = 10 * (nodecounts - 1) + 2
           node(nodecounts - 1).noden1 = index * 10 + 1
           node(nodecounts - 1).noden2 = n * 10 + 1
           node(nodecounts - 1).nodestate = 2
           cell(n).cellstate = 5
         End If
        ElseIf search(n, 2) = True Then
          If cell(index).celln2 Mod 10 = 0 Then
           Call addnode
           node(nodecounts - 1).left = findx(cell(index).left + cell(index).n1x, cell(n).left + cell(n).n2x)
           node(nodecounts - 1).Top = findy(cell(index).Top + cell(index).n1y, cell(n).Top + cell(n).n2y)
           Call linenc(1, nodecounts - 1, index, 1, 1)
           Call linenc(0, nodecounts - 1, n, 2, 2)
           cell(index).celln1 = 10 * (nodecounts - 1) + 1
           cell(n).celln2 = 10 * (nodecounts - 1) + 2
           node(nodecounts - 1).noden1 = index * 10 + 1
           node(nodecounts - 1).noden2 = n * 10 + 2
           node(nodecounts - 1).nodestate = 2
           cell(n).cellstate = 6
          End If
        Else
          cell(index).cellstate = 1
          cancel.Enabled = True
          cancel.Tag = 1
        End If
      Case 2
       If search(n, 1) = True Then
         If cell(index).celln2 Mod 10 = 0 Then
           Call addnode
           node(nodecounts - 1).left = findx(cell(index).left + cell(index).n2x, cell(n).left + cell(n).n1x)
           node(nodecounts - 1).Top = findy(cell(index).Top + cell(index).n2y, cell(n).Top + cell(n).n1y)
           Call linenc(1, nodecounts - 1, index, 1, 2)
           Call linenc(0, nodecounts - 1, n, 2, 1)
           cell(index).celln2 = 10 * (nodecounts - 1) + 1
           cell(n).celln1 = 10 * (nodecounts - 1) + 2
           node(nodecounts - 1).noden1 = index * 10 + 2
           node(nodecounts - 1).noden2 = n * 10 + 1
           node(nodecounts - 1).nodestate = 2
           cell(n).cellstate = 5
         End If
        ElseIf search(n, 2) = True Then
          If cell(index).celln2 Mod 10 = 0 Then
           Call addnode
           node(nodecounts - 1).left = findx(cell(index).left + cell(index).n2x, cell(n).left + cell(n).n2x)
           node(nodecounts - 1).Top = findy(cell(index).Top + cell(index).n2y, cell(n).Top + cell(n).n2y)
           Call linenc(1, nodecounts - 1, index, 1, 2)
           Call linenc(0, nodecounts - 1, n, 2, 2)
           cell(index).celln2 = 10 * (nodecounts - 1) + 1
           cell(n).celln2 = 10 * (nodecounts - 1) + 2
           node(nodecounts - 1).noden1 = index * 10 + 2
           node(nodecounts - 1).noden2 = n * 10 + 2
           node(nodecounts - 1).nodestate = 2