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

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

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


我是个新手，初次接触VB，希望大家多多指教和点评。

21 个解决方案

#1

用line方法直接画线作轨迹

#2

大图放在picture1里,用Pset在中间画一条曲线,然后保存就行了

#3

引用 2 楼 syssz 的回复:

大图放在picture1里,用Pset在中间画一条曲线,然后保存就行了

我是新手，很多不懂。这个画出来的应该不是动态的吧，，怎样画出来一个标志在上面运动呢

#4

引用 1 楼 asftrhgjhkjlkttttttt 的回复:

用line方法直接画线作轨迹

可不可以打开*.TXT格式包含轨迹信息的文件，提取轨迹信息； 
从拼接的地图上重现轨迹呢。 

#5

引用 4 楼 zj272208757 的回复:

引用 1 楼 asftrhgjhkjlkttttttt 的回复:
用line方法直接画线作轨迹

可不可以打开*.TXT格式包含轨迹信息的文件，提取轨迹信息；
从拼接的地图上重现轨迹呢。

可以，你只要把坐标点保存到.txt文件里，然后再次调用就可以重新再现了。

#6

做动画用flash是不是更好一点？

#7

模拟一下。

'窗体上放一个 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

#8

地图上显示汽车的轨迹，首先，地图是多图层叠加起来的一张图，不是你的jpg或者是bmp格式的图形
汽车是在新增加的临时图层中，然后根据读取到的gps数据，画轨迹

#9

图层叠加和控制绘图先后次序是一样的作用。

#10

参考卷轴类游戏的地图画法吧。

#11

引用 5 楼 chinaboyzyq 的回复:

引用 4 楼 zj272208757 的回复:
引用 1 楼 asftrhgjhkjlkttttttt 的回复:
用line方法直接画线作轨迹

可不可以打开*.TXT格式包含轨迹信息的文件，提取轨迹信息；
从拼接的地图上重现轨迹呢。


可以，你只要把坐标点保存到.txt文件里，然后再次调用就可以重新再现了。

难道他们的方法不行吗

#12

该回复于2010-01-05 16:42:53被版主删除

#13

引用 7 楼 tiger_zhao 的回复:

模拟一下。
VB code'窗体上放一个 PictureBox 和一个 Timer 控件'OptionExplicitPrivateSub Form_Load()Dim picAs IPictureDisp
    
    Me.ScaleMode= vbPixels
    Me.WindowState= vbMaximized
    
    Picture1.BorderStyle= vbBSNone
    Picture1.Move0,0,800,600
    Picture1.ScaleMode= vbPixels
    Picture1.BackColor= vbBlack
    Picture1.ForeColor= vbBlue
    Picture1.AutoRedraw=TrueSet pic=LoadPicture("C:\WINDOWS\Web\Wallpaper\Bliss.bmp")
    Picture1.PaintPicture pic,0,0
    Picture1.PSet (0,300)
    
    Timer1.Interval=100End SubPrivateSub Timer1_Timer()Dim dyAsLong
    dy=Rnd()*20-10
    Picture1.Line-Step(10, dy)End Sub

能否解释下这个程序啊，主要能达到什么目的啊，其中的参数是怎么设定的啊，打开*.TXT格式包含轨迹信息的文件（这个轨迹文件又怎样具体设定呢），提取轨迹信息； 从拼接的地图上重现轨迹。
并将运动轨迹保持显示在地图的中部，具体怎么操作啊，麻烦了。

#14

我7楼代码演示如何在图片背景上画线。
1)我图片是固定的，你需要将图片相对车辆移动，只要调整 PaintPicture 第2、3两个参数就可以。
2)我的曲线（车辆移动）是通过随机数模拟的，你只要在定时中改成文件读入即可。文件格式随你喜欢定义，反正每个时间间隔只要能读到新的位置坐标即可。
3)由于中心点动，图片要不停刷新，建议用数组模拟一个循环队列，将最新n次的坐标记录下来，经过坐标转换后画线。

#15

VB+地理地图信息平台
我用VB+TopMap6，你说的功能很简单就能实现

#16

楼主的问题知道如何解决没？

参考一下我的这段代码吧：

' *** 窗体模块代码 ***
' 窗体名称: 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

#17

用 箭头键 进行操作。

#18

真的是很感谢你们啊，我的问题很严重，我根本不知道哪里下手，我是个新手，很多都不懂，我还得慢慢学习。，我还是从基本的做起学起。

#19

up

#20

还不知道从哪下手？

饭都喂到嘴边了…………

#21

学习中。VB做这样的不知道是什么样效果，个人觉得没有直接用google map api好用些。