mainmodule.bas

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

Attribute VB_Name = "MainModule"
'以下为公有变量声明
'================================================
Public mStructor As New ConstructCls

Public mx0 As Double, my0 As Double, mx As Double, my As Double
Public xWmin As Single, yWmin As Single, xWmax As Single, yWmax As Single
Public BxWmin As Single, ByWmin As Single, BxWmax As Single, ByWmax As Single
Public Xmin As Double, Xmax As Double, Ymin As Double, Ymax As Double
Public Unit As Double


Public NDF As Integer, NNE As Integer '结构参数
Public NN1 As Integer    '结点总数
Public NE1 As Integer   '单元总数
Public NLN1 As Integer  '受荷载的结点总数
Public NBN1 As Integer  '支座结点总数
Public E1 As Double     '材料的弹性模量
Public N1 As Integer    '结点的位移总数，N=NDF*NN,N即为实际结构总刚度矩阵的阶数
Public X1() As Double       '结点的x坐标，一位数组，按结点编号顺序存放
Public Y1() As Double       '结点的y坐标，一位数组，按结点编号顺序存放
Public NCO1() As Integer    '各单元两端的结点号，一维数组，按单元编号顺序存放
Public PROP1() As Double    '各杆件的横截面面积和惯性矩，一维数组，按单元编号顺序存放
Public AL1() As Double      '结点荷载或结点位移，一维数组，按结点编号顺序存放
Public IB1() As Integer     '支座结点的位移状态，一位数组
Public REAC1() As Double    '支座预定位移或结点合力，一维数组，按结点编号顺序存放，对于支座结点来说结点合力
                           '即为结点反力；对于自由结点它的值等于相应的结点荷载
                           '计算前为支座预定位移，计算后为支座反力


Public IsAddedNode As Boolean ' 是否添加过数据的识别
Public IsAddedBase As Boolean
Public IsAddedGanJian As Boolean
Public IsAddedPara As Boolean
Public tempN As Integer         '查询时指向当前点
Public tempG As Integer         '查询时指向当前点
Public tempB As Integer         '查询时指向当前点
Public GraphOperType As Integer '图像操作类型（0 全图，1 放大，2 缩小，3 移动，4 开窗放大）
Public EditType As Integer      '信息编辑类型（0 添加结点，1 添加杆件，2 添加支座，3 删除结点，4 删除杆件，5 删除支座 ）
Public GraphType As Integer    '区别不同图像显示（1 原图像，2 位移图，3 轴力图，4 总图像，5 位移动画）
Public scale1 As Double     '位移放大倍数
Public K As Integer         '动画中控制时钟控件

Public HavePrg As Boolean       '是否有工程存在
Public HaveShowGraph As Boolean '主窗体中是否显示有图像
Public HaveReaded As Boolean   '是否生成结构体
Public isCalculate As Boolean  '是否完成计算
Public isCatch As Boolean       '是否打开捕捉功能
Public isSearch As Boolean      '是否打开查询功能


Public Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long

'一、以下为调用API函数实现GraphCan中的图形保存成图像
'=========================================================================================================
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function EmptyClipboard Lib "user32" () As Long

Public Declare Function SetClipboardData Lib "user32" _
                                    (ByVal wFormat As Long, ByVal hMem As Long) As Long

Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function BitBlt Lib "gdi32" _
                                    (ByVal hDestDC As Long, ByVal X As Long, _
                                    ByVal Y As Long, ByVal nWidth As Long, _
                                    ByVal nHeight As Long, ByVal hSrcDC As Long, _
                                    ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Public Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
                                    (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
                                    ByVal lpOutput As String, lpInitData As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, _
                                                                ByVal nHeight As Long) As Long

Public Declare Function CloseClipboard Lib "user32" () As Long

'指定范围的屏幕截图
Public Sub ScrnCap(Left As Long, Top As Long, Right As Long, Bottom As Long)

    Dim rWidth As Long
    Dim rHeight As Long
    Dim SourceDC As Long
    Dim DestDC As Long
    Dim BHandle As Long
    Dim Wnd As Long
    rWidth = Right - Left
    rHeight = Bottom - Top
    SourceDC = CreateDC("DISPLAY", 0, 0, 0)
    DestDC = CreateCompatibleDC(SourceDC)
    BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
    SelectObject DestDC, BHandle
    BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Left, Top, &HCC0020
'    Wnd = Screen.ActiveForm.hwnd
    OpenClipboard Wnd
    EmptyClipboard
    SetClipboardData 2, BHandle
    CloseClipboard
    DeleteDC DestDC
    ReleaseDC 0, SourceDC
End Sub


'二、以下为画图方法
'=====================================================================================
'设定坐标范围1
Public Sub SetScale(panel As Object, Xtemp As Double, Ytemp As Double)
    Dim i As Integer
    '调整panel的scale
    Xmin = xWmin: Xmax = xWmax: Ymin = yWmin: Ymax = yWmax
    If Xmin > Xtemp Then Xmin = Xtemp
    If Xmax < Xtemp Then Xmax = Xtemp
    If Ymin > Ytemp Then Ymin = Ytemp
    If Ymax < Ytemp Then Ymax = Ytemp
    Unit = (Xmax - Xmin) / 100
    If xWmin <> Xmin Or xWmax <> Xmax Or yWmin <> Ymin Or yWmax <> Ymax Then
        xWmin = xWmin - 4 * Unit: xWmax = xWmax + 4 * Unit
        yWmin = yWmin - 4 * Unit: yWmax = yWmax + 4 * Unit
        panel.Cls
        panel.Scale (xWmin, yWmax)-(xWmax, yWmin)
    End If
End Sub
'设定坐标范围2
Public Sub SetScaleAll(panel As Object)
    Dim i As Integer
    '调整panel的scale
    Xmin = X1(1): Xmax = X1(1): Ymin = Y1(1): Ymax = Y1(1)
    For i = 1 To NN1
        If X1(i) < Xmin Then Xmin = X1(i)
        If X1(i) > Xmax Then Xmax = X1(i)
        If Y1(i) < Ymin Then Ymin = Y1(i)
        If Y1(i) > Ymax Then Ymax = Y1(i)
    Next i
    Unit = (Xmax - Xmin) / 100
    xWmin = Xmin - 4 * Unit: xWmax = Xmax + 4 * Unit
    yWmin = Ymin - 4 * Unit: yWmax = Ymax + 4 * Unit
    panel.Scale (xWmin, yWmax)-(xWmax, yWmin)
End Sub

'未形成结构体之前显示图像
Public Sub DrawPicture(panel As Object, color As ColorConstants)
    '节点
    panel.Cls
    panel.DrawMode = vbCopyPen
    If NN1 > 0 Then
        For i = 1 To NN1
            panel.PSet (X1(i), Y1(i)), color
            panel.Circle (X1(i), Y1(i)), 0.5 * Unit, color
            panel.ForeColor = vbWhite
            panel.CurrentX = X1(i): panel.CurrentY = Y1(i)
            panel.Print i
        Next i
    End If
    '杆件
    If NE1 > 0 Then
        Dim SD As Integer, ZD As Integer, Xmid As Double, Ymid As Double
        Dim dX As Double, dY As Double, ang As Single
        For i = 1 To NE1
            SD = NCO1(i * 2 - 1)
            ZD = NCO1(i * 2)
            SlgGJ X1(SD), Y1(SD), X1(ZD), Y1(ZD), color, panel
            Xmid = (X1(SD) + X1(ZD)) / 2
            Ymid = (Y1(SD) + Y1(ZD)) / 2
            panel.ForeColor = vbMagenta
            panel.CurrentX = Xmid
            panel.CurrentY = Ymid
            panel.Print i
        Next i
    End If
    '支座
    If NBN1 > 0 Then
        Dim PN As Integer, BX As Integer, BY As Integer
        For i = 1 To NBN1
            '对应的结点编号
            PN = IB1((NDF + 1) * (i - 1) + 1)
            '判断结点的位移状态，变形方向，以画不同的支座三角形
            BX = IB1((NDF + 1) * (i - 1) + 2)
            BY = IB1((NDF + 1) * (i - 1) + 3)
            SlgBottom X1(PN), Y1(PN), BX, BY, panel, color
        Next i
    End If
    HaveShowGraph = True
End Sub


'已知两点坐标画杆件
Public Sub SlgGJ(xs As Double, ys As Double, xz As Double, yz As Double, color As ColorConstants, panel As Object)
    Dim dX As Double, dY As Double, ang As Single, pi As Double
    pi = 3.1415926535
    dX = xz - xs
    dY = yz - ys
    If dX = 0 And dY > 0 Then
        ang = pi / 2
    ElseIf dX = 0 And dY < 0 Then
        ang = pi * 1.5
    Else
        ang = Atn(dY / dX)
        If dX < 0 Then ang = pi + ang
        If dX > 0 And dY <= 0 Then ang = 2 * pi + ang
    End If
    panel.Line (xs + 0.5 * Unit * Cos(ang), ys + 0.5 * Unit * Sin(ang)) _
                -(xz - 0.5 * Unit * Cos(ang), yz - 0.5 * Unit * Sin(ang)), color

End Sub

'已知一点坐标画基座
Public Sub SlgBottom(pX As Double, pY As Double, BX As Integer, BY As Integer, panel As Object, color As ColorConstants)
     Dim i As Integer, Xtemp As Double, Ytemp As Double
     If BY <> 0 Then
        panel.Circle (pX, pY - 2 * Unit * BY), 0.5 * Unit, color
        panel.Line (pX, pY - 0.5 * Unit * BY)-(pX, pY - 1.5 * Unit * BY), color
        panel.Line (pX - 2.5 * Unit, pY - 2 * Unit * BY)-(pX - 0.5 * Unit, pY - 2 * Unit * BY), color
        panel.Line (pX + 2.5 * Unit, pY - 2 * Unit * BY)-(pX + 0.5 * Unit, pY - 2 * Unit * BY), color
        For i = 0 To 10
            If i <> 5 Then
            Xtemp = pX - (2.5 - 0.5 * i) * Unit
            Ytemp = pY - 2 * Unit * BY
            panel.Line (Xtemp, Ytemp)-(Xtemp - 0.25 * Unit, Ytemp - 0.25 * Unit * BY), color
            End If
        Next i
     End If
     If BX <> 0 Then
        panel.Circle (pX - 2 * Unit * BX, pY), 0.5 * Unit, color
        panel.Line (pX - 0.5 * Unit * BX, pY)-(pX - 1.5 * Unit * BX, pY), color
        panel.Line (pX - 2 * Unit * BX, pY - 2.5 * Unit)-(pX - 2 * Unit * BX, pY - 0.5 * Unit), color
        panel.Line (pX - 2 * Unit * BX, pY + 2.5 * Unit)-(pX - 2 * Unit * BX, pY + 0.5 * Unit), color
        For i = 0 To 10
            If i <> 5 Then
                Xtemp = pX - 2 * Unit * BX
                Ytemp = pY - (2.5 - 0.5 * i) * Unit
                panel.Line (Xtemp, Ytemp)-(Xtemp - 0.25 * Unit * BX, Ytemp - 0.25 * Unit), color
            End If
        Next i
     End If
End Sub

'三、以下为数据显示操作
'=============================================================================================================
'取节点坐标数据，显示在panel中
Public Sub GetNodeData(panel As Object)
    If NN1 = 0 Then Exit Sub
    panel.Text = ""
    Dim i As Integer
    panel.Text = panel.Text + "NODE DATA" + vbCrLf
    panel.Text = panel.Text + "NODE              X                Y" + vbCrLf
    For i = 1 To NN1
        panel.Text = panel.Text + Format(i, "00") + "           " + Format(X1(i), "0.00") + "           " _
                        + Format(Y1(i), "0.00") + vbCrLf
    Next i
    
End Sub

'取杆件单元已知数据，显示在panel中
Public Sub GetGJData(panel As Object)
    If NE1 = 0 Then Exit Sub
    panel.Text = ""
    Dim i As Integer, K1 As Integer, K2 As Integer, j As Integer
    panel.Text = panel.Text + " ELEMENT CONNECTIVITY AND PROPERTIES" + vbCrLf
    panel.Text = panel.Text + "    ELEMENT    START NODE    END NODE       AREA" + vbCrLf
    For i = 1 To NE1
        panel.Text = panel.Text + Format(i, "00") + "        " + Format(NCO1(i * 2 - 1), "00") + _
                        "       " + Format(NCO1(i * 2), "00") + "        " + Format(PROP1(i), "0.00000") + vbCrLf
    Next i

End Sub

'取受荷载的节点数据，显示在panel中
Public Sub GetNodeLoad(panel As Object)
    If NN1 = 0 Then Exit Sub
    panel.Text = ""
    Dim i As Integer
    panel.Text = panel.Text + " NODAL LOADS" + vbCrLf
    panel.Text = panel.Text + "NODE         PX          PY" + vbCrLf
    For i = 1 To NN1
        If AL1(2 * i - 1) <> 0 Or AL1(2 * i) <> 0 Then
            panel.Text = panel.Text + Format(i, "00") + "       " + Format(AL1(2 * i - 1), "0.00") + _
                            "       " + Format(AL1(2 * i), "0.00") + vbCrLf
        End If
    Next i
End Sub

'取支座已知数据，显示在Panel中
Public Sub GetBaseData(panel As Object)
    If NBN1 = 0 Then Exit Sub
    panel.Text = ""
    Dim i As Integer
    panel.Text = panel.Text + " BOUNDARY CONDITION DATA" + vbCrLf
    panel.Text = panel.Text + "                       STATUS             PRESCRIBED VALUES" + vbCrLf
    panel.Text = panel.Text + "              (0:PRESCRIBED, 1:FREE)" + vbCrLf
    panel.Text = panel.Text + "NODE        U         V                U         V" + vbCrLf
    For i = 1 To NBN1
        panel.Text = panel.Text + Str$(IB1((NDF + 1) * (i - 1) + 1)) + "       " _
                    + Str$(IB1((NDF + 1) * (i - 1) + 2)) + "       " + Str$(IB1((NDF + 1) * (i - 1) + 3)) _
                    + "       " + Format(REAC1(NDF * i - 1), "0.00") + "       " + Format(REAC1(NDF * i), "0.00") + vbCrLf
    Next i
End Sub

'显示全部的已知数据在panel上
Public Sub GetKnowData(panel As Object)
    Dim i As Integer
    panel.Text = ""
    panel.Text = panel.Text + Str$(NN1) + "  " + Str$(NE1) + "  " + Str$(NLN1) + "  " + Str$(NBN1) _
                    + "  " + Str$(E1) + vbCrLf
    '写结点坐标
    ' WRITE NODAL COORDINATES IN ARRAY X AND Y
    If NN1 > 0 Then
        For i = 1 To NN1
            panel.Text = panel.Text + Str$(i) + "  " + Format(X1(i), "0.00") + "  " + Format(Y1(i), "0.00") + vbCrLf
        Next i
    End If
    'WRITE ELEMENT CONNECTIVITY IN ARRAY NCO AND ELEMENT PROPERTIES IN ARRAY PROP
    If NE1 > 0 Then
        For i = 1 To NE1
            panel.Text = panel.Text + Str$(i) + "  " + Str$(NCO1(i * 2 - 1)) + "  " + Str$(NCO1(i * 2)) + _
                            "  " + Format(PROP1(i), "0.000000") + vbCrLf
        Next i
    End If
    'READ THE NODAL LOADS AND STORE THEM IN ARRAY AL
    If NN1 > 0 Then
        For i = 1 To NN1
            If AL1(2 * i - 1) <> 0 Or AL1(2 * i) <> 0 Then
                panel.Text = panel.Text + Str$(i) + "  " + Format(AL1(2 * i - 1), "0.00") + "  " _
                            + Format(AL1(2 * i), "0.00") + vbCrLf
            End If
        Next i
    End If
    If NBN1 > 0 Then
        For i = 1 To NBN1
            panel.Text = panel.Text + Str$(IB1((NDF + 1) * (i - 1) + 1)) + "  " + _
                        Str$(IB1((NDF + 1) * (i - 1) + 2)) + "  " + Str$(IB1((NDF + 1) * (i - 1) + 3)) + _
                        "  " + Format(REAC1(NDF * i - 1), "0.0") + "  " + Format(REAC1(NDF * i), "0.0") + vbCrLf
        Next i
    End If
End Sub