⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 某大学开发的一个用于对微波传输线状态进行模拟的软件
💻 FRM
📖 第 1 页 / 共 2 页
字号:
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "度"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1770
      TabIndex        =   14
      Top             =   2670
      Width           =   270
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bo As Boolean

Private Sub Command1_Click()
Form1.Cls
Call Form_Resize
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
bo = True
Form1.Frame1.Visible = False
Form1.Cls
Call Form_Resize
Dim r, ct, pi, ct1, k1, k2, xzn, rzn, xzn1, b1, h1, p As Single
pi = 4 * Atn(1)
X1$ = Form1.ScaleWidth
Y1$ = Form1.ScaleHeight
If (X1 - Y1) > 0 Then
Z$ = Y1 * 0.85
Else
Z = X1 * 0.85
End If
If X1 <= 0 Or Y1 <= 0 Or Z <= 0 Then
X1 = 1
Y1 = 1
Z = 1
End If
h1 = X1 * 0.65

If (X - X1 * 0.65) ^ 2 + (y - Y1 / 2) ^ 2 <= (Z / 2) ^ 2 Then
 
  MousePointer = 2
  r = Abs(Sqr(((X - X1 * 0.65) / (Z / 2)) ^ 2 + ((y - Y1 / 2) / (Z / 2)) ^ 2))
  ct = Atn((Y1 / 2 - y) / (X - X1 * 0.65)) * 180 / pi
  If X < X1 * 0.65 Then
  If y <= Y1 / 2 Then
  ct = ct + 180
  Else
  ct = ct - 180
  End If
  End If

   ct1 = ct * pi / 180
   k1 = Sqr(r ^ 2 / (1 + Tan(ct1) ^ 2))
   If ct = 0 Then
   k2 = 0
   Else
   k2 = Sqr(r ^ 2 / (1 + (1 / Tan(ct1)) ^ 2))
   End If
     If ct >= 0 Then
        If ct > 90 And ct <= 180 Then
        k1 = -k1
        End If
    Else
      If ct > -180 And ct <= -90 Then
        k1 = -k1
        k2 = -k2
      ElseIf ct > -90 And ct < 0 Then
        k2 = -k2
      End If
     End If
        rzn = (1 - k1 ^ 2 - k2 ^ 2) / (k2 ^ 2 + (1 - k1) ^ 2)
        Form1.Circle ((h1 + Z / 2 * rzn / (1 + rzn)), Y1 / 2), (1 - rzn / (1 + rzn)) * Z / 2, vbYellow
       xzn1 = (k2 + k2 * rzn) / (1 - k1)
     If xzn1 = 0 Then
       Form1.Line (h1 - Z / 2, Y1 / 2)-(h1 + Z / 2, Y1 / 2), vbYellow
     ElseIf xzn1 > 0 Then
       xzn = 1 / xzn1
       b1 = pi - 2 * Atn(xzn)
       If b1 = 0 Then
       Form1.Line (h1 - Z / 2, Y1 / 2)-(h1 + Z / 2, Y1 / 2), vbYellow
       Else
       Form1.Circle ((h1 + Z / 2), Y1 / 2 - xzn * Z / 2), Z / 2 * xzn, vbYellow, 3 * pi / 2 - b1, 3 * pi / 2
       End If
     Else
       xzn = -1 / xzn1
       b1 = pi - 2 * Atn(xzn)
       Form1.Circle ((h1 + Z / 2), Y1 / 2 + xzn * Z / 2), Z / 2 * xzn, vbYellow, pi / 2, pi / 2 + b1
      End If
      If Abs(xzn1) < 0.055 Then
    Form1.Line (h1 - Z / 2, Y1 / 2 - (xzn1 * Z / 2))-(h1 + Z / 2, Y1 / 2), vbYellow
   End If
   If MDIForm1.ssck.Checked = False Then
   Form8.Show
   End If
   Form8.Visible = True
   Form8.Text10.Text = Format(rzn, "#########.0000000000")
   Form8.Text9.Text = Format(xzn1, "#########.0000000000")
   Form8.Text11.Text = Format(ct, "#########.0000000000")
   Form8.Text7.Text = Format(r, "#########.0000000000")
    If r = 0 Then
   Form8.Text1.Text = 0
   Else
   Form8.Text1.Text = Format(((1 + r) / (1 - r)), "#########.0000000000")
   End If
    For p = 0 To 1 Step 0.05
   Form1.Circle (X, y), 30 * p, vbBlue
   Next
