frmoptions.frm

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

         Left            =   120
         TabIndex        =   10
         Top             =   240
         Width           =   735
      End
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      ItemData        =   "frmoptions.frx":0D9B
      Left            =   0
      List            =   "frmoptions.frx":0D9D
      TabIndex        =   2
      Text            =   "celllist"
      Top             =   0
      Width           =   1575
   End
   Begin VB.CommandButton cancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   3240
      TabIndex        =   1
      Top             =   3720
      Width           =   735
   End
   Begin VB.CommandButton decide 
      Caption         =   "确定"
      Height          =   375
      Left            =   2280
      TabIndex        =   0
      Top             =   3720
      Width           =   735
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Caption         =   "号"
      Height          =   255
      Left            =   3840
      TabIndex        =   6
      Top             =   0
      Width           =   375
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      Height          =   255
      Left            =   3360
      TabIndex        =   5
      Top             =   0
      Width           =   375
   End
   Begin VB.Label Label2 
      Height          =   255
      Left            =   2520
      TabIndex        =   4
      Top             =   0
      Width           =   735
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "类型"
      Height          =   255
      Left            =   1800
      TabIndex        =   3
      Top             =   0
      Width           =   615
   End
End
Attribute VB_Name = "frmoptions"
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
Private CloseStr As String '纪录Close MenuItem的字符串Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Dim retvalue As Long
Dim sci(4) As Double
Dim fsci(1) As Double
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 Sub ac_GotFocus(index As Integer)
Frame2(index).Visible = True
End Sub

Private Sub cancel_Click()
Me.Hide
End Sub

Sub cellsci_Change(index As Integer)
Select Case index
Case 0
 If cellsci(0).ListIndex = 0 Then
   sci(0) = 1
 ElseIf cellsci(0).ListIndex = 1 Then
   sci(0) = 1000
 Else
   sci(0) = 1000000
 End If
Case 1
 If cellsci(1).ListIndex = 0 Then
   sci(1) = 1
 ElseIf cellsci(0).ListIndex = 1 Then
   sci(1) = 0.000001
 Else
   sci(1) = 0.000000000001
 End If
Case 2
 If cellsci(2).ListIndex = 0 Then
   sci(2) = 1
 ElseIf cellsci(0).ListIndex = 1 Then
   sci(2) = 0.001
 Else
   sci(2) = 0.000001
 End If
Case 3
 If cellsci(3).ListIndex = 0 Then
   sci(3) = 1
 ElseIf cellsci(0).ListIndex = 1 Then
   sci(3) = 0.001
 Else
   sci(3) = 0.000001
 End If
Case 4
 If cellsci(4).ListIndex = 0 Then
   sci(4) = 1
 ElseIf cellsci(0).ListIndex = 1 Then
   sci(4) = 0.001
 Else
   sci(4) = 0.000001
 End If
End Select
End Sub

Private Sub cellsci_Click(index As Integer)
Call cellsci_Change(index)
End Sub

Public Sub Combo1_Click()
If mapform.cell(0).Visible = True And Combo1.ListIndex <> -1 Then
disp (mapform.cell(Combo1.ListIndex).celltype)
Select Case mapform.cell(Combo1.ListIndex).celltype
  Case 0
  Label2.Caption = "电阻"
  Case 1
  Label2.Caption = "电容"
  Case 2
  Label2.Caption = "电感"
  Case 3
  Label2.Caption = "电压源"
  Case 4
  Label2.Caption = "电流源"
  Case 5
  Label2.Caption = "受控源"
  Case 6
  Label2.Caption = "信号发生器"
End Select
Label3.Caption = mapform.cell(Combo1.ListIndex).cellindex
End If
End Sub




Private Sub cstype_GotFocus(index As Integer)
Select Case index
Case 0
  cslabel1.Caption = "电压="
  cslabel2.Caption = "支路的电压"
Case 1
  cslabel1.Caption = "电流="
  cslabel2.Caption = "支路的电压"
Case 2
  cslabel1.Caption = "电压="
  cslabel2.Caption = "支路的电流"
Case 3
  cslabel1.Caption = "电流="
  cslabel2.Caption = "支路的电流"
End Select
End Sub

Private Sub dc_GotFocus(index As Integer)
Frame2(index).Visible = False
End Sub

