📄 mainform.frm
字号:
Exit Sub
End Sub
'保存结果数据文本
Private Sub ResultFile_Click()
If isCalculate = False Then
MsgBox "请先进行计算!"
Exit Sub
End If
On Error GoTo nocation
CoD1.CancelError = True
CoD1.InitDir = App.Path
CoD1.Filter = "文本文件 | *.txt"
CoD1.ShowSave
mStructor.OUTPUTresult (CoD1.filename)
Exit Sub
nocation:
Exit Sub
End Sub
'菜单二,编辑
'参数
Private Sub ParaMenu_Click()
If HavePrg = False Then
MsgBox "请先新建工程!"
Exit Sub
End If
HaveShowGraph = True
ParameterForm.Show , Me
End Sub
'结点
Private Sub NodeMenu_Click()
If HavePrg = False Then
MsgBox "请先新建工程!"
Exit Sub
End If
EditType = -1
NodeF.Show , Me
End Sub
'杆件
Private Sub GJMenu_Click()
If HavePrg = False Then
MsgBox "请先新建工程!"
Exit Sub
End If
EditType = -1
GanJianF.Show , Me
End Sub
'支座
Private Sub BaseMenu_Click()
If HavePrg = False Then
MsgBox "请先新建工程!"
Exit Sub
End If
EditType = -1
BaseForm.Show , Me
End Sub
'菜单三,形成结构体
Private Sub MakeStructor_Click()
mStructor.SetData
isCalculate = False
End Sub
'菜单四,计算
Private Sub mnucal_Click()
If HaveReaded = False Then
MsgBox "未形成结构体!"
Exit Sub
End If
If isCalculate = True Then Exit Sub
mStructor.OUTPUTknowData App.Path & "\DATAO1.TXT"
mStructor.calculate
mStructor.OUTPUTresult App.Path & "\DATAO1.TXT"
If Check1.Value = 0 Then Exit Sub
'将数据显示在窗体ShowDataForm上
Dim fp As Integer, InputData As String
fp = FreeFile
ShowDataForm.Show , Me
ShowDataForm.Caption = "结果数据文本"
ShowDataForm.Text1 = ""
Open App.Path & "\DATAO1.TXT" For Input As #fp
Do While Not EOF(fp)
Line Input #fp, InputData
ShowDataForm.Text1 = ShowDataForm.Text1 + InputData + vbCrLf
Loop
Close #fp
End Sub
'菜单五,文本显示操作
'显示节点数据
Private Sub NodeData_Click()
If HaveReaded = False Then
MsgBox "未形成结构体!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "节点已知数据文本"
GetNodeData ShowDataForm.Text1
End Sub
'显示杆件单元已知数据
Private Sub GJdata_Click()
If HaveReaded = False Then
MsgBox "未形成结构体!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "杆件单元已知数据文本"
GetGJData ShowDataForm.Text1
End Sub
'显示受荷载的节点已知数据
Private Sub Nodeload_Click()
If HaveReaded = False Then
MsgBox "未形成结构体!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "受荷载的节点数据文本"
GetNodeLoad ShowDataForm.Text1
End Sub
'显示支座数据
Private Sub BaseData_Click()
If HaveReaded = False Then
MsgBox "未形成结构体!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "支座已知数据文本"
GetBaseData ShowDataForm.Text1
End Sub
'显示全部已知数据
Private Sub KnowAll_Click()
If HaveReaded = False Then
MsgBox "未形成结构体!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "全部已知数据文本"
GetKnowData ShowDataForm.Text1
End Sub
'显示位移
Private Sub MNEDIS_Click()
If isCalculate = False Then
MsgBox "请先进行计算!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "位移数据文本"
mStructor.GetDis ShowDataForm.Text1
End Sub
'显示轴力文本
Private Sub MNUZHOULI_Click()
If isCalculate = False Then
MsgBox "请先进行计算!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "轴力数据文本"
mStructor.GetForce ShowDataForm.Text1
End Sub
'显示支座反力数据文本
Private Sub MNUZHIZUO_Click()
If isCalculate = False Then
MsgBox "请先进行计算!"
Exit Sub
End If
ShowDataForm.Show , Me
ShowDataForm.Caption = "支座反力数据文本"
mStructor.GetREAC ShowDataForm.Text1
End Sub
'显示计算后自动生成的总数据文本
Private Sub DataAll_Click()
If isCalculate = False Then
MsgBox "请先进行计算!"
Exit Sub
End If
' 将数据显示在窗体ShowDataForm上
Dim fp As Integer, InputData As String
fp = FreeFile
ShowDataForm.Show , Me
ShowDataForm.Caption = "结果数据文本"
ShowDataForm.Text1 = ""
Open App.Path & "\DATAO1.TXT" For Input As #fp
Do While Not EOF(fp)
Line Input #fp, InputData
ShowDataForm.Text1 = ShowDataForm.Text1 + InputData + vbCrLf
Loop
Close #fp
End Sub
'菜单六,显示图像操作
'显示原图像
Private Sub GraphOrg_Click(Index As Integer)
Select Case Index
Case 1
If HaveReaded = False Then
MsgBox "未形成结构体,请先输入数据!"
Exit Sub
End If
Case 2, 3, 4, 5
If isCalculate = False Then
MsgBox "请先进行计算!"
Exit Sub
End If
End Select
GraphOperType = 0
GraphType = Index
GraphCan.Show , Me
GraphCan.Cls
mStructor.CalScale GraphCan
mStructor.DrawConstruct GraphCan, vbRed
Select Case Index
Case 1 '原图像
GraphCan.times.Visible = False
GraphCan.Caption = "图像显示(原图像)"
Case 2 '变形图
GraphCan.times.Visible = True
GraphCan.Caption = "图像显示(位移图像,蓝色为变形后,位移扩大" + Str$(scale1) + "倍)"
mStructor.GetXYDis 1, scale1
mStructor.DrawConstructDis GraphCan, vbCyan
Case 3 '轴力图
GraphCan.times.Visible = False
GraphCan.Caption = "图像显示(轴力图,长方体高表示轴力大小)"
mStructor.DrawForce GraphCan, vbCyan
Case 4 '综合图
GraphCan.times.Visible = False
GraphCan.Caption = "综合图"
mStructor.DrawConstructDis GraphCan, vbCyan
mStructor.DrawForce GraphCan, vbBlue
Case 5 '结构位移渐变动画
GraphCan.times.Visible = True
GraphCan.Cls
GraphCan.Caption = "结构位移渐变(蓝色为变形后,位移扩大" + Str$(scale1) + "倍)"
mStructor.CalScale GraphCan
Timer1.Enabled = True
Timer1.Interval = 100
End Select
End Sub
Private Sub Timer1_Timer()
K = K + 1
GraphCan.Cls
mStructor.DrawConstruct GraphCan, vbRed
mStructor.StructMove GraphCan, K / 20, vbCyan
If K = 20 Then
Timer1.Enabled = False
K = 0
End If
End Sub
'菜单七,图像操作,全图、放大、缩小、开窗、移动
Private Sub GraphMenu_Click(Index As Integer)
If HaveShowGraph = False Then Exit Sub
GraphOperType = Index
If Index = 0 Then
If HaveReaded = True Then
mStructor.CalScale MainPic
mStructor.DrawConstruct MainPic, vbRed
mStructor.DrawNodeNum MainPic, vbWhite
mStructor.DrawGJnum MainPic, vbMagenta
Else
SetScaleAll MainPic
DrawPicture MainPic, vbRed
End If
End If
End Sub
'菜单八,查询
Private Sub Searchmnu_Click()
isSearch = Not isSearch
If isSearch = True Then
isCatch = True
Else
StatusBar1.Panels(1).Text = ""
StatusBar1.Panels(2).Text = ""
StatusBar1.Panels(3).Text = ""
End If
End Sub
'菜单九,捕捉功能
Private Sub CatchMnu_Click()
If HaveShowGraph = False Then Exit Sub
isCatch = Not (isCatch)
If isCatch = True Then
StatusBar1.Panels(1).Text = "捕捉开启"
StatusBar1.Panels(3).Text = "单击左键进行编辑"
Else
StatusBar1.Panels(1).Text = "捕捉关闭"
StatusBar1.Panels(3).Text = ""
End If
End Sub
'菜单十,帮助文档
Private Sub helpMnu_Click()
setval = WinHelp(Me.hwnd, App.Path + "\help.hlp", &H3&, CLng(0))
End Sub
'菜单操作完毕========================================================================
'以下为以上操作中需要用到的函数
'===================================================================================
'添加节点或杆件或支座
Public Sub EditAdd()
If EditType = 0 Then
tempN = NN1
NodeF.Show , Me
Exit Sub
ElseIf EditType = 1 Then
tempG = NE1
GanJianF.Show , Me
Exit Sub
ElseIf EditType = 2 Then
tempB = NBN1
BaseForm.Show , Me
Exit Sub
Else: Exit Sub
End If
End Sub
'删除节点或杆件或支座
Public Sub EditDelete(tmpX As Single, tmpY As Single)
Dim i As Integer, j As Integer, Dis As Double
Dim SD As Integer, ZD As Integer, Xmid As Double, Ymid As Double
If EditType = 3 Then
For i = 1 To NN1
Dis = Sqr((tmpX - X1(i)) ^ 2 + (tmpY - Y1(i)) ^ 2)
If Dis < 2 * Unit Then
tempN = i
NodeF.Show , Me
Exit Sub
End If
Next i
ElseIf EditType = 4 Then
For i = 1 To NE1
SD = NCO1(i * 2 - 1)
ZD = NCO1(i * 2)
Xmid = (X1(SD) + X1(ZD)) / 2
Ymid = (Y1(SD) + Y1(ZD)) / 2
Dis = Sqr((tmpX - Xmid) ^ 2 + (tmpY - Ymid) ^ 2)
If Dis < 2 * Unit Then
tempG = i
GanJianF.Show , Me
Exit Sub
End If
Next i
ElseIf EditType = 5 Then
For j = 1 To NBN1
Dis = Sqr((tmpX - X1(IB1(3 * j - 2))) ^ 2 + (tmpY - Y1(IB1(3 * j - 2))) ^ 2)
If Dis < 2 * Unit Then
tempB = j
BaseForm.Show , Me
Exit Sub
End If
Next j
End If
End Sub
'捕捉一点并且提供编辑
Public Sub Modify(tmpX As Single, tmpY As Single)
Dim i As Integer, j As Integer, Dis As Double
For i = 1 To NN1
Dis = Sqr((tmpX - X1(i)) ^ 2 + (tmpY - Y1(i)) ^ 2)
If Dis < 2 * Unit Then
For j = 1 To NBN1
If IB1(3 * j - 2) = i Then
tempB = j
BaseForm.Show , Me
Exit Sub
End If
Next j
tempN = i
NodeF.Show , Me
Exit Sub
End If
Next i
Dim SD As Integer, ZD As Integer, Xmid As Double, Ymid As Double
For i = 1 To NE1
SD = NCO1(i * 2 - 1)
ZD = NCO1(i * 2)
Xmid = (X1(SD) + X1(ZD)) / 2
Ymid = (Y1(SD) + Y1(ZD)) / 2
Dis = Sqr((tmpX - Xmid) ^ 2 + (tmpY - Ymid) ^ 2)
If Dis < 2 * Unit Then
tempG = i
GanJianF.Show , Me
Exit Sub
End If
Next i
End Sub
Public Sub NewPrg()
xWmin = -5: yWmin = -5
xWmax = 95: yWmax = 95
Unit = 1
scale1 = 50
MainForm.MainPic.Visible = True
MainForm.MainPic.Cls
MainForm.MainPic.Scale (xWmin, yWmax)-(xWmax, yWmin)
mx0 = 0: my0 = 0: mx = 0: my = 0
BxWmin = 0: ByWmin = 0: BxWmax = 0: ByWmax = 0
Xmin = 0: Xmax = 0: Ymin = 0: Ymax = 0
NN1 = 0: NE1 = 0: NLN1 = 0: NBN1 = 0: E1 = 0: N1 = 0
tempN = 0: tempG = 0: tempB = 0
Erase X1, Y1, NCO1, PROP1, AL1, IB1, REAC1
GraphOperType = -1
GraphType = -1
EditType = -1
HaveShowGraph = False
HaveReaded = False
isCalculate = False
isCatch = False
isSearch = False
IsAddedNode = False
IsAddedBase = False
IsAddedGanJian = False
IsAddedPara = False
HavePrg = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -