广告广告
  加入我的最爱 设为首页 风格修改
首页 首尾
 手机版   订阅   地图  繁体 
您是第 7535 个阅读者
 
<<   1   2  下页 >>(共 2 页)
发表文章 发表投票 回覆文章
  可列印版   加为IE收藏   收藏主题   上一主题 | 下一主题   
za08280714
数位造型
个人文章 个人相簿 个人日记 个人地图
小人物
级别: 小人物 该用户目前不上站
推文 x0 鲜花 x3
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片
推文 x0
[Basic][求助] VB2008程式问题
请问高手们.我有放上我做的程式.这三个问题要如何解决 谢谢

问题ㄧ:如何用键盘选 上下左右图 (上图 往上移动)(下图 往下移动)(左图 往左移动)(右图 往右移动) ..

访客只能看到部份内容,免费 加入会员 或由脸书 Google 可以看到全部内容



献花 x1 回到顶端 [楼 主] From:台湾中华电信股份有限公司 | Posted:2011-08-04 21:13 |
ebolaman 手机 会员卡
个人文章 个人相簿 个人日记 个人地图
特殊贡献奖

级别: 副版主 该用户目前不上站
版区: 程式设计
推文 x38 鲜花 x458
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

回答一:不要将 mdir 宣告成 String,这样不方便撰写程式,应该由 Integer来代表方向 (好记的 上,下,左,右 -> 0,1,2,3)
  由于 pb_... 函数未完成,因此左右无法更换图片。再加上一个变数记录是否再移动,移动中就不准更换图片,这样宣告。

回答二:加上 判断碰撞的函数、已经碰撞后处理的函数

回答三:当然可以,读取方式不同而已




底下是我刚刚做的范例程式码,直接贴到你原有的 Form1 程式码即可(记得 备份原来的程式码)


Form1 :

复制程式
Public Class Form1

    '---------- Local variables ----------

    'List of pictures
    Dim lstPic As New List(Of Image)
    Dim stat_lstPic As New List(Of Integer) 'Status (Pausing->0, Moving->1)

    'Positions
    Dim m_x, m_y, m_os_x, m_os_y As Integer

    'Times
    Dim ti_cntdn As Double 'Countdown

    'Flags
    Dim admin_ctrl As Integer 'Admin mode (User can control ->1, can't ->0)
    Dim lastmdir As Integer, mdir As Integer 'Direction

    'Help texts
    Const hlp_1 As String = "(1) Press Any 'ARROW KEY' To Choose An Initial Direction." & vbNewLine & "(2) Press 'SPACE' To Begin/Reset." & vbNewLine & "(3) You May Press Any Arrow Keys To Change The Direction When Object Is Moving."

    '---------- Local objects ----------

    'Labels
    Dim label_indic As New Label


    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown

        local_kc_dir(e.KeyCode)

    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        '--- Variables ---
        admin_ctrl = 1
        lastmdir = -1 : mdir = 3 'Right
        ti_cntdn = 0.5

        m_os_x = 25 'Offset (X Axis)
        m_os_y = 20 'Offset (Y Axis)

        '--- List of Images ---
        lstPic.Add(Image.FromFile("上001.bmp"))
        lstPic.Add(Image.FromFile("下001.bmp"))
        lstPic.Add(Image.FromFile("左001.bmp"))
        lstPic.Add(Image.FromFile("右001.bmp"))

        '--- Obj. ---

        'PictureBox1 - Status
        stat_lstPic.Add(0)

        'PictureBox1 - Image & Location
        local_renew_resetpic()

        'Label
        local_build_obj()

        '--- Sub ---
        local_change_pic()
        local_renew_indic(0, hlp_1)

    End Sub


    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If Timer1.Enabled = False Then Exit Sub

        Static ti_ct As Double

        'Bouncing
        If admin_ctrl = 0 Then
            ti_ct = ti_ct + (Timer1.Interval / 1000)
            If ti_ct = ti_cntdn Then
                ti_ct = 0
                local_switch_moving()
                Exit Sub
            End If
        End If

        'Offset
        m_x = m_x + Choose(mdir + 1, 0, 0, -m_os_x, m_os_x)
        m_y = m_y + Choose(mdir + 1, -m_os_y, m_os_y, 0, 0)

        'Renew position of PictureBox1
        PictureBox1.Location = New Point(m_x, m_y)

        'Check collision with form
        If local_check_colli(PictureBox1, Me) = 1 Then
            local_new_bounce()
            local_change_pic()
        End If


    End Sub



    Private Sub local_build_obj()

        '--- Label ---

        'label_indic
        label_indic.Parent = Me
        label_indic.Location = New Point(70, 60)
        label_indic.AutoSize = True

    End Sub

    Private Sub local_renew_indic(ByRef mode As Integer, ByVal s As String) 'Renew indicator
        label_indic.Text = s
        label_indic.Visible = Not CBool(mode)
    End Sub

    Private Sub local_kc_dir(ByRef kc As Integer)

        'Check Admin
        If admin_ctrl = 0 Then Exit Sub

        'Determine the key
        Select Case kc
            Case Keys.Up
                mdir = 0
            Case Keys.Down
                mdir = 1
            Case Keys.Left
                mdir = 2
            Case Keys.Right
                mdir = 3
            Case Keys.Space
                'Start moving object when SPACE has been pressed, stop moving when pressing again
                local_switch_moving()
        End Select

        'Change image of PictureBox1
        local_change_pic()

    End Sub

    Private Sub local_change_pic()

        If lastmdir = mdir Then Exit Sub

        'Change picture in PictureBox1
        PictureBox1.Image = lstPic(mdir)

        'Save last dir
        lastmdir = mdir

    End Sub

    Private Sub local_switch_moving()

        'Switch value
        stat_lstPic(0) = Not stat_lstPic(0)

        'Show/Hide indicator
        local_renew_indic(stat_lstPic(0), hlp_1)

        'Enable Timer1
        Timer1.Enabled = CBool(stat_lstPic(0))

        'Reset position
        If stat_lstPic(0) = 0 Then
            local_renew_resetpic()

        End If

    End Sub

    Private Function local_check_colli(ByRef obj_src As Object, ByVal obj_dst As Object) As Integer 'Simple verification

        local_check_colli = 0

        If obj_src.location.x <= 0 Or obj_src.location.x + obj_src.width >= obj_dst.width Then
            Return 1
        End If

        If obj_src.location.y <= 0 Or obj_src.location.y + obj_src.height >= obj_dst.height Then
            Return 1
        End If

    End Function

    Private Sub local_renew_resetpic()

        'PictureBox1 - Image & Position
        With PictureBox1
            local_change_pic()

            m_x = 390 : m_y = 180
            PictureBox1.Location = New Point(m_x, m_y)
        End With

        'Variables
        lastmdir = -1
        admin_ctrl = 1

    End Sub

    Private Sub local_new_bounce()

        'Disable admin
        admin_ctrl = 0

        'Turn opposite dir.
        mdir = Choose(mdir + 1, 1, 0, 3, 2)

    End Sub


End Class



以上程式码做出来的程式如何操控:

(1) 按 上下左右 调整方向
(2) 按 空白键 开始移动
(3) 移动过程中 也可以按方向键来切换方向

此文章被评分,最近评分记录
财富:50 (by 三仙) | 理由: ^^ 因为您的参与,让程式设计更容易!!


My BOINC stats :

献花 x1 回到顶端 [1 楼] From:台湾宽频通讯顾问股份有限公司 | Posted:2011-08-04 23:38 |
za08280714
数位造型
个人文章 个人相簿 个人日记 个人地图
小人物
级别: 小人物 该用户目前不上站
推文 x0 鲜花 x3
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

感谢大大的解答.原来可以那样的宣告.我在加强努力研究程式.感恩阿


献花 x0 回到顶端 [2 楼] From:台湾中华电信股份有限公司 | Posted:2011-08-05 18:23 |
za08280714
数位造型
个人文章 个人相簿 个人日记 个人地图
小人物
级别: 小人物 该用户目前不上站
推文 x0 鲜花 x3
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

请问大大我要修改成只上下换图片.之后加入一个抛物线.每换张图片抛物线的数值也跟这呼叫.依角度去区分抛物线高度?如何控置抛物线的速度跟碰到边缘会反弹回来.不管碰到几次掉到最底下就会消失.问题却出在我怎么调整跟加入程式码都无法被执行.除错也没出现.也可以执行却没有改变原先的动作


本帖包含附件
zip vb.rar   (2022-06-09 14:18 / 142 KB)   下载次数:7


