首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

用VB实现模拟的卫星map下显示车辆轨迹,思路下如何做啊来谈谈自己的想法

2012-12-31 
用VB实现模拟的卫星地图上显示车辆轨迹,思路上怎么做啊,各位高手来谈谈自己的想法。我通过Google Earth 截

用VB实现模拟的卫星地图上显示车辆轨迹,思路上怎么做啊,各位高手来谈谈自己的想法。

我通过Google Earth 截图拼接起来一张大图,然后准备用VB编程实现一个预定轨迹(一个车辆的运动模拟轨迹)在该图上运动,并将运动轨迹保持显示在地图的中部。

这个模型框架怎么设计啊?


我是个新手,初次接触VB,希望大家多多指教和点评。
[解决办法]
模拟一下。

'窗体上放一个 PictureBox 和一个 Timer 控件'
Option Explicit

Private Sub Form_Load()
    Dim pic As IPictureDisp
    
    Me.ScaleMode = vbPixels
    Me.WindowState = vbMaximized
    
    Picture1.BorderStyle = vbBSNone
    Picture1.Move 0, 0, 800, 600
    Picture1.ScaleMode = vbPixels
    Picture1.BackColor = vbBlack
    Picture1.ForeColor = vbBlue
    Picture1.AutoRedraw = True
    Set pic = LoadPicture("C:\WINDOWS\Web\Wallpaper\Bliss.bmp")
    Picture1.PaintPicture pic, 0, 0
    Picture1.PSet (0, 300)
    
    Timer1.Interval = 100
End Sub

Private Sub Timer1_Timer()
    Dim dy As Long
    dy = Rnd() * 20 - 10
    Picture1.Line -Step(10, dy)
End Sub

[解决办法]
楼主的问题知道如何解决没?

参考一下我的这段代码吧:
' *** 窗体模块代码 ***
' 窗体名称: Form1
' 窗体内加入 Picture1、Picture2、Timer1
Option Explicit

Private objMapDisp As claCanvs
Private lKeyCtrl As Long

Private Sub Form_Load()

    On Error GoTo E_Handle
    Me.ScaleMode = 3
    Me.Width = 320 * Screen.TwipsPerPixelX
    Me.Height = 260 * Screen.TwipsPerPixelY
    Picture1.ScaleMode = 3
    Picture1.Move 6, 8, ScaleWidth - 12, ScaleHeight - 16
    With Picture2
        .Appearance = 0
        .BorderStyle = 0
        .ScaleMode = 3
        .AutoSize = True
        .AutoRedraw = True
        .Visible = False
        ' ***** 在这里加载你的地图!!!*****
        .Picture = LoadPicture("E:\Picture\资料图片\世界地图_04亚洲.jpg")
    End With

    Set objMapDisp = New claCanvs
    Call objMapDisp.InitObj(Picture1, Picture2)
    Timer1.Enabled = False
    Timer1.Interval = 50
    Timer1.Enabled = True
    Exit Sub

E_Handle:
    MsgBox "程序初始化出错,将结束运行!", 48, "出错!"
    Unload Me


    End

End Sub

Private Sub Form_Terminate()

    Set objMapDisp = Nothing
    End

End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)

    Select Case KeyCode
        Case vbKeyUp: lKeyCtrl = 1
        Case vbKeyDown: lKeyCtrl = 3
        Case vbKeyLeft: lKeyCtrl = 4
        Case vbKeyRight: lKeyCtrl = 2
    End Select
    
End Sub

Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)

    lKeyCtrl = 0

End Sub

Private Sub Timer1_Timer()

    Call objMapDisp.CarMove(lKeyCtrl)
    Call objMapDisp.Render
    
End Sub



' *** 类模块代码 ***
' 类名称: claCanvs
Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
                    ByVal x As Long, ByVal y As Long, _
                    ByVal nWidth As Long, ByVal nHeight As Long, _
                    ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
                    ByVal dwRop As Long) As Long

Private objMap As PictureBox, objCanvs As PictureBox
Private lCanvsDC As Long, lMapDC As Long
Private lCameraWidth As Long, lCameraHeight As Long
Private lCameraMaxX As Long, lCameraMaxY As Long
Private lMapWidth As Long, lMapHeight As Long
Private lCameraX As Long, lCameraY As Long
Private lCarX As Long, lCarY As Long
Private lOffsetX As Long, lOffsetY As Long
Private lStep As Long, lFlash As Long

Public Sub InitObj(picCanv As PictureBox, picMap As PictureBox)

    Set objMap = picMap
    Set objCanvs = picCanv
    lCanvsDC = picCanv.hDC
    lMapDC = picMap.hDC
    lMapWidth = objMap.Width
    lMapHeight = objMap.Height
    lCameraWidth = picCanv.ScaleWidth
    lCameraHeight = picCanv.ScaleHeight
    lCameraMaxX = lMapWidth - lCameraWidth
    lCameraMaxY = lMapHeight - lCameraHeight
    Randomize
    lOffsetX = lCameraWidth \ 2


    lOffsetY = lCameraHeight \ 2
    lCarX = Rnd() * 400 + 200
    lCarY = Rnd() * 260 + 160
    lFlash = 0: lStep = 2

End Sub

Public Sub CarMove(ByVal dir As Long)

    Dim x&, y&

    If (dir = 0) Then Exit Sub
    x = lCarX: y = lCarY
    Select Case dir
        Case 1: lCarY = lCarY - lStep: If (lCarY < 0) Then lCarY = 0
        Case 2: lCarX = lCarX + lStep: If (lCarX >= lMapWidth) Then lCarX = lMapWidth - 1
        Case 3: lCarY = lCarY + lStep: If (lCarY >= lMapHeight) Then lCarY = lMapHeight - 1
        Case 4: lCarX = lCarX - lStep: If (lCarX < 0) Then lCarX = 0
    End Select
    objMap.Line (x, y)-(lCarX, lCarY), vbRed

End Sub

Public Sub Render()

    Dim x&, y&
    lCameraX = lCarX - lOffsetX: lCameraY = lCarY - lOffsetY
    If (lCameraX < 0) Then
        lCameraX = 0
    ElseIf (lCameraX > lCameraMaxX) Then
        lCameraX = lCameraMaxX
    End If
    If (lCameraY < 0) Then
        lCameraY = 0
    ElseIf (lCameraY > lCameraMaxY) Then
        lCameraY = lCameraMaxY
    End If
    x = lCarX - lCameraX: y = lCarY - lCameraY
    Call BitBlt(lCanvsDC, 0, 0, lCameraWidth, lCameraHeight, lMapDC, lCameraX, lCameraY, vbSrcCopy)
    lFlash = lFlash + 1 And 15
    objCanvs.DrawWidth = 1
    objCanvs.Line (x - 8, y)-(x + 8, y), &HE0F0&
    objCanvs.Line (x, y - 8)-(x, y + 8), &HE0F0&
    objCanvs.DrawWidth = 2
    If (lFlash > 6) Then
        objCanvs.Circle (x, y), 5, &HFF00D6
    Else
        objCanvs.Circle (x, y), 5, &HFFFF&
    End If
    
End Sub


热点排行