廣告廣告
  加入我的最愛 設為首頁 風格修改
首頁 首尾
 手機版   訂閱   地圖  簡體 
您是第 7567 個閱讀者
 
<<   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.059735 second(s),query:16 Gzip disabled
本站由 瀛睿律師事務所 擔任常年法律顧問 | 免責聲明 | 本網站已依台灣網站內容分級規定處理 | 連絡我們 | 訪客留言