End If
If (X - X1 * 0.65) ^ 2 + (y - Y1 / 2) ^ 2 >= (Z / 2) ^ 2 Then
Unload Form8
If Form1.Frame1.Visible = False Then
Form1.Frame1.Visible = True
Text5.Text = 0
End If
MousePointer = 0
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
bo = False
MousePointer = 0
End Sub

Public Sub Form_Resize()
Form1.Cls
Dim X1, Y1, Z, h, r, pi, a, ZO, xn, Xn1, rn, b, fi, f, c, m, n, Tu, Tv, t, t2, xy As Double
Dim yx As Single
X1 = Form1.ScaleWidth
Y1 = Form1.ScaleHeight
If (X1 - Y1) > 0 Then
Z = Y1 * 0.85
Else
Z = X1 * 0.85
End If
If X1 <= 0 Or Y1 <= 0 Or Z <= 0 Then
X1 = 1
Y1 = 1
Z = 1
End If

h = X1 * 0.65
r = Z / 2 * 0.08
Form1.Line (h - Z / 2, Y1 / 2)-(h + Z / 2, Y1 / 2)
For xy = 0 To 1 Step 0.06
Form1.Circle ((h + Z / 2 * xy), (Y1 / 2)), Z * (1 - xy) / 2
Next
Form1.Line ((h + Z / 2) * 0.8, Y1 / 2)-(h - Z / 2, Y1 / 2 * 0.95)
Form1.Line ((h + Z / 2) * 0.8, Y1 / 2)-(h - Z / 2, Y1 / 2 * 1.05)
For i = 0 To 1 Step 0.04
pi = 4 * Atn(1)
a = pi - 2 * Atn(r / (Z / 2) * i)
Form1.Circle ((h + Z / 2), Y1 / 2 - r * i), r * i, , 3 * pi / 2 - a, 3 * pi / 2
Form1.Circle ((h + Z / 2), Y1 / 2 + r * i), r * i, , pi / 2, pi / 2 + a
r = 1.4 * r
Next
For yx = 0 To 1 Step 0.05
Form1.Circle (h, Y1 / 2), 30 * yx, vbBlue
Next


Form1.CurrentX = (h - Z / 2) * 0.9
Form1.CurrentY = Y1 / 10
Form1.Print "+j"
Form1.CurrentX = (h - Z / 2) * 0.9
Form1.CurrentY = 4 * Y1 / 5
Form1.Print "-j"
Form1.Circle (h, Y1 / 2), Z / 2 * 19 / 18, vbBlue
Form1.Line ((h - Z / 2 * 19 / 18) * 0.95, Y1 / 2)-(h - Z / 2 * 19 / 18, Y1 / 2)
Form1.CurrentX = (h - Z / 2 * 19 / 18) * 0.8
Form1.CurrentY = (Y1 / 2) * 0.95
Form1.Print "180"
Form1.Line ((h + Z / 2 * 19 / 18), Y1 / 2)-((h + Z / 2 * 19 / 18) * 1.02, Y1 / 2)
Form1.CurrentX = (h + Z / 2 * 19 / 18) * 1.02
Form1.CurrentY = Y1 / 2
Form1.Print "0"
Form1.Line (h, Y1 / 2 + Z / 2 * 19 / 18)-(h, (Y1 / 2 + Z / 2 * 19 / 18) * 1.02)
Form1.CurrentX = h * 1.01
Form1.CurrentY = (Y1 / 2 + Z / 2 * 19 / 18) * 1.005
Form1.Print "-90"
Form1.Line (h, Y1 / 2 - Z / 2 * 19 / 18)-(h, (Y1 / 2 - Z / 2 * 19 / 18) * 0.6)
Form1.CurrentX = h * 1.01
Form1.CurrentY = (Y1 / 2 - Z / 2 * 19 / 18) * 0.3
Form1.Print " 90"

