图形输入.bas

钢筋混凝土框架结构设计计算源程序

Attribute VB_Name = "module11"
Option Explicit
Public Drawp As Integer
Public Gridx, Gridy As Integer
Public Gridture, Foptions As Integer
Public Bcolor As Long
Public Lxadd, Lyadd As Integer
Public Gridxxxx, Gridyyyy As Integer
Public Lxed(0 To 36) As Single
Public Lyed(0 To 36) As Single
Public Ked As Integer
Public Ced As Integer
Public Buttoned As Integer
Public Wanggelx As Integer
Public Wanggezhj As Single
Public xmd, ymd, xmd1, ymd1 As Integer
Sub 杆件图1(Pict As PictureBox)
    Pict.Cls
    Dim i, j As Integer
    Dim tempx, tempy As Single
    Call Gridxy(Pict)
    If Kuashu > 0 Then
        For i = 0 To Kuashu
            tempx = Lx(i) * 1000 + tempx
            Pict.Line (tempx / Gridx, 0)-(tempx / Gridx, Cengtot * 1000 / Gridy)
            tuxing1.command.Text = tuxing1.command.Text + Str(tempx) + "," + Str(0) + "-" + Str(tempx) + "," + Str(Cengtot * 1000) + vbCrLf
        Next i
        For j = 1 To Cengshu
            tempy = Ly(j) * 1000 + tempy
            Pict.Line (0, tempy / Gridy)-(Kuatot * 1000 / Gridx, tempy / Gridy)
            tuxing1.command.Text = tuxing1.command.Text + Str(0) + "," + Str(tempy) + "-" + Str(Kuatot * 1000) + "," + Str(tempy) + vbCrLf
        Next j
    End If
    Call Zhizuo(Pict)
End Sub
Sub 杆件图2(Pict As PictureBox)
    Dim i, j, k, L As Integer
    Dim tempx, tempy As Single
    For k = 1 To Ked
        Pict.Line (Lxed(k) * 1000 / Gridx, 0)-(Lxed(k) * 1000 / Gridx, Cengtot * 1000 / Gridy), vbBlue
        Pict.Circle (Lxed(k) * 1000 / Gridx, 0), 150 / Gridx, vbBlue
        Pict.Circle (Lxed(k) * 1000 / Gridx, Cengtot * 1000 / Gridy), 150 / Gridx, vbBlue
        Pict.Circle (Lxed(k) * 1000 / Gridx, Cengtot * 1000 / Gridy / 2), 150 / Gridx, vbBlue
    Next k
    For L = 1 To Ced
        Pict.Line (0, Lyed(L) * 1000 / Gridy)-(Kuatot * 1000 / Gridx, Lyed(L) * 1000 / Gridy), vbBlue
        Pict.Circle (0, Lyed(L) * 1000 / Gridy), 150 / Gridy, vbBlue
        Pict.Circle (Kuatot * 1000 / Gridx, Lyed(L) * 1000 / Gridy), 150 / Gridy, vbBlue
        Pict.Circle (Kuatot * 1000 / Gridx / 2, Lyed(L) * 1000 / Gridy), 150 / Gridy, vbBlue
    Next L
End Sub
Sub 杆件图3(Pict As PictureBox)
    Dim i, j, k, L As Integer
    Dim tempx, tempy As Single
    Pict.Cls
    If Kuashu > 0 Then
        For i = 0 To Kuashu
            tempx = Lx(i) * 1000 + tempx
            Pict.Line (tempx / Gridx, 0)-(tempx / Gridx, Cengtot * 1000 / Gridy)
        Next i
        For j = 1 To Cengshu
            tempy = Ly(j) * 1000 + tempy
            Pict.Line (0, tempy / Gridy)-(Kuatot * 1000 / Gridx, tempy / Gridy)
        Next j
    End If
    Call Zhizuo(Pict)
    For k = 1 To Ked
        Pict.Line (Lxed(k) * 1000 / Gridx + xmd1 - xmd, 0)-(Lxed(k) * 1000 / Gridx + xmd1 - xmd, Cengtot * 1000 / Gridy), vbBlue
        Pict.Circle (Lxed(k) * 1000 / Gridx + xmd1 - xmd, 0), 150 / Gridx, vbBlue
        Pict.Circle (Lxed(k) * 1000 / Gridx + xmd1 - xmd, Cengtot * 1000 / Gridy), 150 / Gridx, vbBlue
        Pict.Circle (Lxed(k) * 1000 / Gridx + xmd1 - xmd, Cengtot * 1000 / Gridy / 2), 150 / Gridx, vbBlue
    Next k
    For L = 1 To Ced
        Pict.Line (0, Lyed(L) * 1000 / Gridy + ymd1 - ymd)-(Kuatot * 1000 / Gridx, Lyed(L) * 1000 / Gridy + ymd1 - ymd), vbBlue
        Pict.Circle (0, Lyed(L) * 1000 / Gridy + ymd1 - ymd), 150 / Gridy, vbBlue
        Pict.Circle (Kuatot * 1000 / Gridx, Lyed(L) * 1000 / Gridy + ymd1 - ymd), 150 / Gridy, vbBlue
        Pict.Circle (Kuatot * 1000 / Gridx / 2, Lyed(L) * 1000 / Gridy + ymd1 - ymd), 150 / Gridy, vbBlue
    Next L
End Sub
Sub Zhizuo(Pict As PictureBox)
    Dim i, j As Integer
    Dim bilix, biliy, temp, temp1 As Single
    temp = Lx(1)
    For i = 2 To Kuashu
        If temp > Lx(i) Then temp = Lx(i)
    Next i
    bilix = 1000 / Gridx
    biliy = 1000 / Gridy
    For i = 0 To Kuashu
        temp1 = temp1 + Lx(i)
        Pict.Line (temp1 * bilix - temp / 4 * bilix, 0)-(temp1 * bilix + temp / 4 * bilix, 0)
    Next i
    temp1 = 0
    For i = 0 To Kuashu
        temp1 = temp1 + Lx(i)
        For j = 1 To 3
            Pict.Line (temp1 * bilix + (1 + j - 2.5) * temp / 10 * bilix, 0)-(temp1 * bilix + (j - 1 - 2.5) * temp / 10 * bilix, -temp / 10 * biliy)
        Next j
    Next i
End Sub
Sub Gridxy(Pict As PictureBox)
    Dim i, j
    If Foptions = 0 Then Gridture = 1: Bcolor = vbRed
    If Gridture = 1 Then
        If tuxing1.bb / Gridxxxx < Pict.Width / Gridx * 5 Then
        For i = 0 To Int(tuxing1.bb / Gridxxxx)
            For j = 0 To Int(tuxing1.cc / Gridyyyy)
                If Wanggelx = 0 Then
                    Pict.PSet (i * Gridxxxx / Gridx, j * Gridyyyy / Gridy), Bcolor
                Else
                    Pict.FillColor = Bcolor: Pict.FillStyle = 0
                    Pict.Circle (i * Gridxxxx / Gridx, j * Gridyyyy / Gridy), Wanggezhj / Gridx, Bcolor
                    Pict.FillStyle = 1
                End If
            Next j
        Next i
        Else
            tuxing1.command.Text = tuxing1.command.Text + "网格过密，无法显示!" + vbCrLf
        End If
    Else
        tuxing1.command.Text = "Don't draw grid"
    End If
End Sub
Sub Lxaddpro(Yzuo As Single)
    Dim i, j, M, L As Integer
    Dim tempxx As Single
    Yzuo = Abs(Yzuo)
    Lxadd = Abs(Lxadd)
    i = 0: j = 0: M = 0: L = 0: tempxx = 0
    For M = 1 To Kuashu
        tempxx = tempxx + Lx(M)
        If tempxx * 1000 = Int(Lxadd) * Gridx Then L = 1
    Next M
    If L = 0 Then
        If Lx(1) = 0 Then
            Kuatot = Lxadd * Gridx / 1000: Lx(1) = Lxadd * Gridx / 1000
            Ly(1) = Yzuo * Gridy / 1000: Cengtot = Yzuo * Gridy / 1000
            Cengshu = 1: Kuashu = 1
        Else
            If Lxadd * Gridx > Kuatot * 1000 Then
                Lx(Kuashu + 1) = Lxadd * Gridx / 1000 - Kuatot
                Kuatot = Lxadd * Gridx / 1000
            Else
                tempxx = 0
                Do
