| 网站首页 | 业界新闻 | 小组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 264 人关注过本帖
标题:想问下如何画出红圈处点的轨迹
只看楼主 加入收藏
大大同学
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2019-7-2
结帖率:100%
  已结贴   问题点数:20  回复次数:7   
想问下如何画出红圈处点的轨迹

Const pi = 3.1415926
Dim angle As Integer
Private Sub Form_Load() '调整空间尺寸,位置及初始参数
    Me.ScaleMode = 2
    Me.Caption = "I型曲柄滑块"
    Me.Width = 10000
    Me.Height = 7000
    Picture1.ScaleMode = 2
    Picture1.AutoRedraw = True
    Picture1.Move 0, 0, Me.ScaleWidth, 1500
    Command1.Caption = "开始(&B)"
    Command1.Move 20, 260, 70, 30
    Label1.Caption = "速度:"
    Label1.Move 120, 170, 100, 30
    HScroll1.Min = 1
    HScroll1.Max = 20
    HScroll1.Move 160, 260, 140, 30
    Timer1.Interval = 20
    Timer1.Enabled = False
End Sub
Private Sub Command1_Click()
    Timer1.Enabled = Not Timer1.Enabled
    If Timer1.Enabled Then
        Command1.Caption = "暂停(&S)"
    Else
        Command1.Caption = "开始(&B)"
    End If
End Sub
Sub draw(ByVal ox As Integer, ByVal oy As Integer, ByVal orad As Integer) 'ox,oy圆心坐标,orad半径
    angle = (angle + HScroll1.Value) Mod 360
    xo = ox + orad * Cos(angle * pi / 180) 'ox,oy圆心坐标,orad半径
    yo = oy - orad * Sin(angle * pi / 180)
    xs = Sqr((3 * orad) ^ 2 - 10 ^ 2) + xo '滑块的左边界x坐标,连杆长度取4*orad,滑块高度取20(像素)?
    xz = 3 * Sqr((3 * orad) ^ 2 - 10 ^ 2) + xo
    Picture1.BackColor = Picture1.BackColor
    Picture1.DrawStyle = 0 '实线
    Picture1.DrawWidth = 2 '线宽2
    Picture1.Line (ox + 2 * orad, oy + 10)-(ox + 6 * orad, oy + 10) '壁面
    Picture1.Line (ox, oy)-(xo, yo) '连接圆心与圆周上的铰链点
    Picture1.Line (xs, oy)-(xo, yo), vbBlue  '连接滑块与圆周上的铰链点
    Picture1.Line (xz, 3 * oy - 2 * yo)-(xs, oy), vbBlue
    Picture1.FillStyle = 1 '透明填充
    Picture1.Circle (ox, oy), orad '画圆
    Picture1.FillStyle = 0 '实体填充
    Picture1.FillColor = vbWhite '圆心
    Picture1.Circle (ox, oy), 5
    Picture1.FillColor = vbGreen '圆周上的铰接点
    Picture1.Circle (xo, yo), 4
    Picture1.FillColor = vbRed '滑块
    Picture1.Line (xs - 20, oy - 10)-(xs + 20, oy + 10), , B
    Picture1.DrawStyle = 2 '虚线
    Picture1.DrawWidth = 1 '线宽1
    For i = 0 To 9 '表示壁面的虚线
        Picture1.Line (i * 3 * orad / 10 + ox + 2 * orad - 5, oy + 10)-(i * 3 * orad / 10 + ox + 2 * orad + 20 - 5, oy + 20)
    Next
End Sub
Private Sub Timer1_Timer() '画
    draw 60, 160, 40
End Sub


源码有了,请大佬们指点一下
搜索更多相关主题的帖子: Sub  Caption  Move  End  Line  
2019-07-02 12:23
大大同学
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2019-7-2
  得分:0 
附件: 您没有浏览附件的权限,请 登录注册
2019-07-02 12:24
大大同学
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2019-7-2
  得分:0 
点的坐标是(xz, 3 * oy - 2 * yo)
2019-07-02 12:27
wufuzhang
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:广州
等 级:版主
威 望:8
帖 子:121
专家分:753
注 册:2017-8-9
  得分:0 
你把这句去掉Picture1.BackColor = Picture1.BackColor
在draw最后面加上一句Picture1.PSet (xz, 3 * oy - 2 * yo), vbRed就可以了

不经历千百遍的调试,怎能体会成功时那一刹那的喜悦。
2019-07-02 17:30
大大同学
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2019-7-2
  得分:0 
回复 4楼 wufuzhang
不对呀,按照你的所有轨迹都出现了
附件: 您没有浏览附件的权限,请 登录注册
2019-07-02 17:46
wufuzhang
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:广州
等 级:版主
威 望:8
帖 子:121
专家分:753
注 册:2017-8-9
  得分:20 
回复 5楼 大大同学
在你代码基础上,draw过程中最后面加上这段代码就可以了
    N = N + 1
    Picture1.DrawWidth = 10
    If angle Then
       ReDim Preserve PointArray(1 To 2 * N)
       PointArray(2 * N - 1) = xz
       PointArray(2 * N) = 3 * oy - 2 * yo
       For i = 1 To N
           Picture1.PSet (PointArray(2 * i - 1), PointArray(2 * i)), vbRed
       Next
    Else
       N = 1
       ReDim PointArray(1 To 2 * N)
       PointArray(2 * N - 1) = xz
       PointArray(2 * N) = 3 * oy - 2 * yo
       For i = 1 To N
           Picture1.PSet (PointArray(2 * i - 1), PointArray(2 * i)), vbRed
       Next
    End If


记得在声明部分定义:
Dim PointArray()
Dim N As Long

不经历千百遍的调试,怎能体会成功时那一刹那的喜悦。
2019-07-02 23:17
大大同学
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2019-7-2
  得分:0 
回复 6楼 wufuzhang
谢谢老师,你太厉害了
2019-07-03 10:36
wufuzhang
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:广州
等 级:版主
威 望:8
帖 子:121
专家分:753
注 册:2017-8-9
  得分:0 
回复 7楼 大大同学
不客气。
你的动画挺有意思的。

不经历千百遍的调试,怎能体会成功时那一刹那的喜悦。
2019-07-03 15:34







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.025394 second(s), 8 queries.
Copyright©2004-2019, BCCN.NET, All Rights Reserved