Dim j As Integer
Dim k As Single
Dim xstar, ystar, rstar, xt1, xt2 As Double
xt1 = (Z / 2 * 19 / 18) * Cos(pi / 3)
xt2 = (Z / 2 * 19 / 18) * Sin(pi / 3)
For j = 0 To 11
Select Case j
Case 0
xstar = h + Z / 2 * 19 / 18
ystar = Y1 / 2
Case 1
xstar = h + xt1
ystar = Y1 / 2 - xt2
Case 2
xstar = h + xt2
ystar = Y1 / 2 - xt1
Case 3
xstar = h
ystar = Y1 / 2 - Z / 2 * 19 / 18
Case 4
xstar = h - xt2
ystar = Y1 / 2 - xt1
Case 5
xstar = h - xt1
ystar = Y1 / 2 - xt2
Case 6
xstar = h - Z / 2 * 19 / 18
ystar = Y1 / 2
Case 7
xstar = h - xt1
ystar = Y1 / 2 + xt2
Case 8
xstar = h - xt2
ystar = Y1 / 2 + xt1
Case 9
xstar = h
ystar = Y1 / 2 + Z / 2 * 19 / 18
Case 10
xstar = h + xt2
ystar = Y1 / 2 + xt1
Case 11
xstar = h + xt1
ystar = Y1 / 2 + xt2
End Select
For k = 0 To 1 Step 0.01
Form1.Circle (xstar, ystar), 40 * k, vbRed
Next
Next




'zk&dk
z0 = Form1.Text3.Text
If z0 <= 0 Then
MsgBox "特性阻抗输入无效!"
Else
rn = Form1.Text1.Text / z0
If rn < 0 Then
MsgBox "阻抗输入无效!"
Else
Form1.Circle ((h + Z / 2 * rn / (1 + rn)), Y1 / 2), (1 - rn / (1 + rn)) * Z / 2, vbRed
Xn1 = Form1.Text2.Text / z0
If Xn1 > 0 Then
xn = 1 / Xn1
b = pi - 2 * Atn(xn)
Form1.Circle ((h + Z / 2), Y1 / 2 - xn * Z / 2), Z / 2 * xn, vbRed, 3 * pi / 2 - b, 3 * pi / 2
ElseIf Xn1 = 0 Then
Form1.Line (h - Z / 2, Y1 / 2)-(h + Z / 2, Y1 / 2), vbRed
Else
xn = -1 / Xn1
b = pi - 2 * Atn(xn)
Form1.Circle ((h + Z / 2), Y1 / 2 + xn * Z / 2), Z / 2 * xn, vbRed, pi / 2, pi / 2 + b
End If
If Abs(Xn1) < 0.05834482 Then
Form1.Line (h - Z / 2, Y1 / 2 - (Xn1 * Z / 2))-(h + Z / 2, Y1 / 2), vbRed
End If
End If
End If

'TejFi
Tu = (rn - 1) / (rn + 1) + 2 * Xn1 ^ 2 / ((rn + 1) ^ 3 + Xn1 ^ 2 * (rn + 1))
Tv = 2 * Xn1 / ((rn + 1) ^ 2 + Xn1 ^ 2)

If rn ^ 2 + Xn1 ^ 2 = 1 Or Tu = 0 Then
 If Xn1 > 0 Then
 fi = 90
 ElseIf Xn1 < 0 Then
 fi = -90
 Else
 fi = 0
 End If
Else
 If Tv = 0 Then
 fi = 0
 Else
 fi = Atn(Tv / Tu) / pi * 180
 End If