'                If i = 36 Then Exit Do
                tempxx = tempxx + Lx(i)
                If tempxx * 1000 + Lx(i + 1) * 1000 > Lxadd * Gridx Then
                    For j = Kuashu + 1 To i + 3 Step -1
                        Lx(j) = Lx(j - 1)
                    Next j
                    Lx(i + 2) = tempxx + Lx(i + 1) - Lxadd * Gridx / 1000
                    Lx(i + 1) = Lxadd * Gridx / 1000 - tempxx
                    Exit Do
                End If
                i = i + 1
                Loop
            End If
        Kuashu = Kuashu + 1
        End If
        Call 杆件图1(tuxing1.Picture1)
    End If
End Sub
Sub Lyaddpro(Xzuo As Single)
    Dim i, j, N, k As Integer
    Dim tempyy As Single
    i = 0: j = 0: N = 0: k = 0: tempyy = 0
    Lyadd = Abs(Lyadd)
    For N = 1 To Cengshu + 1
        tempyy = tempyy + Ly(N)
        If tempyy * 1000 = Lyadd * Gridy Then k = 1
    Next N
    If k = 0 Then
        If Ly(1) = 0 Then
            Cengtot = Int(Lyadd * Gridy) / 1000: Ly(1) = Int(Lyadd * Gridy) / 1000
            Lx(1) = Int(Xzuo * Gridx) / 1000: Kuatot = Int(Xzuo * Gridx) / 1000
            Cengshu = 1: Kuashu = 1
        Else
            If Lyadd * Gridy > Cengtot * 1000 Then
                Ly(Cengshu + 1) = Int(Lyadd * Gridy) / 1000 - Cengtot
                Cengtot = Int(Lyadd * Gridy) / 1000
            Else
                tempyy = 0
                Do
'                If i = 36 Then Exit Do
                tempyy = tempyy + Ly(i)
                If tempyy * 1000 + Ly(i + 1) * 1000 > Lyadd * Gridy Then
                    For j = Cengshu + 1 To i + 3 Step -1
                        Ly(j) = Ly(j - 1)
                    Next j
                    Ly(i + 2) = Ly(i + 1) + tempyy - Int(Lyadd * Gridy) / 1000
                    Ly(i + 1) = Int(Lyadd * Gridy) / 1000 - tempyy
                    Exit Do
                End If
                i = i + 1
                Loop
            End If
            Cengshu = Cengshu + 1
        End If
        Call 杆件图1(tuxing1.Picture1)
        End If
End Sub
Sub Dellxy(Lxdel, Lydel)
    Dim i, j, M, N, k, L, tempx, tempy
    i = j = M = N = k = L = 0
    tempx = 0: tempy = 0
    If Abs(Lxdel * Gridx - Kuatot * 1000) < Gridx / 2 Then
        k = 1
        Kuatot = Kuatot - Lx(Kuashu)
        Lx(Kuashu) = 0
    Else
        For i = 1 To Kuashu - 1
            tempx = tempx + Lx(i)
            If Abs(Lxdel * Gridx - tempx * 1000) < Gridx / 2 Then
                k = 1: Lx(i) = Lx(i) + Lx(i + 1)
                For j = i + 1 To Kuashu - 1
                    Lx(j) = Lx(j + 1)
                Next j
                Lx(Kuashu) = 0
            End If
        Next i
    End If
    Kuashu = Kuashu - k
    If Abs(Lydel * Gridy - Cengtot * 1000) < Gridy / 2 Then
        L = 1
        Cengtot = Cengtot - Ly(Cengshu)
        Ly(Cengshu) = 0
    Else
        For M = 1 To Cengshu - 1
            tempy = tempy + Ly(M)
            If Abs(Lydel * Gridy - tempy * 1000) < Gridy / 2 Then
                L = 1: Ly(M) = Ly(M) + Ly(M + 1)
                For N = M + 1 To Cengshu - 1
                    Ly(N) = Ly(N + 1)
                Next N
                Ly(Cengshu) = 0
            End If
        Next M
    End If
    Cengshu = Cengshu - L
    Call 杆件图1(tuxing1.Picture1)
'    Call tuxing1.Form_Load
End Sub
Sub Editxy(Lxedit, Lyedit)
    Dim i, j, M, N, k, L, Ll, kk As Integer
    Dim tempx, tempy As Single
    i = j = M = N = k = L = 0
    tempx = 0: tempy = 0
    If Ked < 36 And Ced < 36 Then
        If Ked > 0 Then
            For M = 1 To Ked
                If Abs(Lxedit * Gridx - Lxed(M) * 1000) < Gridx / 2 Then
                    kk = 1
                    For k = M + 1 To Ked
                        Lxed(k - 1) = Lxed(k)
                    Next k
                    Lxed(Ked) = 0
                    Ked = Ked - 1
                End If
            Next M
        End If
        If Ced > 0 Then
            For N = 1 To Ced
                If Abs(Lyedit * Gridy - Lyed(N) * 1000) < Gridy / 2 Then
                    Ll = 1
                    For L = N + 1 To Ced
                        Lyed(L - 1) = Lyed(L)
                    Next L
                    Lyed(Ced) = 0
                    Ced = Ced - 1
                End If
            Next N
        End If
        If kk <> 1 And Ll <> 1 Then
            For i = 1 To Kuashu
                tempx = tempx + Lx(i)
                If Abs(Lxedit * Gridx - tempx * 1000) < Gridx / 2 Then
                    Ked = Ked + 1
                    Lxed(Ked) = tempx
                End If
            Next i
            For j = 1 To Cengshu
                tempy = tempy + Ly(j)
                If Abs(Lyedit * Gridy - tempy * 1000) < Gridy / 2 Then
                    Ced = Ced + 1
                    Lyed(Ced) = tempy
                End If
            Next j
        End If
    End If
    tuxing1.command.Text = Str(Ked) + "        " + Str(Ced)
    Call 杆件图1(tuxing1.Picture1)
    Call 杆件图2(tuxing1.Picture1)
End Sub
Sub 编辑变量清空()
    Erase Lxed()
    Erase Lyed()
    Ked = 0
    Ced = 0
    Buttoned = 0
End Sub
Sub Lxedaddpro(Jiax As Single)
    Dim i, j, M, L As Integer
    Dim tempxx As Single
    i = 0: j = 0: M = 0: L = 0: tempxx = 0
    For M = 1 To Kuashu
        tempxx = tempxx + Lx(M)
        If tempxx * 1000 = Jiax * Gridx Then L = 1
    Next M
    If L = 0 Then
        If Jiax * Gridx > Kuatot * 1000 Then
            Lx(Kuashu + 1) = Jiax * Gridx / 1000 - Kuatot
            Kuatot = Jiax * Gridx / 1000
        Else
            tempxx = 0
            Do
            If i = 36 Then Exit Do
            tempxx = tempxx + Lx(i)
            If tempxx * 1000 + Lx(i + 1) * 1000 > Jiax * Gridx Then
                For j = Kuashu + 1 To i + 3 Step -1
                    Lx(j) = Lx(j - 1)
                Next j
                Lx(i + 2) = tempxx + Lx(i + 1) - Jiax * Gridx / 1000
                Lx(i + 1) = Jiax * Gridx / 1000 - tempxx
                Exit Do
            End If
            i = i + 1
            Loop
        End If
        Kuashu = Kuashu + 1
        Call 杆件图1(tuxing1.Picture1)
    End If
End Sub
Sub Lyedaddpro(Jiay As Single)
    Dim i, j, N, k As Integer
    Dim tempyy As Single
    i = 0: j = 0: N = 0: k = 0: tempyy = 0
    For N = 1 To Cengshu + 1
        tempyy = tempyy + Ly(N)
        If tempyy * 1000 = Jiay * Gridy Then k = 1
    Next N
    If k = 0 Then
        If Jiay * Gridy > Cengtot * 1000 Then
            Ly(Cengshu + 1) = Jiay * Gridy / 1000 - Cengtot
            Cengtot = Jiay * Gridy / 1000
        Else
            tempyy = 0
            Do
            If i = 36 Then Exit Do
            tempyy = tempyy + Ly(i)
            If tempyy * 1000 + Ly(i + 1) * 1000 > Jiay * Gridy Then
                For j = Cengshu + 1 To i + 3 Step -1
                    Ly(j) = Ly(j - 1)
                Next j
                Ly(i + 2) = Ly(i + 1) + tempyy - Jiay * Gridy / 1000
                Ly(i + 1) = Int(Jiay * Gridy) / 1000 - tempyy
                Exit Do
            End If
            i = i + 1
            Loop
        End If
        Cengshu = Cengshu + 1
        Call 杆件图1(tuxing1.Picture1)
    End If
End Sub