📄 userbox.frm
字号:
VERSION 5.00
Begin VB.Form userplotter
Caption = "自定义绘图仪"
ClientHeight = 5445
ClientLeft = 60
ClientTop = 345
ClientWidth = 4005
Icon = "userbox.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5445
ScaleWidth = 4005
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Visible = 0 'False
Begin VB.PictureBox table
Appearance = 0 'Flat
BackColor = &H8000000A&
ForeColor = &H80000008&
Height = 2150
Left = 0
ScaleHeight = 2115
ScaleWidth = 3975
TabIndex = 21
Top = 0
Width = 4000
Begin VB.PictureBox Paper
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 2000
Left = 0
ScaleHeight = 1965
ScaleWidth = 3975
TabIndex = 22
Top = 150
Width = 4000
Begin VB.Line mesureline
BorderColor = &H00FF0000&
X1 = 840
X2 = 840
Y1 = 0
Y2 = 1920
End
End
Begin VB.Image Mark
Appearance = 0 'Flat
Height = 150
Left = 840
Picture = "userbox.frx":0CCA
Stretch = -1 'True
Top = 0
Width = 150
End
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H8000000A&
Caption = "设置"
ForeColor = &H80000008&
Height = 2655
Left = 0
TabIndex = 2
Top = 2760
Width = 4000
Begin VB.OptionButton AF
Caption = "振幅特性"
Height = 255
Left = 600
TabIndex = 20
Top = 240
Width = 1095
End
Begin VB.OptionButton PH
Caption = "相位特性"
Height = 255
Left = 2040
TabIndex = 19
Top = 240
Width = 1095
End
Begin VB.Frame Frame2
Caption = "接口"
Height = 1080
Left = 120
TabIndex = 12
Top = 1450
Width = 1695
Begin VB.TextBox node
Height = 270
Left = 720
TabIndex = 15
Text = "0"
Top = 220
Width = 855
End
Begin VB.TextBox zerocom
Height = 270
Left = 720
TabIndex = 14
Text = "0"
Top = 460
Width = 855
End
Begin VB.TextBox sourcec
Height = 270
Left = 720
TabIndex = 13
Text = "0"
Top = 700
Width = 855
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "节点"
Height = 255
Left = 120
TabIndex = 18
Top = 260
Width = 495
End
Begin VB.Label Label8
Alignment = 2 'Center
Caption = "共地端"
Height = 255
Left = 15
TabIndex = 17
Top = 505
Width = 735
End
Begin VB.Label Label9
Alignment = 2 'Center
Caption = "绑定源"
Height = 255
Left = 15
TabIndex = 16
Top = 750
Width = 720
End
End
Begin VB.Frame Frame3
Height = 975
Left = 120
TabIndex = 7
Top = 480
Width = 3735
Begin VB.TextBox maxv
Alignment = 1 'Right Justify
Height = 270
Left = 960
TabIndex = 9
Text = "100"
Top = 240
Width = 2655
End
Begin VB.TextBox coun
Alignment = 1 'Right Justify
Height = 270
Left = 960
TabIndex = 8
Text = "10"
Top = 600
Width = 2655
End
Begin VB.Label Label5
Alignment = 2 'Center
Caption = "最大值"
Height = 255
Left = 120
TabIndex = 11
Top = 240
Width = 735
End
Begin VB.Label Label6
Alignment = 2 'Center
Caption = "采样数"
Height = 255
Left = 120
TabIndex = 10
Top = 600
Width = 735
End
End
Begin VB.Frame Frame4
Caption = "显示类型"
Height = 1080
Left = 2280
TabIndex = 3
Top = 1450
Width = 1575
Begin VB.OptionButton dsp
Caption = "真实值"
Height = 255
Index = 0
Left = 120
TabIndex = 6
Top = 215
Width = 975
End
Begin VB.OptionButton dsp
Caption = "相对值"
Height = 255
Index = 1
Left = 120
TabIndex = 5
Top = 455
Width = 975
End
Begin VB.OptionButton dsp
Caption = "对数值"
Height = 255
Index = 2
Left = 120
TabIndex = 4
Top = 695
Width = 975
End
End
End
Begin VB.CommandButton left
Appearance = 0 'Flat
Height = 300
Left = 2160
Picture = "userbox.frx":13CC
Style = 1 'Graphical
TabIndex = 1
Top = 2430
Width = 855
End
Begin VB.CommandButton right
Appearance = 0 'Flat
Height = 300
Left = 3120
Picture = "userbox.frx":1E9A
Style = 1 'Graphical
TabIndex = 0
Top = 2430
Width = 855
End
Begin VB.Label nowvalue
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Left = 2760
TabIndex = 23
Top = 2160
Width = 1215
End
Begin VB.Label nowvolt
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Left = 840
TabIndex = 25
Top = 2160
Width = 1095
End
Begin VB.Label Label3
Appearance = 0 'Flat
BackColor = &H8000000A&
BorderStyle = 1 'Fixed Single
Caption = "当前值："
ForeColor = &H80000008&
Height = 255
Left = 1920
TabIndex = 24
Top = 2160
Width = 975
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H8000000A&
BorderStyle = 1 'Fixed Single
Caption = "当前电压："
ForeColor = &H80000008&
Height = 255
Left = 0
TabIndex = 26
Top = 2160
Width = 975
End
End
Attribute VB_Name = "userplotter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 bodetype As Integer
Dim maxvalue As Single
Dim State As Integer
Dim numbers As Integer
Dim com, disptype As Integer
Dim pnode As Integer
Dim values() As Single
Dim sourcecell As Integer
Dim oldx As Single
Sub clip()
mesureline.X1 = Mark.left + 53
mesureline.X2 = Mark.left + 53
If State = 1 Then
nowvalue.Caption = maxvalue * Mark.left / 4000
nowvolt.Caption = values(Fix(Mark.left / (4000 / numbers)) + 1)
End If
End Sub
Private Sub coun_Change()
If coun.Text <> "" Then
If CInt(coun.Text) > 0 Then
numbers = CInt(coun.Text)
End If
End If
End Sub
Private Sub Form_Load()
Dim k As Integer
retvalue = SetWindowPos(Me.hwnd, -1, Me.CurrentX, Me.CurrentY, 273, 380, &H40)
'置中窗体
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
numbers = 10
maxvalue = 100
pnode = 1
com = 0
Call drawnet
Call clip
End Sub
Private Sub Form_Unload(cancel As Integer)
If formstate = 1 Then
cancel = 0
Else
cancel = 1
userplotter.Hide
End If
End Sub
Private Sub Mark_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Source.Move Mark.left + (X - oldx)
If Mark.left > 3800 Then
Mark.left = 3800
ElseIf Mark.left < 40 Then
Mark.left = 40
End If
Call clip
End Sub
Private Sub Mark_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
oldx = X
Mark.Drag
End If
End Sub
Sub drawmap()
Dim steps, k As Integer
Dim temp As Single
ReDim values(1 To numbers) As Single
Paper.Cls
Call drawnet
State = 1
steps = Fix(4000 / numbers)
'''''''''''''''to initial the value
Call wholeanalysis(1)
'''''''''''''''''''''''''''''''''''''
'''''to compute the node value!
For k = 1 To numbers
If (mapform.cell(sourcecell).celltype = 3 Or mapform.cell(sourcecell).celltype = 4) And mapform.cell(sourcecell).celltag = 1 Then
sourcemat(mapform.cell(sourcecell).cellvalue).a = maxvalue * (k / numbers)
Else
mapform.cell(sourcecell).cellvalue = maxvalue * (k / numbers)
End If
Call ACanalyse
values(k) = getvalue
Next k
'''''to draw the bodecurves!
If disptype = 2 Then
For k = 2 To numbers
Paper.Line (steps * (k - 1), Fix(Log(values(k - 1)) * 100))-(steps * k, Fix(Log(values(k)) * 100))
Next k
Else
For k = 1 To numbers
If values(k) > temp Then
temp = values(k)
End If
Next k
For k = 2 To numbers
Paper.Line (steps * (k - 1), 2000 - Fix(values(k - 1) / temp * 2000))-(steps * k, 2000 - Fix(values(k) / temp * 2000))
Next k
End If
Call clip
End Sub
Function getvalue()
If bodetype = 0 Then
getvalue = nodevinfo(pnode, 0).a - nodevinfo(com, 0).a
If getvalue < 0 Then
getvalue = Abs(getvalue)
End If
Else
getvalue = nodevinfo(pnode, 0).alpha - nodevinfo(com, 0).alpha
If getvalue < 0 Then
getvalue = getvalue + 360
End If
End If
End Function
Private Sub maxv_Change()
If maxv.Text <> "" Then
If CInt(maxv.Text) > 0 Then
maxvalue = CInt(maxv.Text)
End If
End If
End Sub
Public Sub node_Change()
If node.Text <> "" Then
If CInt(node.Text) >= 0 And CInt(node.Text) < nodecounts Then
pnode = CInt(node.Text)
Else
MsgBox "请正确输入节点号！"
End If
End If
End Sub
Public Sub sourcec_Change()
If sourcec.Text <> "" Then
If CInt(sourcec.Text) >= 0 And CInt(sourcec.Text) < counts Then
sourcecell = CInt(sourcec.Text)
Else
MsgBox "请正确输入元件号！"
End If
End If
End Sub
Public Sub zerocom_Change()
If zerocom <> "" Then
If CInt(zerocom.Text) >= 0 And CInt(zerocom.Text) < nodecounts Then
com = CInt(zerocom.Text)
Else
MsgBox "请正确输入节点号！"
End If
End If
End Sub
Private Sub left_Click()
If Mark.left > 40 Then
Mark.left = Mark.left - 20
Call clip
End If
End Sub
Private Sub right_Click()
If Mark.left < 4000 Then
Mark.left = Mark.left + 20
Call clip
End If
End Sub
Sub drawnet()
Dim k As Integer
For k = 0 To Paper.Width Step 80
Paper.Line (k, 0)-(k, 2000), &HC0C0C0
Next k
For k = 0 To Paper.Height Step 80
Paper.Line (0, k)-(4000, k), &HC0C0C0
Next k
End Sub
Public Sub plotter_start()
Dim flag As Integer
On Error GoTo marks
Call drawmap
flag = 1
marks::
If flag = 0 Then
MsgBox "电路尚不完善或电路中有错误，请先纠正再运行！"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -