📄 翼型数据处理程序.frm
字号:
VERSION 5.00
Begin VB.Form FrmTRansact
Caption = "数据处理界面"
ClientHeight = 4065
ClientLeft = 60
ClientTop = 450
ClientWidth = 4845
LinkTopic = "Form1"
ScaleHeight = 4044.776
ScaleMode = 0 'User
ScaleWidth = 4820.896
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox TxtBxy
Appearance = 0 'Flat
Enabled = 0 'False
Height = 390
Left = 3360
TabIndex = 15
Top = 1200
Width = 975
End
Begin VB.TextBox TxtXY
Height = 375
Left = 2040
TabIndex = 9
Text = "1"
Top = 1200
Width = 495
End
Begin VB.TextBox TxtK
Height = 375
Left = 5040
TabIndex = 12
Text = "40"
Top = 480
Width = 1215
End
Begin VB.CommandButton CmdPlot
Height = 495
Left = 3480
TabIndex = 10
Top = 3000
Width = 1335
End
Begin VB.TextBox TxtNum
Height = 375
Left = 2040
TabIndex = 7
Top = 240
Width = 1335
End
Begin VB.ComboBox Combo1
Height = 1080
Left = 2040
Style = 1 'Simple Combo
TabIndex = 5
Text = "Combo1"
Top = 1680
Width = 1335
End
Begin VB.TextBox TxtSym
Height = 375
Left = 2040
TabIndex = 8
Top = 720
Width = 1335
End
Begin VB.CommandButton CmdSTA
Caption = "生成通用格式数据"
Height = 495
Left = 240
TabIndex = 2
Top = 3000
Width = 1695
End
Begin VB.CommandButton CmdWrite
Caption = "写入数据库"
Height = 495
Left = 2040
TabIndex = 1
Top = 3000
Width = 1335
End
Begin VB.CommandButton CmdFinish
Caption = "完 成"
Height = 375
Left = 3600
TabIndex = 0
Top = 3600
Width = 1095
End
Begin VB.Label Label6
Caption = " 参考值："
Height = 255
Left = 2520
TabIndex = 14
Top = 1320
Width = 855
End
Begin VB.Label Label5
Caption = " 翼型形状修正因子："
Height = 375
Left = 0
TabIndex = 13
Top = 1200
Width = 1815
End
Begin VB.Label Label4
Caption = "图象放大系数："
Height = 255
Left = 5040
TabIndex = 11
Top = 120
Width = 1455
End
Begin VB.Label Label3
Caption = "采集坐标点对数： >30&&<150"
Height = 375
Left = 360
TabIndex = 6
Top = 240
Width = 1455
End
Begin VB.Label Label2
Caption = "已存在的翼型类："
Height = 375
Left = 360
TabIndex = 4
Top = 1680
Width = 1455
End
Begin VB.Label Label1
Caption = " 翼型数据类名："
Height = 375
Left = 360
TabIndex = 3
Top = 720
Width = 1455
End
End
Attribute VB_Name = "FrmTRansact"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strPath, strMDB, strData As String
Private Sym As String
Private T(150) As Single
Private XA(1 To 25), YA(1 To 25), YB(1 To 25) As Single
Private Num As Integer
Private i As Integer
Private SimR, CenAN As Single
Private objFSO As New FileSystemObject
Private objText As TextStream
Private Sub CmdFinish_Click()
Unload Me
End Sub
Private Sub CmdPlot_Click()
FrmTRansact.Width = 13000
FrmTRansact.Visible = False
FrmTRansact.Show
Dim XPOS, YPOS
Dim K As Integer
XPOS = 3.5 * ScaleWidth / 7
YPOS = 1 * ScaleHeight / 2
CurrentX = XPOS
CurrentY = YPOS
K = TxtK.Text
For i = 1 To 25
Line -(XA(i) * K + XPOS, YA(i) * K + YPOS)
Next
CurrentX = XPOS
CurrentY = YPOS
For i = 1 To 25
Line -(XA(i) * K + XPOS, YB(i) * K + YPOS)
Next
Line (XPOS, YPOS)-(XPOS + (XA(25) + XA(25)) * K / 2, YPOS + (YA(25) + YB(25)) * K / 2)
Const PI = 3.14159265
Circle (XA(25) * K + XPOS, YPOS), YA(25) * K, , PI * 19 / 13, PI * 6 / 13
End Sub
Private Sub CmdSTA_Click()
CmdWrite.Enabled = True
Num = Val(Trim(TxtNum.Text))
Sym = Trim(TxtSym.Text)
Dim strT As String
Set objText = objFSO.OpenTextFile(strData & "predata.txt", ForReading, False, TristateUseDefault)
SimR = objText.ReadLine
CenAN = objText.ReadLine
For i = 0 To Num - 1
strT = objText.ReadLine
T(Num - 1 - i) = Val(Trim(strT))
Next
Call Transact
TxtBxy.Text = Str(50 * 180 / (SimR * CenAN * 4 * Atn(1)))
End Sub
Private Sub CmdWrite_Click()
Dim Conn As New ADODB.Connection
Dim Rs As ADODB.Recordset
Set Conn = New ADODB.Connection
Conn.CursorLocation = adUseClient
Dim strSQL As String
Dim STRS As String
STRS = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strMDB & "aerofoil.mdb"
Conn.Open STRS
Set Rs = New ADODB.Recordset
Rs.Open "select * from aerofoil", Conn, adOpenStatic, adLockOptimistic
Rs.MoveLast
Rs.MoveFirst
Dim strKind As String
Dim symKind As Boolean
Dim nCount As Integer
nCount = Rs.RecordCount
symKind = False
strKind = TxtSym.Text
For i = 0 To nCount - 1
If strKind = Rs!aerofoilSym Then
symKind = True
Exit For
End If
Rs.MoveNext
Next
If symKind = False Then
Rs.MoveLast
Rs.AddNew
End If
Rs!pointNum = 25
Rs!aerofoilSym = strKind
Rs!t1 = YA(1)
Rs!t3 = YA(2)
Rs!t5 = YA(3)
Rs!t7 = YA(4)
Rs!t9 = YA(5)
Rs!t11 = YA(6)
Rs!t13 = YA(7)
Rs!t15 = YA(8)
Rs!t17 = YA(9)
Rs!t19 = YA(10)
Rs!t21 = YA(11)
Rs!t23 = YA(12)
Rs!t25 = YA(13)
Rs!t27 = YA(14)
Rs!t29 = YA(15)
Rs!t31 = YA(16)
Rs!t33 = YA(17)
Rs!t35 = YA(18)
Rs!t37 = YA(19)
Rs!t39 = YA(20)
Rs!t41 = YA(21)
Rs!t43 = YA(22)
Rs!t45 = YA(23)
Rs!t47 = YA(24)
Rs!t49 = YA(25)
Rs!t2 = YB(1)
Rs!t4 = YB(2)
Rs!t6 = YB(3)
Rs!t8 = YB(4)
Rs!t10 = YB(5)
Rs!t12 = YB(6)
Rs!t14 = YB(7)
Rs!t16 = YB(8)
Rs!t18 = YB(9)
Rs!t20 = YB(10)
Rs!t22 = YB(11)
Rs!t24 = YB(12)
Rs!t26 = YB(13)
Rs!t28 = YB(14)
Rs!t30 = YB(15)
Rs!t32 = YB(16)
Rs!t34 = YB(17)
Rs!t36 = YB(18)
Rs!t38 = YB(19)
Rs!t40 = YB(20)
Rs!t42 = YB(21)
Rs!t44 = YB(22)
Rs!t46 = YB(23)
Rs!t48 = YB(24)
Rs!t50 = YB(25)
Rs!t51 = XA(1)
Rs!t52 = XA(2)
Rs!t53 = XA(3)
Rs!t54 = XA(4)
Rs!t55 = XA(5)
Rs!t56 = XA(6)
Rs!t57 = XA(7)
Rs!t58 = XA(8)
Rs!t59 = XA(9)
Rs!t60 = XA(10)
Rs!t61 = XA(11)
Rs!t62 = XA(12)
Rs!t63 = XA(13)
Rs!t64 = XA(14)
Rs!t65 = XA(15)
Rs!t66 = XA(16)
Rs!t67 = XA(17)
Rs!t68 = XA(18)
Rs!t69 = XA(19)
Rs!t70 = XA(20)
Rs!t71 = XA(21)
Rs!t72 = XA(22)
Rs!t73 = XA(23)
Rs!t74 = XA(24)
Rs!t75 = XA(25)
Rs.Update
Rs.Close
Conn.Close
Dim MyVal
MyVal = MsgBox("已经更新到数据库！", vbInformation & vbOKOnly, "提示")
End Sub
Private Sub Combo1_Click()
Dim Conn As New ADODB.Connection
Dim Rs As ADODB.Recordset
Set Conn = New ADODB.Connection
Conn.CursorLocation = adUseClient
Dim strSQL As String
Dim strSource As String
strSource = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strMDB & "aerofoil.mdb"
Conn.Open strSource
Set Rs = New ADODB.Recordset
Rs.Open "select * from aerofoil", Conn, adOpenStatic, adLockOptimistic
Rs.MoveLast
Rs.MoveFirst
Dim strKind As String
Dim symKind As Boolean
Dim nCount As Integer
nCount = Rs.RecordCount
symKind = False
strKind = Combo1.Text
For i = 0 To nCount - 1
If strKind = Rs!aerofoilSym And strKind <> "Flat" Then
symKind = True
Exit For
End If
Rs.MoveNext
Next
If symKind Then
YA(1) = Rs!t1
YA(2) = Rs!t3
YA(3) = Rs!t5
YA(4) = Rs!t7
YA(5) = Rs!t9
YA(6) = Rs!t11
YA(7) = Rs!t13
YA(8) = Rs!t15
YA(9) = Rs!t17
YA(10) = Rs!t19
YA(11) = Rs!t21
YA(12) = Rs!t23
YA(13) = Rs!t25
YA(14) = Rs!t27
YA(15) = Rs!t29
YA(16) = Rs!t31
YA(17) = Rs!t33
YA(18) = Rs!t35
YA(19) = Rs!t37
YA(20) = Rs!t39
YA(21) = Rs!t41
YA(22) = Rs!t43
YA(23) = Rs!t45
YA(24) = Rs!t47
YA(25) = Rs!t49
YB(1) = Rs!t2
YB(2) = Rs!t4
YB(3) = Rs!t6
YB(4) = Rs!t8
YB(5) = Rs!t10
YB(6) = Rs!t12
YB(7) = Rs!t14
YB(8) = Rs!t16
YB(9) = Rs!t18
YB(10) = Rs!t20
YB(11) = Rs!t22
YB(12) = Rs!t24
YB(13) = Rs!t26
YB(14) = Rs!t28
YB(15) = Rs!t30
YB(16) = Rs!t32
YB(17) = Rs!t34
YB(18) = Rs!t36
YB(19) = Rs!t38
YB(20) = Rs!t40
YB(21) = Rs!t42
YB(22) = Rs!t44
YB(23) = Rs!t46
YB(24) = Rs!t48
YB(25) = Rs!t50
End If
If strKind = "Flat" Then
Dim FT As Single
Dim J As Integer
FT = InputBox("请输入平板厚度：", "提示")
XA(1) = 0.5
XA(2) = 0.75
XA(3) = 1.25
XA(4) = 2.5
XA(5) = 5
XA(6) = 7.5
For i = 7 To 25
XA(i) = 10 + (i - 7) * 5
Next
For J = 1 To 25
YA(J) = FT / 2
YB(J) = -FT / 2
Next
End If
Rs.Close
Conn.Close
End Sub
Private Sub Form_Load()
strPath = App.Path
strMDB = strPath & "\DataBase\"
strData = strPath & "\aerofoil\"
CmdWrite.Enabled = False
CmdPlot.Caption = "查看翼型曲线"
Dim Conn As New ADODB.Connection
Dim Rs As ADODB.Recordset
Set Conn = New ADODB.Connection
Conn.CursorLocation = adUseClient
Dim strSQL As String
Dim strSource As String
strSource = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strMDB & "aerofoil.mdb"
Conn.Open strSource
Set Rs = New ADODB.Recordset
Rs.Open "select * from aerofoil", Conn, adOpenStatic, adLockOptimistic
Rs.MoveLast
Rs.MoveFirst
Dim nCount As Integer
nCount = Rs.RecordCount
For i = 0 To nCount - 1
Combo1.List(i) = Rs!aerofoilSym
Rs.MoveNext
Next
Rs.Close
Conn.Close
XA(1) = 0.5
XA(2) = 0.75
XA(3) = 1.25
XA(4) = 2.5
XA(5) = 5
XA(6) = 7.5
For i = 7 To 25
XA(i) = 10 + (i - 7) * 5
Next
End Sub
Private Sub Transact()
Dim LE As Single
Dim SCA As Single
Dim K, J As Integer
Dim XY As Single
LE = SimR * CenAN * 4 * Atn(1) / 180
TxtXY.Text = Str(50 * 180 / (SimR * CenAN * 4 * Atn(1)))
XY = Val(Trim(TxtXY.Text))
For i = 1 To 25
SCA = Num * XA(i) / 100
J = Fix(SCA)
K = Fix(SCA) + 1
If Abs(SCA - J) < Abs(K - SCA) Then
J = J
ElseIf Abs(SCA - J) < Abs(K - SCA) Then
J = K
End If
If J = Num Then
J = Num - 2
K = J + 1
End If
YA(i) = (T(J) + (T(K) - T(J)) * (SCA - Fix(SCA))) * XY
YB(i) = -(T(J) + (T(K) - T(J)) * (SCA - Fix(SCA))) * XY
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -