Private Sub 坐标系1(轴长, 最大值, 弯矩最大处)
    Pic1.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
    Pic1.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
    Pic1.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
    Pic1.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
    
    Pic1.Line (0, 0)-(轴长 * 1.25, 0)
    Pic1.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
    Pic1.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic1.CurrentX = -轴长 / 100
    Pic1.CurrentY = 0
    Pic1.Print 0
    
    Pic1.CurrentX = 轴长
    Pic1.CurrentY = 0
    Pic1.Print 轴长
    
    Pic1.CurrentX = 弯矩最大处
    Pic1.CurrentY = 0
    Pic1.Print 弯矩最大处
    
    Pic1.CurrentX = 轴长 * 1.25
    Pic1.CurrentY = 0
    Pic1.Print "X"
    
    Pic1.CurrentX = 轴长 / 50
    Pic1.CurrentY = 最大值 * 1.5
    Pic1.Print "Y"
    
   
    Pic1.CurrentX = 弯矩最大处 * 0.99
    Pic1.CurrentY = 最大值 * 1.32
    Pic1.Print Round(最大值)
    
    'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系2(轴长, 最小值, 弯矩最小处)
    Pic1.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
    Pic1.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
    Pic1.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
    Pic1.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
    
    Pic1.Line (0, 0)-(轴长 * 1.25, 0)
    Pic1.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
    Pic1.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic1.CurrentX = -轴长 / 100
    Pic1.CurrentY = 0
    Pic1.Print 0
    
    Pic1.CurrentX = 轴长
    Pic1.CurrentY = 0
    Pic1.Print 轴长
    
    Pic1.CurrentX = 弯矩最小处
    Pic1.CurrentY = 0
    Pic1.Print 弯矩最小处
    
    Pic1.CurrentX = 轴长 * 1.25
    Pic1.CurrentY = 0
    Pic1.Print "X"
    
    Pic1.CurrentX = 轴长 / 50
    Pic1.CurrentY = 最小值 * 1.5
    Pic1.Print "Y"
    
   
    Pic1.CurrentX = 弯矩最小处 * 0.99
    Pic1.CurrentY = 最小值 * 1.32
    Pic1.Print Round(最小值)
   
    
    'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系3(轴长, 最大值, 弯矩最大处)
    Pic2.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
    Pic2.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
    Pic2.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
    Pic2.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
    
    Pic2.Line (0, 0)-(轴长 * 1.25, 0)
    Pic2.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
    Pic2.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic2.CurrentX = -轴长 / 100
    Pic2.CurrentY = 0
    Pic2.Print 0
    
    Pic2.CurrentX = 轴长
    Pic2.CurrentY = 0
    Pic2.Print 轴长
    
    Pic2.CurrentX = 弯矩最大处
    Pic2.CurrentY = 0
    Pic2.Print 弯矩最大处
    
    Pic2.CurrentX = 轴长 * 1.25
    Pic2.CurrentY = 0
    Pic2.Print "X"
    
    Pic2.CurrentX = 轴长 / 50
    Pic2.CurrentY = 最大值 * 1.5
    Pic2.Print "Y"
    
   
    Pic2.CurrentX = 弯矩最大处 * 0.99
    Pic2.CurrentY = 最大值 * 1.32
    Pic2.Print Round(最大值)
End Sub
Private Sub 坐标系4(轴长, 最小值, 弯矩最小处)
    Pic2.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
    Pic2.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
    Pic2.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
    Pic2.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
    
    Pic2.Line (0, 0)-(轴长 * 1.25, 0)
    Pic2.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
    Pic2.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic2.CurrentX = -轴长 / 100
    Pic2.CurrentY = 0
    Pic2.Print 0
    
    Pic2.CurrentX = 轴长
    Pic2.CurrentY = 0
    Pic2.Print 轴长
    
    Pic2.CurrentX = 弯矩最小处
    Pic2.CurrentY = 0
    Pic2.Print 弯矩最小处
    
    Pic2.CurrentX = 轴长 * 1.25
    Pic2.CurrentY = 0
    Pic2.Print "X"
    
    Pic2.CurrentX = 轴长 / 50
    Pic2.CurrentY = 最小值 * 1.5
    Pic2.Print "Y"
    
   
    Pic2.CurrentX = 弯矩最小处 * 0.99
    Pic2.CurrentY = 最小值 * 1.32
    Pic2.Print Round(最小值)
End SubPrivate Function Fp11(l, xp1, p1, x)
    Fp11 = (1 - xp1 / l) * p1
End Function
Private Function Fp12(l, xp1, p1, x)
    Fp12 = -xp1 * p1 / l
End Function
Private Function Mp11(l, xp1, p1, x)
    Mp11 = (1 - xp1 / l) * p1 * x
End Function
Private Function Mp12(l, xp1, p1, x)
    Mp12 = (1 - xp1 / l) * p1 * x - p1 * (x - xp1)
End FunctionPrivate Sub Command2_Click()
    Pic1.Cls
    Dim y()
    l = Val(Text3.Text)
    ReDim y(l * 1000)
    Max = 0
    Maxx = 0
    Min = 0
    Minx1 = 0
 If Combo1.Text = "简支梁" Then
    If Val(Text1.Text) = 1 Then
        If Val(Text2.Text) = 0 And Val(Text11.Text) = 0 Then
            p1 = Arr(1)
            xp1 = Brr(1)
            For i = 0 To l * 1000
                x = i / 1000
                If x < xp1 Then
                    y(i) = Mp11(l, xp1, p1, x)
                Else
                    y(i) = Mp12(l, xp1, p1, x)
                End If
                If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                End If
            Next i
  'frm扭转计算.Print Max
            坐标系1 l, Max, Maxx  '调用的上面的建坐标系的函数,很好
            For i = 0 To l * 1000
                x = i / 1000
                Pic1.PSet (x, y(i))
                If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
            Next i
                Max = 0
                Maxx = 0
                Min = 0
                Minx1 = 0
                For i = 0 To l * 1000
                x = i / 1000
                Select Case x
                    Case Is <= xp1
                        y(i) = Fp11(l, xp1, p1, x)
                    Case Else
                        y(i) = Fp12(l, xp1, p1, x)
                End Select
                 If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                ElseIf y(i) < Min Then
                    Min = y(i)
                    Minx1 = x
                End If
            Next i
                 If Abs(Max) > Abs(Min) Then
                    坐标系3 l, Max, Maxx
                 Else
                    坐标系4 l, Min, Minx1
                 End If
               For i = 0 To l * 1000
                x = i / 1000
                 If i = 0 Then
                    Pic2.PSet (x, y(i))
                Else
                    Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
                    If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
                End If
                If i Mod (50 * l) = 0 Then
                    Pic2.Line (x, y(i))-(x, 0), vbBlue
                End If
            Next i
        End If
     End If
     End If
End Sub

解决方案 »

  1.   

    高手们,第一部分是四个建立坐标系所建立的过程,第二部分是第三部分要调用的函数,第三部分是Private Sub Command2_Click()
    高手们,现在能否明白了呢,希望高手帮忙指点点思路,谢谢您们
      

  2.   

    楼上的高手们,我的做的是用vb代码绘制材料力学中的弯曲的弯矩图和剪力图,是力学求解器的一部分,因为用到几个窗体,每个窗体都有部分代码,不好粘贴上去,论坛也不能传压缩文件给高手们看,只能贴了一部分比较重要的代码,在上面Private Sub 坐标系1(轴长, 最大值, 弯矩最大处)后面的是绘制坐标系,Private Function Fp11(l, xp1, p1, x)是绘制函数图象调用的函数表达式,
    Private Sub Command2_Click()里面的内容是绘制出弯矩图和剪力图的代码,
    希望高手们能够看明白,如果高手们想看看所有的,我可以把压缩文件给您,希望高手能够帮忙,因为以前没怎么遇到过过程太大的问题,希望高手帮帮忙,谢谢,邮箱[email protected]
      

  3.   

    首先声明,俺不是高手,俺才五裤衩,与高手相比差太远了.
    站在一个低手的立场上,给楼主提一些建议:
    1.程序的优劣,不是简单地一眼扫过就能判断出来的,要根据程序是否能达到需求的目的,是否有较快的运算速度,是否占用较少的系统资源等方面来衡量,你的这段程序,是你整个工程的一部分,拿来给我们看,我们一不知道你要干什么,二不知道你是什么干的,光看程序就得琢磨半天,恐怕最后也难给出你满意的结论.
    2.如果你是一个新手的话,那能把程序运行起来,获得应有的结果,程序就是好程序.
    3.程序给别人看,是得写成优美一些的结构,并添加上合适的注释的,然后如果是要解决什么问题,你应该适当注明哪儿可能有什么问题,哪儿我写得觉得过于复杂了,这样人家才好帮到你,就你这段程序,我就觉得写得没什么问题,因为我不能看出它哪儿能够优化,因为你的判断太多了,而我不知道你是根据什么来判断的.
    附上我看程序时的结构上的修改,建议以后如果有问题的时候,上来问也这样做:
    Private Sub Command2_Click()
      Pic1.Cls
      Dim y()
      l = Val(Text3.Text)
      ReDim y(l * 1000)
      Max = 0
      Maxx = 0
      Min = 0
      Minx1 = 0
        If Combo1.Text = "简支梁" Then
           If Val(Text1.Text) = 1 Then
             If Val(Text2.Text) = 0 And Val(Text11.Text) = 0 Then
               p1 = Arr(1)
               xp1 = Brr(1)
               For i = 0 To l * 1000
                 x = i / 1000
                 If x < xp1 Then
                   y(i) = Mp11(l, xp1, p1, x)
                 Else
                   y(i) = Mp12(l, xp1, p1, x)
                 End If
                 If y(i) > Max Then
                   Max = y(i)
                   Maxx = x
                 End If
               Next i
               'frm扭转计算.Print Max
               坐标系1 l, Max, Maxx '调用的上面的建坐标系的函数,很好
               For i = 0 To l * 1000
                 x = i / 1000
                 Pic1.PSet (x, y(i))
                 If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
               Next i
               Max = 0
               Maxx = 0
               Min = 0
               Minx1 = 0
               For i = 0 To l * 1000
                 x = i / 1000
                 Select Case x
                 Case Is <= xp1
                   y(i) = Fp11(l, xp1, p1, x)
                 Case Else
                   y(i) = Fp12(l, xp1, p1, x)
                 End Select
                 If y(i) > Max Then
                   Max = y(i)
                   Maxx = x
                 ElseIf y(i) < Min Then
                   Min = y(i)
                   Minx1 = x
                 End If
               Next i
               If Abs(Max) > Abs(Min) Then
                 坐标系3 l, Max, Maxx
               Else
                 坐标系4 l, Min, Minx1
               End If
               For i = 0 To l * 1000
                 x = i / 1000
                 If i = 0 Then
                   Pic2.PSet (x, y(i))
                 Else
                   Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
                   If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
                 End If
                 If i Mod (50 * l) = 0 Then
                   Pic2.Line (x, y(i))-(x, 0), vbBlue
                 End If
               Next i
             End If
           End If
         End If
    End Sub
      

  4.   

    将静态的图形元素画一次,保存到一个隐藏的PictureBox控件里面,
    以后每次先将这个PictureBox控件的Picture用PaintPicture方法画到背景上,然后再画动态元素?
      

  5.   

    您好,高手我的做的是用vb代码绘制材料力学中的弯曲的弯矩图和剪力图,是力学求解器的一部分,因为用到几个窗体,每个窗体都有部分代码,不好粘贴上去,论坛也不能传压缩文件给高手们看,只能贴了一部分比较重要的代码,在上面Private Sub 坐标系1(轴长, 最大值, 弯矩最大处)后面的是绘制坐标系,Private Function Fp11(l, xp1, p1, x)是绘制函数图象调用的函数表达式,
    Private Sub Command2_Click()里面的内容是绘制出弯矩图和剪力图的代码
    本质就是在一个窗体上利用函数表达式在picture上绘制函数图象,高手,我想问您一下
                  If y(i) > Max Then
                   Max = y(i)
                   Maxx = x
                 ElseIf y(i) < Min Then
                   Min = y(i)
                   Minx1 = x
                 End If
    这段代码能简化为一个函数过程吗?用的时候调用它?谢谢
      

  6.   

    LZ的Command2_Click代码可以试下如下将画PIC1和PIC2的代码放2个独立过程再调试,以下代码仅供参考:    Dim y() As Single
        Dim l As Long
    Private Sub Command2_Click()
        Pic1.Cls
        l = Val(Text3.Text)
        ReDim y(l * 1000)
        If Combo1.Text = "简支梁" Then
            If Val(Text1.Text) = 1 Then
                If Val(Text2.Text) = 0 And Val(Text11.Text) = 0 Then
                    Call pic_1
                    Call pic_2
                End If
            End If
        End If
    End Sub
    Public Sub pic_1()
        Max = 0
        Maxx = 0
        Min = 0
        Minx1 = 0
        p1 = Arr(1)
        xp1 = Brr(1)
        For i = 0 To l * 1000
            x = i / 1000
            If x < xp1 Then
                y(i) = Mp11(l, xp1, p1, x)
            Else
                y(i) = Mp12(l, xp1, p1, x)
            End If
            If y(i) > Max Then
                Max = y(i)
                Maxx = x
            End If
        Next i
        'frm扭转计算.Print Max
        '坐标系1 l, Max, Maxx '调用的上面的建坐标系的函数,很好
        For i = 0 To l * 1000
            x = i / 1000
            Pic1.PSet (x, y(i))
            If i Mod (50 * l) = 0 Then
                Pic1.Line (x, y(i))-(x, 0), vbBlack
            End If
        Next i
    End SubPublic Sub pic_2()
        Max = 0
        Maxx = 0
        Min = 0
        Minx1 = 0
        For i = 0 To l * 1000
            x = i / 1000
            Select Case x
                Case Is <= xp1
                    y(i) = Fp11(l, xp1, p1, x)
                Case Else
                    y(i) = Fp12(l, xp1, p1, x)
            End Select
            If y(i) > Max Then
                Max = y(i)
                Maxx = x
            ElseIf y(i) < Min Then
                Min = y(i)
                Minx1 = x
            End If
        Next i
        If Abs(Max) > Abs(Min) Then
            坐标系3 l, Max, Maxx
        Else
            坐标系4 l, Min, Minx1
        End If
        For i = 0 To l * 1000
            x = i / 1000
            If i = 0 Then
                Pic2.PSet (x, y(i))
            Else
                Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
                If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
            End If
            If i Mod (50 * l) = 0 Then
                Pic2.Line (x, y(i))-(x, 0), vbBlue
            End If
        Next i
    End Sub