mainform.frm

该程序是按照矩阵位移法的后处理法的基本原理和分析过程

      Begin VB.Menu GraphOrg 
         Caption         =   "原图像"
         Index           =   1
      End
      Begin VB.Menu GraphOrg 
         Caption         =   "变形图"
         Index           =   2
      End
      Begin VB.Menu GraphOrg 
         Caption         =   "轴力图"
         Index           =   3
      End
      Begin VB.Menu GraphOrg 
         Caption         =   "综合图"
         Index           =   4
      End
      Begin VB.Menu GraphOrg 
         Caption         =   "结构渐变动画"
         Index           =   5
      End
   End
   Begin VB.Menu GraphOperate 
      Caption         =   "图像操作"
      Begin VB.Menu GraphMenu 
         Caption         =   "全图"
         Index           =   1
      End
      Begin VB.Menu GraphMenu 
         Caption         =   "放大"
         Index           =   2
      End
      Begin VB.Menu GraphMenu 
         Caption         =   "缩小"
         Index           =   3
      End
      Begin VB.Menu GraphMenu 
         Caption         =   "移动"
         Index           =   4
      End
      Begin VB.Menu GraphMenu 
         Caption         =   "开窗放大"
         Index           =   5
      End
      Begin VB.Menu Searchmnu 
         Caption         =   "查看"
      End
      Begin VB.Menu CatchMnu 
         Caption         =   "捕捉"
      End
   End
   Begin VB.Menu helpMnu 
      Caption         =   "帮助"
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'以下对应界面右边的命令操作
'====================================================================================
'改变时弹出相应的输入框
Private Sub Combo11_Click()
    If HavePrg = False Then
        MsgBox "请先新建工程！"
        Exit Sub
    End If
    EditType = -1
    If Combo11.Text = Combo11.List(0) Then
       ParameterForm.Show , Me
    ElseIf Combo11.Text = Combo11.List(1) Then
        NodeF.Show , Me
    ElseIf Combo11.Text = Combo11.List(2) Then
       GanJianF.Show , Me
    ElseIf Combo11.Text = Combo11.List(3) Then
        BaseForm.Show , Me
    ElseIf Combo11.Text = Combo11.List(4) Then
        mStructor.SetData
        isCalculate = False
    End If
End Sub

'通过文件输入数据
Private Sub CmdOpen_Click()
    If HavePrg = False Then
        MsgBox "请先新建工程！"
        Exit Sub
    End If
    On Error GoTo nocation
    CoD1.CancelError = True
    CoD1.InitDir = App.Path
    CoD1.Filter = "文本文件 | *.txt"
    CoD1.ShowOpen
    mStructor.InputData (CoD1.filename)
    Exit Sub
nocation:
   Exit Sub
End Sub

'生成图像
Private Sub CmdGraph_Click()
    If HaveReaded = False Then
        MsgBox "未形成结构体！"
        Exit Sub
    End If
    GraphOperType = 0
    mStructor.CalScale MainPic
    mStructor.DrawConstruct MainPic, vbRed
    mStructor.DrawNodeNum MainPic, vbWhite
    mStructor.DrawGJnum MainPic, vbMagenta
    HaveShowGraph = True
    isCatch = False
    StatusBar1.Panels(1).Text = "捕捉关闭"
    StatusBar1.Panels(3).Text = ""
End Sub

'处理，即计算过程
Private Sub CmdCompute_Click()
    If HaveReaded = False Then
        MsgBox "未形成结构体！"
        Exit Sub
    End If
    If isCalculate = True Then Exit Sub
    mStructor.OUTPUTknowData App.Path & "\DATAO1.TXT"
    mStructor.calculate
    isCatch = False
    isSearch = False
    StatusBar1.Panels(1).Text = ""
    StatusBar1.Panels(2).Text = ""
    StatusBar1.Panels(3).Text = ""
    
    '导出文件
    mStructor.OUTPUTresult App.Path & "\DATAO1.TXT"
    '将数据显示在窗体ShowDataForm上
    If Check1.Value = 0 Then Exit Sub
    
    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 CmdExit_Click()
    Unload Me
End Sub
'===========================================================================

'以下对应工具栏选项操作
'===========================================================================
'新建工程
Private Sub New_Click()
    Call NewPrg
End Sub
'打开
Private Sub Command2_Click()
    If HavePrg = False Then
        MsgBox "请先新建工程！"
        Exit Sub
    End If
    On Error GoTo nocation
    CoD1.CancelError = True
    CoD1.InitDir = App.Path
    CoD1.Filter = "文本文件 | *.txt"
    CoD1.ShowOpen
    mStructor.InputData (CoD1.filename)
    mStructor.CalScale MainPic
    mStructor.SetDataShow
    Exit Sub
nocation:
   Exit Sub

End Sub
'保存
Private Sub Command3_Click()
    GetKnowData ShowDataForm.Text1
    On Error GoTo nocation
    CoD1.CancelError = True
    CoD1.InitDir = App.Path
    CoD1.Filter = "文本文件 | *.txt"
    CoD1.ShowSave
    Dim fp As Integer  ' 打开文件号
    fp = FreeFile
    Open CoD1.filename For Output As #fp
    Print #fp, ShowDataForm.Text1.Text
    Close #fp
nocation:
    Exit Sub
End Sub

'添加结点
Private Sub Command5_Click()
    EditType = 0
    EditAdd
End Sub
'添加杆件单元
Private Sub Command4_Click()
    EditType = 1
    EditAdd
End Sub
'添加支座
Private Sub Command6_Click()
    EditType = 2
    EditAdd
End Sub
'删除结点
Private Sub Command7_Click()
    EditType = 3
    isCatch = True
End Sub
'删除杆件
Private Sub Command18_Click()
    EditType = 4
    isCatch = True
End Sub
'删除支座
Private Sub Command19_Click()
    EditType = 5
    isCatch = True
End Sub

'全图
Private Sub Command29_Click()
    If HaveShowGraph = False Then Exit Sub
    GraphOperType = 1
    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 Sub
'放大
Private Sub Command11_Click()
    GraphOperType = 2
End Sub
'缩小
Private Sub Command13_Click()
    GraphOperType = 3
End Sub
'移动
Private Sub Command9_Click()
    GraphOperType = 4
End Sub
'开窗放大
Private Sub Command8_Click()
    GraphOperType = 5
End Sub

'查询功能
Private Sub Command30_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 Form_Load()
    MainPic.Visible = False
    NDF = 2
    NNE = 2
    HavePrg = False
    NewPrg
End Sub

'主窗口缩放时对图像做相应缩放
Private Sub Form_Resize()
    If Height > 1100 Then MainPic.Height = Height - 1800
    If Width > 2280 Then MainPic.Width = Width - 2280
    Combo11.Left = MainPic.Width + 225
    CmdOpen.Left = MainPic.Width + 225
    CmdGraph.Left = MainPic.Width + 225
    CmdCompute.Left = MainPic.Width + 225
    CmdExit.Left = MainPic.Width + 225
    Check1.Left = MainPic.Width + 225
    If HaveShowGraph = True Then
        MainPic.Scale (xWmin, yWmax)-(xWmax, yWmin)
        mStructor.DrawConstruct MainPic, vbRed
        mStructor.DrawNodeNum MainPic, vbWhite
        mStructor.DrawGJnum MainPic, vbMagenta
    End If

End Sub

'以下为鼠标在图形框内的操作
'===============================================================================
Private Sub MainPic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If HaveShowGraph = False Then Exit Sub
     MainPic.DrawMode = vbXorPen
     MainPic.DrawWidth = 1
     mx0 = X: my0 = Y
     If Button = 1 Then ' 鼠标左键
        If GraphOperType = 2 Then   '放大
        ElseIf GraphOperType = 3 Then   '缩小
        ElseIf GraphOperType = 4 Then   '移动
        ElseIf GraphOperType = 5 Then  '开窗放大
            MainPic.Line (mx0, my0)-(X, Y), vbCyan, B
            mx = X
            my = Y
        End If
    End If
    
End Sub

Private Sub MainPic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If HaveShowGraph = False Then Exit Sub
    MainPic.SetFocus
    MainPic.DrawWidth = 1
    MainPic.DrawMode = vbXorPen
    If Button = 1 Then                              '鼠标左键  => 开窗
       If GraphOperType = 2 Then   '放大