Private Sub decide_Click()
If Combo1.ListIndex >= 0 Then
If mapform.cell(Combo1.ListIndex).celltype = 3 Then
   
   If mapform.cell(Combo1.ListIndex).celltag = 0 And Frame2(0).Visible = True Then
     ReDim Preserve sourcemat(sourcecount) As electruct
     sourcemat(sourcecount).a = writevalue(CSng(cellvalue(3).Text), 3)
     sourcemat(sourcecount).alpha = CSng(arctext(0).Text)
     sourcemat(sourcecount).frequency = writevalue(CSng(frequency(0).Text), 5)
     mapform.cell(Combo1.ListIndex).cellvalue = sourcecount
     mapform.cell(Combo1.ListIndex).celltag = 1
     sourcecount = sourcecount + 1
   ElseIf mapform.cell(Combo1.ListIndex).celltag = 0 And Frame2(0).Visible = False Then
     mapform.cell(Combo1.ListIndex).cellvalue = writevalue(CSng(cellvalue(3).Text), 3)
   ElseIf mapform.cell(Combo1.ListIndex).celltag = 1 And Frame2(0).Visible = True Then
     sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).a = writevalue(CSng(cellvalue(3).Text), 3)
      sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).alpha = CSng(arctext(0).Text)
      sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).frequency = writevalue(CSng(frequency(0).Text), 5)
   ElseIf mapform.cell(Combo1.ListIndex).celltag = 2 Then
   Else
     mapform.cell(Combo1.ListIndex).cellvalue = writevalue(CSng(cellvalue(3).Text), 3)
     mapform.cell(Combo1.ListIndex).celltag = 0
   End If

ElseIf mapform.cell(Combo1.ListIndex).celltype = 4 Then
     
     If mapform.cell(Combo1.ListIndex).celltag = 0 And Frame2(1).Visible = True Then
     ReDim Preserve sourcemat(sourcecount) As electruct
     sourcemat(sourcecount).a = writevalue(CSng(cellvalue(4).Text), 4)
     sourcemat(sourcecount).alpha = CSng(arctext(1).Text)
     sourcemat(sourcecount).frequency = writevalue(CSng(frequency(1).Text), 6)
     mapform.cell(Combo1.ListIndex).cellvalue = sourcecount
     mapform.cell(Combo1.ListIndex).celltag = 1
     sourcecount = sourcecount + 1
   ElseIf mapform.cell(Combo1.ListIndex).celltag = 0 And Frame2(1).Visible = False Then
     mapform.cell(Combo1.ListIndex).cellvalue = writevalue(CSng(cellvalue(4).Text), 4)
   ElseIf mapform.cell(Combo1.ListIndex).celltag = 1 And Frame2(1).Visible = True Then
      sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).a = writevalue(CSng(cellvalue(4).Text), 4)
      sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).alpha = CSng(arctext(1).Text)
      sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).frequency = writevalue(CSng(frequency(1).Text), 6)
   Else
     mapform.cell(Combo1.ListIndex).cellvalue = writevalue(CSng(cellvalue(4).Text), 4)
     mapform.cell(Combo1.ListIndex).celltag = 0
   End If

ElseIf mapform.cell(Combo1.ListIndex).celltype = 5 Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For k = 0 To 3
If cstype(k).value = True Then
   mapform.cell(Combo1.ListIndex).celltag = k + 1
End If
Next k
mapform.cell(Combo1.ListIndex).cellvalue = CSng(cellvalue(5).Text)
mapform.cell(Combo1.ListIndex).Tag = Combo2.ListIndex
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,

ElseIf mapform.cell(Combo1.ListIndex).celltype = 6 Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,

Else
       mapform.cell(Combo1.ListIndex).cellvalue = writevalue(CSng(cellvalue(mapform.cell(Combo1.ListIndex).celltype).Text), mapform.cell(Combo1.ListIndex).celltype)
End If
End If
Me.Hide
For k = 0 To counts - 1
Call mapform.cell(k).incall
Next k

End Sub

Private Sub Form_Load()
retvalue = SetWindowPos(Me.hwnd, -1, Me.CurrentX, Me.CurrentY, 300, 300, &H40)
    '置中窗体
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
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&)
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
sci(0) = 1
sci(1) = 1000000
sci(2) = 1
sci(3) = 1
sci(4) = 1
fsci(0) = 1
fsci(1) = 1
Call disp(0)
End Sub
Sub disp(index As Integer)
If Combo1.ListIndex >= 0 Then
For n = 0 To 5
If n <> index Then
Frame1(n).Visible = False
Else
Frame1(n).Visible = True
Frame1(n).left = 120
Frame1(n).Top = 720
End If
Next n