End If
t = Sqr(Tu ^ 2 + Tv ^ 2)
t2 = Abs(t)
  If rn ^ 2 + Xn1 ^ 2 < 1 Then
   If rn < 1 Then
     If Xn1 > -1 And Xn1 < 0 Then
       fi = fi - 180
     ElseIf Xn1 > 0 And Xn1 < 1 Then
       fi = fi + 180
     End If
    End If
   End If
  If Xn1 = 0 And rn < 1 Then
  fi = 180
  End If
  t2 = Format(t2, "#########.0000000000")
  fi = Format(fi, "#########.0000000000")
Form1.Text4.Text = t2
Form1.Text6.Text = fi
If t2 = 0 Then
Text7.Text = 0
Else
Text7.Text = Format((1 + t2) / (1 - t2), "########.0000000000")
End If

'xz
    If Form1.Option3.Value = True Then
      c = Form1.Text5
    Else
      c = Form1.Text5 * 180 / pi
    End If
    If Form1.Option2.Value = True Then
      fi = fi + c
    Else
      fi = fi - c
    End If
   f = fi * pi / 180
   If c <> 0 Then
   Form1.Circle (h, Y1 / 2), t2 * Z / 2, vbGreen
   m = Sqr(t ^ 2 / (1 + Tan(f) ^ 2))
   n = Sqr(t ^ 2 / (1 + (1 / Tan(f)) ^ 2))
   If fi > 360 Then
      Do While fi > 360
      fi = fi - 360
      Loop
   End If
   If fi < -360 Then
      Do While fi < -360
      fi = fi + 360
      Loop
   End If
   If fi >= 0 Then
       If fi >= 0 And fi <= 90 Then
        m = m
       ElseIf fi > 90 And fi <= 180 Then
        m = -m
       ElseIf fi > 180 And fi <= 270 Then
        n = -n
        m = -m
       ElseIf fi > 270 And fi <= 360 Then
        n = -n
       End If
    Else
      If fi >= -360 And fi <= -270 Then
        m = m
      ElseIf fi > -270 And fi <= -180 Then
        m = -m
      ElseIf fi > -180 And fi <= -90 Then
        n = -n
        m = -m
      ElseIf fi > -90 And fi < 0 Then
        n = -n
      End If
     End If
        rn = (1 - m ^ 2 - n ^ 2) / (n ^ 2 + (1 - m) ^ 2)
        Form1.Circle ((h + Z / 2 * rn / (1 + rn)), Y1 / 2), (1 - rn / (1 + rn)) * Z / 2, vbYellow
       Xn1 = (n + n * rn) / (1 - m)
       If Xn1 > 0 Then
       xn = 1 / Xn1
       b = pi - 2 * Atn(xn)
       Form1.Circle ((h + Z / 2), Y1 / 2 - xn * Z / 2), Z / 2 * xn, vbYellow, 3 * pi / 2 - b, 3 * pi / 2
      ElseIf Xn1 = 0 Then
       Form1.Line (h - Z / 2, Y1 / 2)-(h + Z / 2, Y1 / 2), vbYellow
      Else
       xn = -1 / Xn1
       b = pi - 2 * Atn(xn)
       Form1.Circle ((h + Z / 2), Y1 / 2 + xn * Z / 2), Z / 2 * xn, vbYellow, pi / 2, pi / 2 + b
      End If
      If Abs(Xn1) < 0.05834482 Then
      Form1.Line (h - Z / 2, Y1 / 2 - (Xn1 * Z / 2))-(h + Z / 2, Y1 / 2), vbRed
      End If
      End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Dim Pnt As PointAPI ' Declare a variable to use the UDT
GetCursorPos Pnt ' Call the API to return the x and y coordinates of the mouse pointer
If bo = True Then
Form1.Frame1.Visible = False
Form1.Cls
Call Form_Resize
Dim r, ct, pi, ct1, k1, k2, xzn, rzn, xzn1, b1, h1, q As Single
pi = 4 * Atn(1)
X1$ = Form1.ScaleWidth
Y1$ = Form1.ScaleHeight
If (X1 - Y1) > 0 Then
Z$ = Y1 * 0.85
Else
Z = X1 * 0.85
End If
If X1 <= 0 Or Y1 <= 0 Or Z <= 0 Then
X1 = 1
Y1 = 1
Z = 1
End If
h1 = X1 * 0.65