'        ElseIf GraphOperType = 3 Then   '缩小
'        ElseIf GraphOperType = 4 Then   '移动
       ElseIf GraphOperType = 5 Then   '开窗放大
           MainPic.Line (mx0, my0)-(mx, my), vbCyan, B
           MainPic.Line (mx0, my0)-(X, Y), vbCyan, B
           mx = X
           my = Y
       End If
       Exit Sub
    End If
    StatusBar1.Panels(2).Text = Format(X, "0.####") & "," & Format(Y, "0.####")
    If isCatch = True Then mStructor.GetProperties X, Y, StatusBar1, MainPic
End Sub

Private Sub MainPic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If HaveShowGraph = False Then Exit Sub
    MainPic.DrawMode = vbXorPen
    MainPic.DrawWidth = 1
    mx = X: my = Y
    If Button = 1 Then
        If GraphOperType = 2 Then   '放大
            xWmin = mx - (mx - xWmin) * 0.8
            xWmax = mx + (xWmax - mx) * 0.8
            yWmin = my - (my - yWmin) * 0.8
            yWmax = my + (yWmax - my) * 0.8
        ElseIf GraphOperType = 3 Then   '缩小
            xWmin = mx - (mx - xWmin) * 1.2
            xWmax = mx + (xWmax - mx) * 1.2
            yWmin = my - (my - yWmin) * 1.2
            yWmax = my + (yWmax - my) * 1.2
        ElseIf GraphOperType = 4 Then   '移动
            If Abs(mx - mx0) < Unit Or Abs(my - my0) < Unit Then Exit Sub
            xWmin = xWmin + mx0 - mx
            xWmax = xWmax + mx0 - mx
            yWmin = yWmin + my0 - my
            yWmax = yWmax + my0 - my
        ElseIf GraphOperType = 5 Then  '开窗放大
            If Abs(mx - mx0) < Unit Or Abs(my - my0) < Unit Then Exit Sub
            MainPic.Line (mx0, my0)-(mx, my), vbCyan, B        '移动
            xWmin = IIf(mx < mx0, mx, mx0)
            xWmax = IIf(mx < mx0, mx0, mx)
            yWmin = IIf(my < my0, my, my0)
            yWmax = IIf(my < my0, my0, my)
        End If
        If EditType = 3 Or EditType = 4 Or EditType = 4 Then EditDelete X, Y: Exit Sub
        If isCatch = True Then
            Modify X, Y
        End If
    End If
    MainPic.Scale (xWmin, yWmax)-(xWmax, yWmin)
    If HaveReaded = True Then
        mStructor.DrawConstruct MainPic, vbRed
        mStructor.DrawNodeNum MainPic, vbWhite
        mStructor.DrawGJnum MainPic, vbMagenta
    Else
        DrawPicture MainPic, vbRed
    End If
End Sub

'以下对应菜单命令操作
'=============================================================================
'菜单一，文件
'新建工程
Private Sub NewP_Click()
    Call NewPrg
End Sub
'打开文件
Private Sub OpenFile_Click()
    If HavePrg = False Then
        MsgBox "请先新建工程！"
        Exit Sub
    End If
    On Error GoTo nocation
    CoD1.CancelError = True
    CoD1.InitDir = App.Path
    CoD1.Filter = "文本文件 | *.txt"
    CoD1.ShowOpen
    mStructor.InputData (CoD1.filename)
    Exit Sub
nocation:
    Exit Sub
End Sub
'保存已知数据文本
Private Sub KownDataFile_Click()
    If HaveReaded = False Then
        MsgBox "未形成结构体！"
        Exit Sub
    End If
    GetKnowData ShowDataForm.Text1
    On Error GoTo nocation
    CoD1.CancelError = True
    CoD1.InitDir = App.Path
    CoD1.Filter = "文本文件 | *.txt"
    CoD1.ShowSave
    Dim fp As Integer  ' 打开文件号
    fp = FreeFile
    Open CoD1.filename For Output As #fp
    Print #fp, ShowDataForm.Text1.Text
    Close #fp
    Exit Sub
nocation: