亲，您未登录哦！ 登录 | 注册
首页  |  社区  |  工具箱  |  代码库  |  博客  |  招聘  |  文章  |  新闻  |  下载  |  读书
回 帖 发 新 帖 刷新版面

主题：[讨论]vb过程太大，高手们能否简化此程序，希望高手帮忙，万分感激

向光前进 [专家分：0] 发布于 2011-11-26 09:40:00

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 Sub

Private 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 Function



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
本帖地址：  http://bbs.pfan.cn/post/378939.html

回复列表 （共17个回复）

沙发

老大徒伤悲 [专家分：29120] 发布于 2011-11-27 13:25:00

你的程序主要是
   Pic1.CurrentX = -轴长 / 100
    Pic1.CurrentY = 0
    Pic1.Print 0
类型的语句组太多地重复。
建议在下面的方案中选一种来简化：
1、建立一个自定义过程专门用于在指定的位置输出指定的文字。

private sub 输出（控件 as picturebox，纵位置 as single，横位置 as single，文字 as string）
   控件.CurrentX = 横位置
   控件.CurrentY = 纵位置
   P控件.Print 文字
end sub

然后，你上面的程序里四行变成一行。

2、设立二个数组，一个是位置，一个是标志。
利用循环输出这些内容。

板凳

向光前进 [专家分：0] 发布于 2011-11-27 16:39:00


高手，您能否具体的帮我简化一下啊，我试了一下它一直出现用户未定义的对话框，再就是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
这一段如何处理啊，求求高手帮小弟解决一下，万分感激您，高手如果需要加分我可以给您追加，希望高手帮忙解决一下，我学vb不太熟，像简化程序还有点欠缺，希望高手帮忙，万分感激，谢谢

3 楼

老大徒伤悲 [专家分：29120] 发布于 2011-11-28 10:27:00

分也不吃喝，你觉得有帮助就给，没有帮助就算。无所谓。
至于你的问题，你至少要说清楚。“用户未定义”出现在哪个过程？哪一行？那个词？
你说的这六行代码“怎么处理”是什么意思？

4 楼

向光前进 [专家分：0] 发布于 2011-11-28 13:54:00

高手，我刚注册不长时间，不太会用，所以没给您评分，请谅解，现在给您评分了，我按您的提示可是它提示未定义，我vb学的时间也不长，也不太明白到底出错在哪？希望高手能够给出具体代码？谢谢。只要问题解决，评分没问题，希望高手谅解新手的无知，谢谢

5 楼

向光前进 [专家分：0] 发布于 2011-11-28 13:57:00

高手按钮中的程序还能否简化呢，因为类似的程序还有很多，怕高手看烦了，只是发了一部分，希望高手指点，谢谢，高手

6 楼

老大徒伤悲 [专家分：29120] 发布于 2011-11-28 14:19:00

“用户未定义”出现在哪个过程？哪一行？那个词？

7 楼

向光前进 [专家分：0] 发布于 2011-11-28 21:43:00


高手那个问题我解决了，少了一个定义语句，嘿嘿，不好意思啊。
高手我想问您一下，除了简化那个地方，其他的代码还能不能简化啊，过程太大的问题还是没能解决啊？？？我学vb时间不长这次还是第一次遇到这个问题，高手能否再帮忙看看简化一下，分数不是问题，我现在急着简化这个代码，时间很急了，谢谢您

8 楼

向光前进 [专家分：0] 发布于 2011-11-28 21:49:00


高手这是在Private Sub Command2_Click()
的另一小段代码，和上面给的代码很多地方相似，高手能否帮我看看是否还有简化的余地，能否帮忙简化一下，谢谢
ElseIf Val(Text1.Text) = 2 Then '这又是简支梁的一种情况           两个集中力
         If Val(Text2) = 0 Then
            p1 = Arr(1)
            xp1 = Brr(1)
            p2 = Arr(2)
            xp2 = Brr(2)
            For i = 0 To L * 1000
                x = i / 1000
                Select Case x
                    Case Is < xp1
                        y(i) = Mp11(L, xp1, p1, x) + Mp21(L, xp2, p2, x)
                    Case Is < xp2
                        y(i) = Mp12(L, xp1, p1, x) + Mp21(L, xp2, p2, x)
                    Case Else
                        y(i) = Mp12(L, xp1, p1, x) + Mp22(L, xp2, p2, x)
                End Select
                If y(i) > MaxVal Then
                    MaxVal = y(i)
                    MaxxVal = x
                End If
            Next i
           坐标系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

9 楼

向光前进 [专家分：0] 发布于 2011-11-28 21:49:00


 MaxVal = 0
                MaxxVal = 0
                MinVal = 0
                MinxVal = 0
                For i = 0 To L * 1000
                x = i / 1000
                Select Case x
                    Case Is <= xp1
                        y(i) = Fp11(L, xp1, p1, x) + Fp21(L, xp2, p2, x)
                    Case Is <= xp2
                        y(i) = Fp12(L, xp1, p1, x) + Fp21(L, xp2, p2, x)
                    Case Else
                        y(i) = Fp12(L, xp1, p1, x) + Fp22(L, xp2, p2, x)
                End Select
                 If y(i) > MaxVal Then
                    MaxVal = y(i)
                    MaxxVal = x
                ElseIf y(i) < MinVal Then
                    MinVal = y(i)
                    MinxVal = x
                End If
            Next i
                 If Abs(MaxVal) > Abs(MinVal) 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

10 楼

向光前进 [专家分：0] 发布于 2011-11-28 21:50:00


高手8楼9楼是连在一块的

我来回复

您尚未登录，请登录后再回复。点此登录或注册

程序员工具箱 new

  • 文本转表格
  • 在线Markdown编辑器
  • JSON格式化高亮
  • JS代码压缩
  • 网页颜色工具
  • JavaScript库CDN服务
  • 各种语言HelloWorld
  • 微博图片反查
  • 疫苗查询
  • 营销号生成器
  • 更多工具

    • 代码片段

  • 模拟键盘（不可按）
  • 碰撞的唐三
  • 精彩奥运热点赛事的实时采集
  • 获取天气动态信息
  • 文件查找
  • python大数据抓取京东电脑销量数据
  • 爬虫技术不仅仅支持数据采集
  • 抓取脉脉APP上的职业信息
  • 爬虫中多线程的运用
  • 四则运算以及一元二次方程
  • 欢迎来共享你的NB代码

    • 本版新帖

  • 网络编程之winsock控件简介使用方法
  • 发现一个极棒的免费BASIC
  • 如何使用api函数
  • 谁有计算表达式的程序？
  • Visual Basic讨论版任命eerfaone为本版版主，大家鼓掌！！ 
  • 各位大侠请了，怎么在vb中利用文本文件的资源？谢谢。
  • 怎样用VB6.0编写BO程序（木马程序）
  • 请教一个问题?
  • 汉字编码原理，atcc进来看看！！！
  • 不调用API来链接个人主页及个人邮箱的技巧代码
  • vb实现远程控制
  • 大哥们 救命呀
  • VB 6.0中类聚集关系的实现 
  • VB6编程中如何获取硬盘分区信息 
  • 要在1-10之间找4个不重复的随机数。请教！