If (X - X1 * 0.65) ^ 2 + (y - Y1 / 2) ^ 2 <= (Z / 2) ^ 2 Then

MousePointer = 2
r = Abs(Sqr(((X - X1 * 0.65) / (Z / 2)) ^ 2 + ((y - Y1 / 2) / (Z / 2)) ^ 2))
ct = Atn((Y1 / 2 - y) / (X - X1 * 0.65)) * 180 / pi
If X < X1 * 0.65 Then
If y <= Y1 / 2 Then
ct = ct + 180
Else
ct = ct - 180
End If
End If

   ct1 = ct * pi / 180
   k1 = Sqr(r ^ 2 / (1 + Tan(ct1) ^ 2))
   If ct = 0 Then
   k2 = 0
   Else
   k2 = Sqr(r ^ 2 / (1 + (1 / Tan(ct1)) ^ 2))
   End If
     If ct >= 0 Then
        If ct > 90 And ct <= 180 Then
        k1 = -k1
        End If
    Else
      If ct > -180 And ct <= -90 Then
        k1 = -k1
        k2 = -k2
      ElseIf ct > -90 And ct < 0 Then
        k2 = -k2
      End If
     End If
        rzn = (1 - k1 ^ 2 - k2 ^ 2) / (k2 ^ 2 + (1 - k1) ^ 2)
        Form1.Circle ((h1 + Z / 2 * rzn / (1 + rzn)), Y1 / 2), (1 - rzn / (1 + rzn)) * Z / 2, vbYellow
       xzn1 = (k2 + k2 * rzn) / (1 - k1)
     If xzn1 = 0 Then
       Form1.Line (h1 - Z / 2, Y1 / 2)-(h1 + Z / 2, Y1 / 2), vbYellow
     ElseIf xzn1 > 0 Then
       xzn = 1 / xzn1
       b1 = pi - 2 * Atn(xzn)
       If b1 = 0 Then
       Form1.Line (h1 - Z / 2, Y1 / 2)-(h1 + Z / 2, Y1 / 2), vbYellow
       Else
       Form1.Circle ((h1 + Z / 2), Y1 / 2 - xzn * Z / 2), Z / 2 * xzn, vbYellow, 3 * pi / 2 - b1, 3 * pi / 2
       End If
     Else
       xzn = -1 / xzn1
       b1 = pi - 2 * Atn(xzn)
       Form1.Circle ((h1 + Z / 2), Y1 / 2 + xzn * Z / 2), Z / 2 * xzn, vbYellow, pi / 2, pi / 2 + b1
      End If
       If Abs(xzn1) < 0.055 Then
       Form1.Line (h1 - Z / 2, Y1 / 2 - (xzn1 * Z / 2))-(h1 + Z / 2, Y1 / 2), vbYellow
       For q = 0 To 1 Step 0.05
       Form1.Circle (X, Y1 / 2 - (xzn1 * Z / 2)), 40 * q, vbBlue
       Next
       Else
        For q = 0 To 1 Step 0.05
        Form1.Circle (X, y), 30 * q, vbBlue
        Next
       End If
   Form8.Show
   Form8.Visible = True
   Form8.Text10.Text = Format(rzn, "#########.0000000000")
   Form8.Text9.Text = Format(xzn1, "#########.0000000000")
   Form8.Text11.Text = Format(ct, "#########.0000000000")
   Form8.Text7.Text = Format(r, "#########.0000000000")
    If r = 0 Then
   Form8.Text1.Text = 0
   Else
   Form8.Text1.Text = Format(((1 + r) / (1 - r)), "#########.0000000000")
   End If
  
End If
If (X - X1 * 0.65) ^ 2 + (y - Y1 / 2) ^ 2 >= (Z / 2) ^ 2 Then
Unload Form8
Form1.Frame1.Visible = True
Text5.Text = 0
MousePointer = 0
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Form8
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -