[GB.MAP]
* NEW: a new function Grab allow to get an image of a given zone at the given size and at the better zoom level. ex: PictureBox1.Picture = $Map.Grab($Map!MyShape!zone1.Bounds, PictureBox1.Width, PictureBox1.Height, 0).Picture * NEW: Map Class have an event Draw() * NEW: Map have a property Loading that allow to control if the layers have finished to get theire datas * NEW: I've replaced the _ShapeItem box (RectF) by Bounds (MapBounds) git-svn-id: svn://localhost/gambas/trunk@5649 867c0c6c-44f3-4631-809d-bfa615b0a4ec
This commit is contained in:
Fabien Bodard
parent
abc5bd861c
commit
17978a3f38
11 changed files with 253 additions and 29 deletions
|
|
@ -78,6 +78,10 @@ b
|
|||
:
|
||||
|
||||
|
||||
:Draw
|
||||
:
|
||||
|
||||
|
||||
Refresh
|
||||
m
|
||||
|
||||
|
|
@ -97,7 +101,7 @@ _MapTile
|
|||
AddShape
|
||||
m
|
||||
_MapShape
|
||||
(Name)s[(Shape)Shapes;]
|
||||
(Name)s
|
||||
_get
|
||||
m
|
||||
o
|
||||
|
|
@ -118,6 +122,93 @@ tmrDraw_Timer
|
|||
m
|
||||
|
||||
|
||||
Grab
|
||||
m
|
||||
Image
|
||||
(Bounds)MapBounds;(iWidth)i(iHeight)i[(Padding)i(Zoom)i]
|
||||
#MapBounds
|
||||
|
||||
C
|
||||
Left
|
||||
p
|
||||
f
|
||||
|
||||
Lon
|
||||
p
|
||||
f
|
||||
|
||||
Est
|
||||
p
|
||||
f
|
||||
|
||||
Right
|
||||
p
|
||||
f
|
||||
|
||||
Lon2
|
||||
p
|
||||
f
|
||||
|
||||
West
|
||||
p
|
||||
f
|
||||
|
||||
Top
|
||||
p
|
||||
f
|
||||
|
||||
Lat
|
||||
p
|
||||
f
|
||||
|
||||
North
|
||||
p
|
||||
f
|
||||
|
||||
Bottom
|
||||
p
|
||||
f
|
||||
|
||||
Lat2
|
||||
p
|
||||
f
|
||||
|
||||
South
|
||||
p
|
||||
f
|
||||
|
||||
TopLeft
|
||||
p
|
||||
MapPoint
|
||||
|
||||
NorthEast
|
||||
p
|
||||
MapPoint
|
||||
|
||||
BottomRight
|
||||
p
|
||||
MapPoint
|
||||
|
||||
SouthWest
|
||||
p
|
||||
MapPoint
|
||||
|
||||
InBounds
|
||||
m
|
||||
b
|
||||
(P)MapPoint;
|
||||
Contain
|
||||
m
|
||||
b
|
||||
(Bound)MapBounds;
|
||||
Merge
|
||||
m
|
||||
MapBounds
|
||||
(Bound)MapBounds;
|
||||
_Call
|
||||
M
|
||||
MapBounds
|
||||
(NorthEast)MapPoint;(SouthWest)MapPoint;
|
||||
#MapPoint
|
||||
|
||||
C
|
||||
|
|
@ -312,9 +403,9 @@ _ShapeItem
|
|||
#_ShapeItem
|
||||
|
||||
C
|
||||
Box
|
||||
Bounds
|
||||
v
|
||||
RectF
|
||||
MapBounds
|
||||
|
||||
Id
|
||||
v
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
Geo
|
||||
Map
|
||||
MapBounds
|
||||
MapPoint
|
||||
MapView
|
||||
Shapes
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ Private $aLayerNames As New String[]
|
|||
'Private $bPreload As Boolean
|
||||
Public _ShowWithEffect As Boolean
|
||||
Event Refresh
|
||||
|
||||
Event Draw
|
||||
Private Function Top_Read() As Integer
|
||||
|
||||
Return $iTop
|
||||
|
|
@ -190,18 +190,18 @@ Public Sub AddTile(Name As String, Pattern As String, Optional Args As Collectio
|
|||
|
||||
End
|
||||
|
||||
Public Function AddShape(Name As String, Optional Shape As Shapes) As _MapShape
|
||||
Public Function AddShape(Name As String) As _MapShape
|
||||
|
||||
Dim hLayer As New _MapShape(Shape)
|
||||
Dim hLayer As New _MapShape
|
||||
|
||||
hLayer.Name = Name
|
||||
|
||||
$aLayers.Add(hLayer)
|
||||
$aLayerNames.Add(Name)
|
||||
Object.Attach(hLayer, Me, "Layer")
|
||||
If Shape Then hLayer.Data = Shape
|
||||
'If Shape Then hLayer.Data = Shape
|
||||
Return hLayer
|
||||
|
||||
|
||||
End
|
||||
|
||||
Public Sub _get(Name As String) As Object
|
||||
|
|
@ -244,7 +244,7 @@ Public Sub Draw()
|
|||
Draw.Rect(Draw.Width - iTextWidth - 5, Draw.Height - iTextHeight - 2, iTextWidth + 6, iTextHeight + 4)
|
||||
Draw.Text(sCopyright, Draw.Width - iTextWidth, Draw.Height - iTextHeight)
|
||||
Endif
|
||||
|
||||
Raise Draw
|
||||
End
|
||||
|
||||
Public Sub Layer_Refresh()
|
||||
|
|
@ -275,7 +275,56 @@ End
|
|||
' End
|
||||
|
||||
Private Function Bounds_Read() As MapBounds
|
||||
|
||||
|
||||
Return $Bounds
|
||||
|
||||
End
|
||||
|
||||
Public Function Grab(Bounds As MapBounds, iWidth As Integer, iHeight As Integer, Optional Padding As Integer, Optional Zoom As Integer) As Image
|
||||
|
||||
Dim i As Integer
|
||||
Dim hBndCenter As MapPoint = MapPoint((Bounds.Lat + Bounds.Lat2) / 2, (Bounds.Lon + Bounds.Lon2) / 2)
|
||||
Dim hPix, hPix2 As Point
|
||||
Dim hMpBounds As MapBounds
|
||||
Dim hImg As New Image(iWidth, iHeight, Color.Yellow)
|
||||
Dim bLoad As Boolean
|
||||
Dim hLayer As _MapLayer
|
||||
'Définir la zone a afficher
|
||||
'On centre la carte sur le bound
|
||||
Me.Center = hBndCenter
|
||||
Me.Resize(iwidth, iHeight)
|
||||
|
||||
If Zoom Then
|
||||
|
||||
Me.Zoom = Zoom
|
||||
|
||||
Else
|
||||
|
||||
For i = 18 To 1 Step -1
|
||||
hpix = Geo.MapPointToPixel(hBndCenter, i)
|
||||
hPix2 = Geo.MapPointToPixel(Bounds.BottomRight, i)
|
||||
If (hPix2.X - hpix.X) <= (iWidth / 2 - Padding) And If (hpix.Y - hPix2.Y) <= (iHeight / 2 - Padding) Then
|
||||
Break
|
||||
Endif
|
||||
Next
|
||||
|
||||
Me.Zoom = i
|
||||
Endif
|
||||
|
||||
tmrLoad_Timer
|
||||
|
||||
Repeat
|
||||
bLoad = False
|
||||
For Each hLayer In $aLayers
|
||||
If hLayer.loading = True Then bLoad = True
|
||||
Wait
|
||||
Next
|
||||
Until bLoad = False
|
||||
|
||||
Draw.Begin(hImg)
|
||||
Draw()
|
||||
Draw.End
|
||||
|
||||
Return hImg
|
||||
|
||||
End
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
' Gambas class file
|
||||
|
||||
Export
|
||||
Public Box As New RectF
|
||||
Public Bounds As New MapBounds
|
||||
Public Id As String
|
||||
Public Type As Integer
|
||||
Public Points As Object
|
||||
|
|
@ -11,8 +11,8 @@ Public Image As Image
|
|||
|
||||
Public Function Contains(hMapPoint As MapPoint) As Boolean
|
||||
|
||||
If Box.X < hMapPoint.Lon And Box.Right > hMapPoint.Lon Then
|
||||
If Box.Y < hMapPoint.Lat And Box.Bottom > hMapPoint.Lat Then
|
||||
If Bounds.X < hMapPoint.Lon And Bounds.Right > hMapPoint.Lon Then
|
||||
If Bounds.Y < hMapPoint.Lat And Bounds.Bottom > hMapPoint.Lat Then
|
||||
Return True
|
||||
Endif
|
||||
Endif
|
||||
|
|
|
|||
|
|
@ -9,8 +9,6 @@
|
|||
{ MapView1 MapView
|
||||
MoveScaled(32,19,16,16)
|
||||
Expand = True
|
||||
AllowEffect = False
|
||||
ShowControls = False
|
||||
}
|
||||
{ GridView1 GridView
|
||||
MoveScaled(72,11,25,35)
|
||||
|
|
|
|||
23
comp/src/gb.map/.src/Tests/Form1.class
Normal file
23
comp/src/gb.map/.src/Tests/Form1.class
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
' Gambas class file
|
||||
|
||||
Private $Map As New Map As "Map"
|
||||
Public Sub Form_Open()
|
||||
$Map.AddTile("OpenStreet", "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", Null, "os")
|
||||
$Map.AddShape("MyShape")
|
||||
$Map!MyShape.AddPolygon("zone1", [[MapPoint(45.70534, -0.358086), MapPoint(45.709176, -0.314312), MapPoint(45.67968, -0.313454), MapPoint(45.674403, -0.36375), MapPoint(45.689634, -0.379372)]])
|
||||
|
||||
PictureBox1.Picture = $Map.Grab($Map!MyShape!zone1.Bounds, PictureBox1.Width, PictureBox1.Height, 0).Picture
|
||||
PictureBox2.Picture = $Map.Grab($Map!MyShape!zone1.Bounds, PictureBox2.Width, PictureBox2.Height, 0).Picture
|
||||
PictureBox3.Picture = $Map.Grab($Map!MyShape!zone1.Bounds, PictureBox3.Width, PictureBox3.Height, 0).Picture
|
||||
PictureBox4.Picture = $Map.Grab($Map!MyShape!zone1.Bounds, PictureBox4.Width, PictureBox4.Height, 0).Picture
|
||||
PictureBox5.Picture = $Map.Grab($Map!MyShape!zone1.Bounds, PictureBox5.Width, PictureBox5.Height, 0).Picture
|
||||
End
|
||||
|
||||
|
||||
Public Sub Map_Draw()
|
||||
Dim hPoint As Point
|
||||
hPoint = Geo.MapPointToPixel($Map!MyShape!zone1.Center, $Map.Zoom)
|
||||
Draw.Foreground = Color.Red
|
||||
Draw.Text("Cognac", hPoint.x - $Map.PixelBox.x, hPoint.Y - $Map.PixelBox.Y)
|
||||
|
||||
End
|
||||
21
comp/src/gb.map/.src/Tests/Form1.form
Normal file
21
comp/src/gb.map/.src/Tests/Form1.form
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
# Gambas Form File 3.0
|
||||
|
||||
{ Form Form
|
||||
MoveScaled(0,0,132,67)
|
||||
{ PictureBox1 PictureBox
|
||||
MoveScaled(6,3,8,7)
|
||||
Background = &H7F00FF&
|
||||
}
|
||||
{ PictureBox2 PictureBox
|
||||
MoveScaled(10,13,24,19)
|
||||
}
|
||||
{ PictureBox3 PictureBox
|
||||
MoveScaled(48,19,62,44)
|
||||
}
|
||||
{ PictureBox4 PictureBox
|
||||
MoveScaled(6,31,8,33)
|
||||
}
|
||||
{ PictureBox5 PictureBox
|
||||
MoveScaled(30,4,101,8)
|
||||
}
|
||||
}
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
' Gambas class file
|
||||
|
||||
Export
|
||||
Property Left, Lon, Est As Float
|
||||
Property Right, Lon2, West As Float
|
||||
Property Top, Lat, North As Float
|
||||
|
|
@ -7,8 +8,8 @@ Property Bottom, Lat2, South As Float
|
|||
|
||||
Private $mpTopLeft As New MapPoint
|
||||
Private $mpBottomRight As New MapPoint
|
||||
Property TopLeft As MapPoint
|
||||
Property BottomRight As MapPoint
|
||||
Property TopLeft, NorthEast As MapPoint
|
||||
Property BottomRight, SouthWest As MapPoint
|
||||
|
||||
Private Function Left_Read() As Float
|
||||
|
||||
|
|
@ -112,3 +113,12 @@ Private Sub BottomRight_Write(Value As MapPoint)
|
|||
$mpBottomRight = Value
|
||||
|
||||
End
|
||||
|
||||
Static Public Function _Call(NorthEast As MapPoint, SouthWest As MapPoint) As MapBounds
|
||||
|
||||
Dim hBounds As New MapBounds
|
||||
|
||||
hBounds.TopLeft = NorthEast
|
||||
hBounds.BottomRight = SouthWest
|
||||
Return hBounds
|
||||
End
|
||||
|
|
@ -7,6 +7,7 @@ Public Copyright As String
|
|||
Public $aStack As New String[]
|
||||
Property Opacity As Float
|
||||
Private $fOpaciy As Float = 1
|
||||
Property Read Loading As Boolean
|
||||
|
||||
|
||||
Event Refresh
|
||||
|
|
@ -63,4 +64,10 @@ Private Sub Opacity_Write(Value As Float)
|
|||
|
||||
$fOpaciy = Min(1, Max(0, Value))
|
||||
|
||||
End
|
||||
|
||||
Private Function Loading_Read() As Boolean
|
||||
|
||||
|
||||
|
||||
End
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ Property Image As Image
|
|||
Private $imgPointImage As Image
|
||||
|
||||
|
||||
Public Sub _new(Optional hShape As Shapes)
|
||||
Public Sub _new()
|
||||
|
||||
$himgPoint = Image.Load("point.png")
|
||||
|
||||
|
|
@ -36,6 +36,7 @@ Public Sub AddPoint(Id As String, Points As MapPoint)
|
|||
hItem.Id = Id
|
||||
hItem.Center = Points
|
||||
hItem.Points = Points
|
||||
hItem.Bounds = MapBounds(Points, Points)
|
||||
$hShapes.Add(hItem)
|
||||
$colIDShape[Id] = $hShapes.Max
|
||||
End
|
||||
|
|
@ -47,6 +48,7 @@ Public Sub AddMultipoint(Id As String, Points As MapPoint[])
|
|||
hItem.Id = Id
|
||||
hItem.Center = GetCenter(Points)
|
||||
hItem.Points = Points
|
||||
hItem.Bounds = GetPointBounds(Points)
|
||||
$hShapes.Add(hItem)
|
||||
$colIDShape[Id] = $hShapes.Max
|
||||
End
|
||||
|
|
@ -57,7 +59,7 @@ Public Sub AddPolyLine(Id As String, Points As MapPoint[])
|
|||
hItem.Type = Polyline
|
||||
hItem.Id = Id
|
||||
hItem.Center = GetCenter(Points)
|
||||
hItem.Box = GetPointsBox(Points)
|
||||
hItem.Bounds = GetPointBounds(Points)
|
||||
hItem.Points = Points
|
||||
$hShapes.Add(hItem)
|
||||
$colIDShape[Id] = $hShapes.Max
|
||||
|
|
@ -69,7 +71,7 @@ Public Sub AddPolygon(Id As String, Points As MapPoint[][])
|
|||
hItem.Type = Polygon
|
||||
hItem.Id = Id
|
||||
hItem.Center = GetCenter(Points[0])
|
||||
hItem.Box = GetPointsBox(Points[0])
|
||||
hItem.Bounds = GetPointBounds(Points[0])
|
||||
hItem.Points = Points
|
||||
$hShapes.Add(hItem)
|
||||
$colIDShape[Id] = $hShapes.Max
|
||||
|
|
@ -192,10 +194,10 @@ Static Public Function GetCenter(hPoints As MapPoint[]) As MapPoint
|
|||
|
||||
End
|
||||
|
||||
Private Function GetPointsBox(hMapPoints As MapPoint[]) As RectF
|
||||
Private Function GetPointBounds(hMapPoints As MapPoint[]) As MapBounds
|
||||
|
||||
Dim hPoint As MapPoint
|
||||
Dim hRectF As New RectF
|
||||
Dim hBounds As New RectF
|
||||
Dim X, Y, X2, Y2 As Float
|
||||
X = hMapPoints[0].Lon
|
||||
Y = hMapPoints[0].Lat
|
||||
|
|
@ -207,7 +209,7 @@ Private Function GetPointsBox(hMapPoints As MapPoint[]) As RectF
|
|||
X2 = Max(hPoint.lon, X2)
|
||||
Y2 = Max(hPoint.lat, Y2)
|
||||
Next
|
||||
Return hRectF(X, Y, X2 - X, Y2 - Y)
|
||||
Return MapBounds(MapPoint(Y, X), MapPoint(Y2, X2))
|
||||
End
|
||||
|
||||
Private Function Count_Read() As Integer
|
||||
|
|
@ -248,13 +250,13 @@ Public Sub Refresh()
|
|||
|
||||
Case Me.Point
|
||||
hItem.Center = hItem.Points
|
||||
hItem.Box = RectF(hItem.Points.Lon, hItem.Points.Lat, 0, 0)
|
||||
hItem.Bounds = MapBounds(hItem.Points, hItem.Points)
|
||||
Case Polyline, MultiPoint
|
||||
hItem.Center = GetCenter(hItem.Points)
|
||||
hItem.Box = GetPointsBox(hItem.Points)
|
||||
hItem.Bounds = GetPointBounds(hItem.Points)
|
||||
Case Polygon
|
||||
hItem.Center = GetCenter(hItem.Points[0])
|
||||
hItem.Box = GetPointsBox(hItem.Points[0])
|
||||
hItem.Bounds = GetPointBounds(hItem.Points[0])
|
||||
End Select
|
||||
Next
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,9 @@ Private $aPreload As New String[]
|
|||
Private $bPreloadMode As Boolean
|
||||
Private $fGradStep As Float = 0.1
|
||||
Private $bIsQuadKey As Boolean
|
||||
Property Read Loading As Boolean
|
||||
Private $bLoading As Boolean
|
||||
Private $iCli As Integer
|
||||
Event Refresh
|
||||
|
||||
Public Sub _new(Optional CacheName As String)
|
||||
|
|
@ -197,7 +200,7 @@ Public Sub Load()
|
|||
|
||||
$bPreloadMode = False
|
||||
$tmrGet.Trigger
|
||||
|
||||
'tmrGet_Timer
|
||||
End
|
||||
|
||||
Private Sub ReLoadTile(hTile As _Tile)
|
||||
|
|
@ -261,18 +264,21 @@ Public Sub tmrGet_Timer()
|
|||
Do
|
||||
|
||||
If $bPreloadMode Then
|
||||
$bLoading = False
|
||||
If $aPreload.Count = 0 Then Return
|
||||
hClient = GetClient()
|
||||
If Not hClient Then Return
|
||||
sUrl = $aPreload.Pop()
|
||||
sFile = $aPreload.Pop()
|
||||
Else
|
||||
$bLoading = $aStack.Count > 0
|
||||
If $aStack.count = 0 Then
|
||||
$bPreloadMode = True
|
||||
Return
|
||||
Endif
|
||||
hClient = GetClient()
|
||||
If Not hClient Then Return
|
||||
Inc $iCli
|
||||
sUrl = $aStack.Pop()
|
||||
sFile = $aStack.Pop()
|
||||
Endif
|
||||
|
|
@ -298,7 +304,7 @@ End
|
|||
Public Sub Client_Finished()
|
||||
|
||||
Dim hTile As _Tile
|
||||
|
||||
Dec $iCli
|
||||
'If Not $bPreloadMode Then
|
||||
hTile = $colTiles[Last.Tag]
|
||||
If Not hTile Then Goto Skip
|
||||
|
|
@ -308,6 +314,7 @@ Public Sub Client_Finished()
|
|||
ReLoadTile(hTile)
|
||||
Return
|
||||
Endif
|
||||
'Print hTile.Name
|
||||
hTile.Status = _Tile.Normal
|
||||
Raise Refresh
|
||||
'Endif
|
||||
|
|
@ -320,7 +327,7 @@ End
|
|||
Public Sub Client_Error()
|
||||
|
||||
Dim hTile As _Tile
|
||||
|
||||
Dec $iCli
|
||||
'If Not $bPreloadMode Then
|
||||
hTile = $coltiles[Last.Tag]
|
||||
If Not hTile Then Goto Skip
|
||||
|
|
@ -452,3 +459,18 @@ Public Sub _free()
|
|||
$aClients.Clear
|
||||
End
|
||||
|
||||
|
||||
Private Function Loading_Read() As Boolean
|
||||
' Dim bLoad As Boolean
|
||||
' Dim i As Integer
|
||||
'
|
||||
' For i = 0 To $aClients.Max
|
||||
' If $aClients[i].Status <> Net.Inactive Then bLoad = True
|
||||
' Print $aClients[i].Status
|
||||
' 'Print bLoad
|
||||
' Next
|
||||
' 'Print bLoad
|
||||
' Return $tmrGet.Enabled Or bLoad
|
||||
'Print $bLoading
|
||||
Return $bLoading '$iCli > 0 And $aStack.Count > 0
|
||||
End
|
||||
|
|
|
|||
Loading…
Reference in a new issue