献花 x0 回到顶端 [3 楼] From:台湾中华电信股份有限公司 | Posted:2011-08-07 11:32 |
ebolaman 手机 会员卡
个人文章 个人相簿 个人日记 个人地图
特殊贡献奖

级别: 副版主 该用户目前不上站
版区: 程式设计
推文 x38 鲜花 x458
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

下面是引用 za08280714 于 2011-08-07 11:32 发表的 : 到引言文
请问大大我要修改成只上下换图片.之后加入一个抛物线.每换张图片抛物线的数值也跟这呼叫.依角度去区分抛物线高度?如何控置抛物线的速度跟碰到边缘会反弹回来.不管碰到几次掉到最底下就会消失.问题却出在我怎么调整跟加入程式码都无法被执行.除错也没出现.也可以执行却没有改变原先的动作


所以,你要改成 只能按 上下 切换图片

抛物线是要让图片经过之处画一条线吗? 还是单纯让图片呈抛物线前进


用角度去做抛物线没问题,碰撞后会反弹也没问题

但我还想问一下,这些图片是要呈现角度吗?

那么一开始的上下左右的图片呢?

一开始发射的角度? 位置? 这些条件未知,目前我无法下手



复制程式
        lstPic.Add(Image.FromFile("ghost_90.bmp"))
        lstPic.Add(Image.FromFile("ghost_85.bmp"))
        lstPic.Add(Image.FromFile("ghost_80.bmp"))
        lstPic.Add(Image.FromFile("ghost_75.bmp"))
        lstPic.Add(Image.FromFile("ghost_70.bmp"))
        lstPic.Add(Image.FromFile("ghost_65.bmp"))
        lstPic.Add(Image.FromFile("ghost_60.bmp"))
        lstPic.Add(Image.FromFile("ghost_55.bmp"))
        lstPic.Add(Image.FromFile("ghost_50.bmp"))
        lstPic.Add(Image.FromFile("ghost_45.bmp"))


My BOINC stats :

献花 x0 回到顶端 [4 楼] From:台湾宽频通讯顾问股份有限公司 | Posted:2011-08-07 17:46 |
za08280714
数位造型
个人文章 个人相簿 个人日记 个人地图
小人物
级别: 小人物 该用户目前不上站
推文 x0 鲜花 x3
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

以45度图片为开始.一开始能选择上下换图片.再依图片的角度下去做抛物线的角度的选项.让图片呈抛物线前进


献花 x0 回到顶端 [5 楼] From:台湾中华电信股份有限公司 | Posted:2011-08-07 18:36 |
ebolaman 手机 会员卡
个人文章 个人相簿 个人日记 个人地图
特殊贡献奖

级别: 副版主 该用户目前不上站
版区: 程式设计
推文 x38 鲜花 x458
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片
Re:VB2008程式问题 抛物线第三版本
没想到还挺难做的

你的意思是这样子吧,碰到上、左、右都会反弹(但是发射角度我调往右)

运用到了物理的斜向抛射公式,以及数学的速度数值转换等方法







也是一样,底下是 Form1 的程式码,全部覆盖过去即可 (记得备份原本的程式码):

由于我是 VB2010,怕有不相容,不提供专案档




Form1 :

复制程式
Public Class Form1

    '---------- Local structures ----------

    'Positions
    Structure struc_pos
        Dim x, y As Integer 'Current position
        Dim ini_x, ini_y As Integer 'Initial position
        Dim ang As Single 'Current angle
        Dim vx, vy As Single 'Current velocity
        Dim ini_vx, ini_vy As Single 'Initial velocity
        Dim ini_v As Single 'Initial velocity
        Dim g As Single  'Gravity constant
    End Structure

    '---------- Local constants ----------

    'Initial positions
    Const user_ini_v As Single = 80
    Const user_ini_x As Integer = 390, user_ini_y As Integer = 180

    '---------- Local variables ---------- 

    'Graphics
    Dim g As System.Drawing.Graphics
    Dim dstRect, srcRect As Rectangle

    'List
    Dim listPic As New List(Of Image) 'List of picture
    Dim listAng As New List(Of Integer) 'List of angle

    'Collection
    Dim collRep As New Collection

    'Positions
    Dim pos As struc_pos

    'Flags 
    Dim stat_moving As Integer 'Status (Pausing->0, Moving->1) 
    Dim stat_ang, max_ang As Integer 'Angle
    Dim passedTime, multiTi As Single 'Time

    'Help texts 
    Const hlp_1 As String = "(1) 按 ""上"",""下"" 切换角度" & vbNewLine & "(2) 按 ""空白键"" 开始发射/停止" & vbNewLine & vbNewLine & "当物体碰撞到底下边缘才会消失"


    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown

        local_kc_dir(e.KeyCode)

    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        Dim i As Integer

        '--- Variables --- 

        'Position
        With pos
            .g = 9.8
            .ini_v = user_ini_v
        End With

        'Status
        stat_moving = 0
        stat_ang = 3

        'Time
        multiTi = 15

        '--- List of Images --- 

        max_ang = -1
        For i = 30 To 90 Step 5
            listPic.Add(Image.FromFile("ghost_" & i & ".bmp"))
            listAng.Add(i)
            max_ang += 1
        Next

        '--- Obj. --- 

        'PictureBox1 
        local_renew_resetpic()
        PictureBox1.Visible = False

        'Timer1
        Timer1.Interval = 20

        '--- Sub --- 
        local_change_pic()

    End Sub

    Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint

        dstRect = Me.ClientRectangle
        srcRect = dstRect

        g = e.Graphics

        '--- Picture ---
        dstRect = New Rectangle(New Point(pos.x, pos.y), PictureBox1.Size)

        g.DrawImage(PictureBox1.Image, dstRect, srcRect, GraphicsUnit.Pixel)

        '--- Help text ---
        Dim tempFont As New Font("Arial", 12)

        If stat_moving = 0 Then
            g.DrawString(hlp_1, tempFont, Brushes.Black, New Point(60, 60))
        End If

        '--- Dispose ---
        e.Graphics.Dispose()

    End Sub

    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If Timer1.Enabled = False Then Exit Sub

        'Accumulate time
        passedTime = passedTime + (Timer1.Interval / 1000) * multiTi

        'Renew position of PictureBox1 
        local_renew_pospic()

        'Check collision with form 
        local_check_colli(New Rectangle(pos.x, pos.y, PictureBox1.Width, PictureBox1.Height), Me)

        If collfind(0) = 0 Then
            If collfind(4) = 1 Then
                local_start_moving()
            Else
                local_after_colli(collRep(1))
            End If
        End If

    End Sub



    Private Sub local_kc_dir(ByRef kc As Integer)

        Dim flagchange As Boolean = False

        'Determine the key 
        Select Case kc
            Case Keys.Up
                If stat_moving = 0 And (stat_ang < max_ang) Then stat_ang += 1 : flagchange = True
            Case Keys.Down
                If stat_moving = 0 And (stat_ang > 0) Then stat_ang -= 1 : flagchange = True
            Case Keys.Space     'Start moving object when SPACE has been pressed, stop moving when pressing again
                local_start_moving()
        End Select

        'Change image of PictureBox1 
        If flagchange Then local_change_pic()

    End Sub

    Private Sub local_change_pic()

        PictureBox1.Image = listPic(stat_ang)
        Me.Refresh()

    End Sub

    Private Sub local_start_moving()

        'Switch value 
        stat_moving = Not stat_moving


        'Calibrate positions
        local_clb_pos(0)

        'Enable Timer1 
        passedTime = 0
        Timer1.Enabled = CBool(stat_moving)

        'Reset position 
        If stat_moving = 0 Then
            local_renew_resetpic()
        End If

    End Sub

    Private Sub local_clb_pos(ByRef mode As Integer)

        '----- Formula -----
        'vx=vx
        'vy=vy-(g*t)

        'x=x0+(v0x*t)
        'y=y0+(v0y*t)-(1/2*g*t^2)
        '___________________

        With pos
            If mode = 0 Then 'Initial values
                .ang = math_degtorad(listAng(stat_ang))
                .ini_vx = .ini_v * Math.Cos(.ang) : .ini_vy = .ini_v * Math.Sin(.ang)
            Else
                .vx = .ini_vx
                .vy = .ini_vy - (.g * passedTime)
                .ang = Math.Atan(.vy / .vx)
                If .vx < 0 And .vy > 0 Then .ang = math_revang(0, .ang)
                If .vx < 0 And .vy < 0 Then .ang = .ang + Math.PI

                '--- Debug ---
                Me.Text = "ang=" & .ang * 180 / Math.PI & " vx=" & .vx & " vy=" & .vy & " Delta y=" & (.vy * passedTime) - (0.5 * .g * (passedTime ^ 2))
                '_____________

                .x = .ini_x + (.ini_vx * passedTime)
                .y = .ini_y + -((.ini_vy * passedTime) - (0.5 * .g * (passedTime ^ 2)))
            End If
        End With

    End Sub

    Private Sub local_check_colli(ByRef rect As Rectangle, ByVal obj_dst As Object)

        collRep.Clear()

        If rect.Y <= 0 Then collRep.Add(3) : Exit Sub
        If rect.Y + rect.Height >= obj_dst.height Then collRep.Add(4) : Exit Sub
        If rect.X <= 0 Then collRep.Add(1) : Exit Sub
        If rect.X + rect.Width >= obj_dst.width Then collRep.Add(2) : Exit Sub

        collRep.Add(0)

    End Sub

    Private Sub local_renew_resetpic()

        'PictureBox1 
        With PictureBox1
            local_change_pic()

            pos.ini_x = user_ini_x : pos.ini_y = user_ini_y : pos.ini_v = user_ini_v

            pos.x = pos.ini_x : pos.y = pos.ini_y

            Me.Refresh()
        End With

    End Sub

    Private Sub local_renew_pospic()

        'Recalibrate positions
        local_clb_pos(1)

        'Renew position of picture
        Me.Refresh()

    End Sub

    Private Sub local_after_colli(ByRef mode As Integer)

        passedTime = 0

        With pos
            'Reset position & velocity
            .ini_x = .x : .ini_y = .y
            .ini_v = Math.Sqrt(.vx ^ 2 + .vy ^ 2)

            'Reverse angle
            .ang = math_revang(Fix((mode - 1) / 2), .ang)

            'Reset initial velocity (vx & vy)
            .ini_vx = .ini_v * Math.Cos(.ang) : .ini_vy = .ini_v * Math.Sin(.ang)

            'Force reversing direction of velocity
            Select Case mode
                Case 1
                    If .ini_vx < 0 Then .ini_vx = -.ini_vx
                Case 2
                    If .ini_vx > 0 Then .ini_vx = -.ini_vx
                Case 3
                    If .ini_vy > 0 Then .ini_vy = -.ini_vy
                Case 4
                    If .ini_vy < 0 Then .ini_vy = -.ini_vy
            End Select

        End With

    End Sub



    Private Function math_degtorad(ByRef deg As Single) As Single
        Return deg * Math.PI / 180
    End Function

    Private Function math_revang(ByRef mode As Integer, ByRef ang As Single) As Single

        'mode=0 -> By Y Axis
        'mode=1 -> By X Axis

        If mode = 0 Then
            Return Math.PI - (ang Mod Math.PI) + Fix(ang / Math.PI) * Math.PI
        Else
            Return (Math.PI * 2) - ang
        End If

    End Function

    Public Function collfind(ByRef f As Integer)

        Dim l As Long

        collfind = 0
        For l = 1 To collRep.Count
            If collRep(l) = f Then Return 1
        Next

    End Function

End Class


math_degtorad, math_revang, collfind 三个函数放到 模组(Module) 里会比较好看








附上中文解释的版本:


Form1 (With Chinese Comments) :

复制程式
Public Class Form1

    '---------- Local structures ----------

    'Positions [位置的变数]
    Structure struc_pos
        Dim x, y As Integer 'Current position [目前的 x,y]
        Dim ini_x, ini_y As Integer 'Initial position [抛物线参考的最初 x,y,就是物理中表示的 x0,y0]
        Dim ang As Single 'Current angle [目前的角度,为碰撞时可转换]
        Dim vx, vy As Single 'Current velocity [目前的速度分量]
        Dim ini_vx, ini_vy As Single 'Initial velocity [一开始的 速度分量,就是物理中表示的 vx0,vy0]
        Dim ini_v As Single 'Initial velocity [一开始的速度]
        Dim g As Single  'Gravity constant [重力常数]
    End Structure

    '---------- Local constants ----------

    'Initial positions
    Const user_ini_v As Single = 80 '[设定一开始的速度(可调整)]
    Const user_ini_x As Integer = 390, user_ini_y As Integer = 180 '[图片一开始的座标(可调整)]

    '---------- Local variables ----------

    'Graphics [绘图]
    Dim g As System.Drawing.Graphics
    Dim dstRect, srcRect As Rectangle

    'List [清单]
    Dim listPic As New List(Of Image) 'List of picture
    Dim listAng As New List(Of Integer) 'List of angle

    'Collection [集合]
    Dim collRep As New Collection

    'Positions [宣告座标的巢状结构]
    Dim pos As struc_pos

    'Flags [旗标]
    Dim stat_moving As Integer 'Status (Pausing->0, Moving->1) [纪录是否在移动]
    Dim stat_ang, max_ang As Integer 'Angle [角度(DEG),与最大值]
    Dim passedTime, multiTi As Single 'Time [已经过时间,与时间加倍量]

    'Help texts
    Const hlp_1 As String = "(1) 按 ""上"",""下"" 切换角度" & vbNewLine & "(2) 按 ""空白键"" 开始发射/停止" & vbNewLine & vbNewLine & "当物体碰撞到底下边缘才会消失"


    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown

        local_kc_dir(e.KeyCode)

    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        Dim i As Integer

        '--- Variables ---

        'Position
        With pos
            .g = 9.8
            .ini_v = user_ini_v
        End With

        'Status
        stat_moving = 0
        stat_ang = 3 '[设定一开始是第三张图片,30度的]

        'Time
        multiTi = 15 '[时间加倍量,太低图片会跑很慢]

        '--- List of Images ---
        '[读取图片,并读取角度值]
        max_ang = -1
        For i = 30 To 90 Step 5
            listPic.Add(Image.FromFile("ghost_" & i & ".bmp"))
            listAng.Add(i)
            max_ang += 1
        Next

        '--- Obj. ---

        'PictureBox1
        local_renew_resetpic()
        PictureBox1.Visible = False

        'Timer1
        Timer1.Interval = 20

        '--- Sub ---
        local_change_pic()

    End Sub

    Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint

        dstRect = Me.ClientRectangle
        srcRect = dstRect

        g = e.Graphics

        '--- Picture ---
        dstRect = New Rectangle(New Point(pos.x, pos.y), PictureBox1.Size)

        g.DrawImage(PictureBox1.Image, dstRect, srcRect, GraphicsUnit.Pixel)

        '--- Help text ---
        Dim tempFont As New Font("Arial", 12)

        If stat_moving = 0 Then
            g.DrawString(hlp_1, tempFont, Brushes.Black, New Point(60, 60))
        End If

        '--- Dispose ---
        e.Graphics.Dispose()

    End Sub

    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If Timer1.Enabled = False Then Exit Sub

        'Accumulate time [时间累积]
        passedTime = passedTime + (Timer1.Interval / 1000) * multiTi

        'Renew position of PictureBox1 [更新图片座标]
        local_renew_pospic()

        'Check collision with form [检查是否碰撞]
        local_check_colli(New Rectangle(pos.x, pos.y, PictureBox1.Width, PictureBox1.Height), Me)

        If collfind(0) = 0 Then '[假如碰撞,这是呼叫 collfind 去找 collRep 中元素是否没有 0 这个值,也就是函数检查中检查到碰撞]
            If collfind(4) = 1 Then '[底下的碰撞,再呼叫 local_start_moving 即可停止]
                local_start_moving()
            Else
                local_after_colli(collRep(1)) '[其他上、左、右边的碰撞,转换座标、速度、角度的函数,为了碰撞后接下来的反弹而作]
            End If
        End If

    End Sub



    Private Sub local_kc_dir(ByRef kc As Integer)

        Dim flagchange As Boolean = False

        'Determine the key
        Select Case kc
            Case Keys.Up
                If stat_moving = 0 And (stat_ang < max_ang) Then stat_ang += 1 : flagchange = True
            Case Keys.Down
                If stat_moving = 0 And (stat_ang > 0) Then stat_ang -= 1 : flagchange = True
            Case Keys.Space     'Start moving object when SPACE has been pressed, stop moving when pressing again
                local_start_moving()
        End Select

        'Change image of PictureBox1
        If flagchange Then local_change_pic()

    End Sub

    Private Sub local_change_pic()

        PictureBox1.Image = listPic(stat_ang)
        Me.Refresh()

    End Sub

    Private Sub local_start_moving()

        'Switch value
        stat_moving = Not stat_moving


        'Calibrate positions [调整座标]
        local_clb_pos(0)

        'Enable Timer1
        passedTime = 0
        Timer1.Enabled = CBool(stat_moving)

        'Reset position
        If stat_moving = 0 Then
            local_renew_resetpic()
        End If

    End Sub

    Private Sub local_clb_pos(ByRef mode As Integer)

        '----- Formula ----- [物理公式参考]
        'vx=vx
        'vy=vy-(g*t)

        'x=x0+(v0x*t)
        'y=y0+(v0y*t)-(1/2*g*t^2)
        '___________________

        With pos
            If mode = 0 Then 'Initial values
                .ang = math_degtorad(listAng(stat_ang)) '[把角度 DEG格式 转换到 RAD格式]
                .ini_vx = .ini_v * Math.Cos(.ang) : .ini_vy = .ini_v * Math.Sin(.ang) '[设定 vx0,vy0 好让接下来移动中公式使用]
            Else
                .vx = .ini_vx '[斜向抛射中 vx 不会变]
                .vy = .ini_vy - (.g * passedTime) '[斜向抛射 vy=vy0-(gt)]
                .ang = Math.Atan(.vy / .vx) '[用 ArcTan() 来更新角度的值]
                If .vx < 0 And .vy > 0 Then .ang = math_revang(0, .ang) '[底下这两行是为了修正 ArcTan 的结果]
                If .vx < 0 And .vy < 0 Then .ang = .ang + Math.PI

                '--- Debug ---
                Me.Text = "ang=" & .ang * 180 / Math.PI & " vx=" & .vx & " vy=" & .vy & " Delta y=" & (.vy * passedTime) - (0.5 * .g * (passedTime ^ 2))
                '_____________

                .x = .ini_x + (.ini_vx * passedTime) '[底下两行是更新目前座标 x,y]
                .y = .ini_y + -((.ini_vy * passedTime) - (0.5 * .g * (passedTime ^ 2)))
            End If
        End With

    End Sub

    Private Sub local_check_colli(ByRef rect As Rectangle, ByVal obj_dst As Object)

        collRep.Clear()

        If rect.Y <= 0 Then collRep.Add(3) : Exit Sub '[与天花板碰撞]
        If rect.Y + rect.Height >= obj_dst.height Then collRep.Add(4) : Exit Sub '[与地板碰撞]
        If rect.X <= 0 Then collRep.Add(1) : Exit Sub '[与左边碰撞]
        If rect.X + rect.Width >= obj_dst.width Then collRep.Add(2) : Exit Sub '[与右边碰撞]

        collRep.Add(0)

    End Sub

    Private Sub local_renew_resetpic()

        'PictureBox1
        With PictureBox1
            local_change_pic()

            pos.ini_x = user_ini_x : pos.ini_y = user_ini_y : pos.ini_v = user_ini_v

            pos.x = pos.ini_x : pos.y = pos.ini_y

            Me.Refresh()
        End With

    End Sub

    Private Sub local_renew_pospic()

        'Recalibrate positions [重新调整座标]
        local_clb_pos(1)

        'Renew position of picture [将触发 Form1_Paint]
        Me.Refresh()

    End Sub

    Private Sub local_after_colli(ByRef mode As Integer)

        passedTime = 0

        With pos
            'Reset position & velocity [将目前的 x,y 载入到 x0,y0 等于是下次的抛物线从碰撞的地方开始]
            .ini_x = .x : .ini_y = .y
            .ini_v = Math.Sqrt(.vx ^ 2 + .vy ^ 2)

            'Reverse angle [转换角度]
            .ang = math_revang(Fix((mode - 1) / 2), .ang)

            'Reset initial velocity (vx & vy) [利用转换而来的角度来取得 vx0,vy0]
            .ini_vx = .ini_v * Math.Cos(.ang) : .ini_vy = .ini_v * Math.Sin(.ang)

            'Force reversing direction of velocity [有时边缘的碰撞会造成连续碰撞,为了修正,而强制侦测并强制转换 vx0,vy0]
            Select Case mode
                Case 1
                    If .ini_vx < 0 Then .ini_vx = -.ini_vx
                Case 2
                    If .ini_vx > 0 Then .ini_vx = -.ini_vx
                Case 3
                    If .ini_vy > 0 Then .ini_vy = -.ini_vy
                Case 4
                    If .ini_vy < 0 Then .ini_vy = -.ini_vy
            End Select

        End With

    End Sub



    Private Function math_degtorad(ByRef deg As Single) As Single
        Return deg * Math.PI / 180 '[Rad = Deg * pi / 180]
    End Function

    Private Function math_revang(ByRef mode As Integer, ByRef ang As Single) As Single

        'mode=0 -> By Y Axis [Y轴反射,例如 30度(DEG) 会转成 150度(DEG)]
        'mode=1 -> By X Axis [X轴反射,例如 30度(DEG) 会转成 330度(DEG),不过这里是 RAD 的转换]

        If mode = 0 Then
            Return Math.PI - (ang Mod Math.PI) + Fix(ang / Math.PI) * Math.PI
        Else
            Return (Math.PI * 2) - ang
        End If

    End Function

    Public Function collfind(ByRef f As Integer) '[在 collRep 集合中寻找元素]

        Dim l As Long

        collfind = 0
        For l = 1 To collRep.Count
            If collRep(l) = f Then Return 1
        Next

    End Function