If index = 3 Then
 If mapform.cell(Combo1.ListIndex).celltag = 1 Then
   Frame2(0).Visible = True
   ac(0).SetFocus
   frequency(0).Text = CStr(readvalue(sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).frequency, 5))
   arctext(0).Text = CStr(sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).alpha)
   cellvalue(3).Text = CStr(readvalue(sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).a, 3))
   Else
   dc(0).SetFocus
   Frame2(0).Visible = False
   cellvalue(3).Text = CStr(readvalue(mapform.cell(Combo1.ListIndex).cellvalue, 3))
 End If
ElseIf index = 4 Then
 If mapform.cell(Combo1.ListIndex).celltag = 1 Then
   Frame2(1).Visible = True
   ac(1).SetFocus
   frequency(1).Text = CStr(readvalue(sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).frequency, 6))
   arctext(1).Text = CStr(sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).alpha)
   cellvalue(4).Text = CStr(readvalue(sourcemat(mapform.cell(Combo1.ListIndex).cellvalue).a, 4))
   Else
   Frame2(1).Visible = False
   dc(1).SetFocus
   cellvalue(4).Text = CStr(readvalue(mapform.cell(Combo1.ListIndex).cellvalue, 4))
 End If
ElseIf index = 5 Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
cstype(mapform.cell(Combo1.ListIndex).celltag - 1).SetFocus
cellvalue(5).Text = mapform.cell(Combo1.ListIndex).cellvalue
Combo2.ListIndex = mapform.cell(Combo1.ListIndex).Tag
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,

ElseIf index = 6 Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
signalsource.Show
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Else
  cellvalue(index).Text = CStr(readvalue(mapform.cell(Combo1.ListIndex).cellvalue, index))
End If
End If
End Sub

Private Sub Form_Unload(cancel As Integer)
formstate = 1
End Sub
Function readvalue(values As Single, types As Integer) As Single
Select Case types
Case 0
  cellsci(0).Tag = values
  If values > 1000000 Then
    cellsci(0).ListIndex = 2
    Call cellsci_Change(0)
   readvalue = values / 1000000
  ElseIf values > 1000 Then
     cellsci(0).ListIndex = 1
    Call cellsci_Change(0)
   readvalue = values / 1000
  Else
     cellsci(0).ListIndex = 0
    Call cellsci_Change(0)
   readvalue = values
 End If
Case 1
   cellsci(1).Tag = values
  If values < 0.000001 Then
    cellsci(1).ListIndex = 2
    Call cellsci_Change(1)
   readvalue = values * 1000000000000#
  ElseIf values < 0.01 Then
     cellsci(1).ListIndex = 1
    Call cellsci_Change(1)
   readvalue = values * 1000000
  Else
     cellsci(1).ListIndex = 0
    Call cellsci_Change(1)
   readvalue = values
 End If
Case 2, 3, 4
  cellsci(types).Tag = values
  If values < 0.001 Then
    cellsci(types).ListIndex = 2
    Call cellsci_Change(types)
   readvalue = values / 0.000001
  ElseIf values < 1 Then
     cellsci(types).ListIndex = 1
    Call cellsci_Change(types)
   readvalue = values / 0.001
  Else
     cellsci(types).ListIndex = 0
    Call cellsci_Change(types)
   readvalue = values
 End If
Case 5, 6
  fresci(types - 5).Tag = values
  If values > 1000000 Then
     fresci(types - 5).ListIndex = 2
     Call fresci_Change(types - 5)
     readvalue = values / 1000000
  ElseIf values > 1000 Then
     fresci(types - 5).ListIndex = 1
     Call fresci_Change(types - 5)
     readvalue = values / 1000

  Else
     fresci(types - 5).ListIndex = 0
     Call fresci_Change(types - 5)
     readvalue = values
  End If
End Select
End Function
Function writevalue(values As Single, types As Integer) As Single
Select Case types
Case 0, 1, 2, 3, 4
 writevalue = values * sci(types)
Case 5, 6
 writevalue = values * fsci(types - 5)
End Select
End Function

Sub fresci_Change(index As Integer)
If index = 0 Then
  If fresci(0).ListIndex = 0 Then
   fsci(0) = 1
   ElseIf fresci(0).ListIndex = 1 Then
   fsci(0) = 1000
   Else
   fsci(0) = 1000000
   End If
 Else
  If fresci(1).ListIndex = 0 Then
   fsci(1) = 1
   ElseIf fresci(1).ListIndex = 1 Then
   fsci(1) = 1000
   Else
   fsci(1) = 1000000
   End If
End If
End Sub

Private Sub fresci_Click(index As Integer)
Call fresci_Change(index)
End Sub