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

📄 mainform.frm

📁 该程序是按照矩阵位移法的后处理法的基本原理和分析过程
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    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 + -