End Class







原理解析:



[ 此文章被ebolaman在2011-08-08 19:15重新编辑 ]


My BOINC stats :

献花 x0 回到顶端 [6 楼] From:台湾宽频通讯顾问股份有限公司 | Posted:2011-08-08 13:20 |
za08280714
数位造型
个人文章 个人相簿 个人日记 个人地图
小人物
级别: 小人物 该用户目前不上站
推文 x0 鲜花 x3
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

感谢大大的指导.想说原理很简单.可是做出来真得好难.程式里有个错误讯息.我有用Event 宣告 可是还是不行.还是2008的版本问题
 

Structure struc_inipos
    Const user_ini_v As Single = 80 '[设定一开始的速度(可调整)]
    Const user_ini_x As Integer = 390, user_ini_y As Integer = 180 '[图片一开始的座标(可调整)]
  End Structure


错误结构 'struc_inipos' 至少必须包含一个执行个体成员变数或 Event 宣告。


献花 x0 回到顶端 [7 楼] From:台湾中华电信股份有限公司 | Posted:2011-08-08 16:58 |
ebolaman 手机 会员卡
个人文章 个人相簿 个人日记 个人地图
特殊贡献奖

级别: 副版主 该用户目前不上站
版区: 程式设计
推文 x38 鲜花 x458
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

下面是引用 za08280714 于 2011-08-08 16:58 发表的 : 到引言文
感谢大大的指导.想说原理很简单.可是做出来真得好难.程式里有个错误讯息.我有用Event 宣告 可是还是不行.还是2008的版本问题
 

Structure struc_inipos
      Const user_ini_v As Single = 80 '[设定一开始的速度(可调整)]
      Const user_ini_x As Integer = 390, user_ini_y As Integer = 180 '[图片一开始的座标(可调整)]
  End Structure


错误结构 'struc_inipos' 至少必须包含一个执行个体成员变数或 Event 宣告。


好像是版本不同用法接受度不同

我已经把 巢状结构去除,改成常数了

程式码在上面部分,已重新编辑过


My BOINC stats :

献花 x0 回到顶端 [8 楼] From:台湾宽频通讯顾问股份有限公司 | Posted:2011-08-08 19:15 |
za08280714
数位造型
个人文章 个人相簿 个人日记 个人地图
小人物
级别: 小人物 该用户目前不上站
推文 x0 鲜花 x3
分享: 转寄此文章 Facebook Plurk Twitter 复制连结到剪贴簿 转换为繁体 转换为简体 载入图片

感谢大大 已经可以运作了.大大真是利害
我要开始研究程式了


献花 x0 回到顶端 [9 楼] From:台湾中华电信股份有限公司 | Posted:2011-08-09 10:17 |

<<   1   2  下页 >>(共 2 页)
首页  发表文章 发表投票 回覆文章
Powered by PHPWind v1.3.6
Copyright © 2003-04 PHPWind
Processed in 0.081422 second(s),query:16 Gzip disabled
本站由 瀛睿律师事务所 担任常年法律顾问 | 免责声明 | 本网站已依台湾网站内容分级规定处理 | 连络我们 | 访客留言