form1.frm

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

   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)
   Call displaycell(0)
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 = 0
  cell(counts).celltag = 0
  Call addlist(counts, Index)
  Call displaycell(CInt(counts))
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 = "受控源"
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 * 5000
   node(nodecounts).Top = Rnd * 5000
node(nodecounts).Visible = True
node(nodecounts).Height = 60
    node(nodecounts).Width = 60
   node(nodecounts).nodestate = 0
End If
nodecounts = nodecounts + 1
End Sub

Private Sub ccc_Click()

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 cell_DblClick(Index As Integer)
frmoptions.Show
frmoptions.Combo1.ListIndex = Index
Call frmoptions.Combo1_Click
End Sub

Private Sub cell_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
   
  
  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
 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



Private Sub cell_GotFocus(Index As Integer)
 
 cell(Index).ForeColor = vbBlue
 Call cell(Index).incall
 If voltform.Check1.value = 1 Then
   voltform.Label1.Caption = cell(Index).n1volt - cell(Index).n2volt
 End If
If currentform.Check1.value = 1 Then
   currentform.Label1.Caption = CStr(cell(Index).cellcurrent)
 End If

End Sub


Private Sub cell_LostFocus(Index As Integer)
 cell(Index).ForeColor = vbBlack
 Call cell(Index).incall
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 "e:\程红太\vb-pcas\help\contents.htm"
 urlcounts = 1
End Select
marks::
End Sub

Private Sub Form_Load()
bmps(0, 0) = "E:\程红太\vb-pcas\pic\hr.bmp"
bmps(0, 1) = "E:\程红太\vb-pcas\pic\hc.bmp"
bmps(0, 2) = "E:\程红太\vb-pcas\pic\hl.bmp"
bmps(0, 3) = "E:\程红太\vb-pcas\pic\hv.bmp"
bmps(0, 4) = "E:\程红太\vb-pcas\pic\ha.bmp"
bmps(0, 5) = "E:\程红太\vb-pcas\pic\hn.bmp"
bmps(1, 0) = "E:\程红太\vb-pcas\pic\vr.bmp"
bmps(1, 1) = "E:\程红太\vb-pcas\pic\vc.bmp"
bmps(1, 2) = "E:\程红太\vb-pcas\pic\vl.bmp"
bmps(1, 3) = "E:\程红太\vb-pcas\pic\vv.bmp"
bmps(1, 4) = "E:\程红太\vb-pcas\pic\va.bmp"
bmps(1, 5) = "E:\程红太\vb-pcas\pic\vn.bmp"
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&)
 '-------------------------------------------------------
  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 - 550
  Next k
  
  helper.Top = 700
  helper.Left = 50
  helper.Width = anshow.Width - 200
  helper.Height = anshow.Height - 1300
  
  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 - 750

  container2.Top = 150
  container2.Left = 50
  container2.Width = anshow.Width - 450
  container2.Height = anshow.Height - 750
  
  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 - 750
  
  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 "e:\程红太\vb-pcas\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


  
  If cell(Index).mytag = 0 Then
    If Button = 1 Then
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

      oldx = X
      oldy = Y
      cell(Index).Drag
      Call displaycell(Index)
    Else
       元件.Tag = Index
       PopupMenu 元件
     End If
Else


Select Case cell(Index).mytag

 Case 1
   If search(n, 1) = True Then
  
   cell(Index).celln1 = n * 10 + 1
   cell(n).celln1 = Index * 10 + 1
   cell(Index).cellstate = 5  '有一种区别，0，1，2，3，4 说明连支路，5，6，7，8说明它已连过了。
   cell(n).cellstate = 5
   Call lineab(0, n, Index, 1, 1)
      cell(n).main1 = 1
    cell(Index).isnew = 1
 cell(n).isnew = 1

  
  ElseIf search(n, 2) = True Then
   cell(Index).celln1 = n * 10 + 2
   cell(n).celln2 = Index * 10 + 1
   cell(Index).cellstate = 5
   cell(n).cellstate = 6
    Call lineab(0, n, Index, 2, 1)
     cell(n).main2 = 1
   cell(Index).isnew = 1
     cell(n).isnew = 1
   Else
   cell(Index).cellstate = 1
 End If
 
 Case 2
   If search(n, 2) = True Then
   cell(Index).celln2 = n * 10 + 2
   cell(n).celln2 = Index * 10 + 2
   cell(Index).cellstate = 6
   cell(n).cellstate = 6
    Call lineab(0, n, Index, 2, 2)
     cell(n).main2 = 1
      cell(Index).isnew = 1
          cell(n).isnew = 1
   ElseIf search(n, 1) = True Then
    cell(Index).celln2 = n * 10 + 1
   cell(n).celln1 = Index * 10 + 2
   cell(Index).cellstate = 6
   cell(n).cellstate = 5
          cell(Index).isnew = 1
    Call lineab(0, n, Index, 1, 2)
  cell(n).main1 = 1
 cell(n).isnew = 1
Else
   cell(Index).cellstate = 2
 End If
End Select
End If
End Sub

Private Sub Form_Resize()
container.Left = 0
container.Height = mapform.Height - 650
container.Top = 0
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

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 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 Then
ans = MsgBox("确认文件最近更新了吗？点击否更新!", 3 + 32 + 256, "提醒您！")
If ans = 6 Then
cancel = 0
ElseIf ans = 7 Then
Call mapform.save_Click
Else
cancel = 1