用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