From 17978a3f383de2bdacebb413eb92a0155abf1d5a Mon Sep 17 00:00:00 2001 From: Fabien Bodard Date: Thu, 9 May 2013 20:12:24 +0000 Subject: [PATCH] [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 --- comp/src/gb.map/.info | 97 +++++++++++++++++++- comp/src/gb.map/.list | 1 + comp/src/gb.map/.src/Map.class | 63 +++++++++++-- comp/src/gb.map/.src/Shapes/_ShapeItem.class | 6 +- comp/src/gb.map/.src/Tests/FMain.form | 2 - comp/src/gb.map/.src/Tests/Form1.class | 23 +++++ comp/src/gb.map/.src/Tests/Form1.form | 21 +++++ comp/src/gb.map/.src/Types/MapBounds.class | 14 ++- comp/src/gb.map/.src/_MapLayer.class | 7 ++ comp/src/gb.map/.src/_MapShape.class | 20 ++-- comp/src/gb.map/.src/_MapTile.class | 28 +++++- 11 files changed, 253 insertions(+), 29 deletions(-) create mode 100644 comp/src/gb.map/.src/Tests/Form1.class create mode 100644 comp/src/gb.map/.src/Tests/Form1.form diff --git a/comp/src/gb.map/.info b/comp/src/gb.map/.info index 777f6e89d..2dabad36d 100644 --- a/comp/src/gb.map/.info +++ b/comp/src/gb.map/.info @@ -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 diff --git a/comp/src/gb.map/.list b/comp/src/gb.map/.list index cb8c53413..a15e85fee 100644 --- a/comp/src/gb.map/.list +++ b/comp/src/gb.map/.list @@ -1,5 +1,6 @@ Geo Map +MapBounds MapPoint MapView Shapes diff --git a/comp/src/gb.map/.src/Map.class b/comp/src/gb.map/.src/Map.class index 886dafd11..7192b477a 100644 --- a/comp/src/gb.map/.src/Map.class +++ b/comp/src/gb.map/.src/Map.class @@ -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 diff --git a/comp/src/gb.map/.src/Shapes/_ShapeItem.class b/comp/src/gb.map/.src/Shapes/_ShapeItem.class index 6785c589f..fcba183c0 100644 --- a/comp/src/gb.map/.src/Shapes/_ShapeItem.class +++ b/comp/src/gb.map/.src/Shapes/_ShapeItem.class @@ -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 diff --git a/comp/src/gb.map/.src/Tests/FMain.form b/comp/src/gb.map/.src/Tests/FMain.form index d4ad70e34..38a0c9f5d 100644 --- a/comp/src/gb.map/.src/Tests/FMain.form +++ b/comp/src/gb.map/.src/Tests/FMain.form @@ -9,8 +9,6 @@ { MapView1 MapView MoveScaled(32,19,16,16) Expand = True - AllowEffect = False - ShowControls = False } { GridView1 GridView MoveScaled(72,11,25,35) diff --git a/comp/src/gb.map/.src/Tests/Form1.class b/comp/src/gb.map/.src/Tests/Form1.class new file mode 100644 index 000000000..bd14b95e1 --- /dev/null +++ b/comp/src/gb.map/.src/Tests/Form1.class @@ -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 diff --git a/comp/src/gb.map/.src/Tests/Form1.form b/comp/src/gb.map/.src/Tests/Form1.form new file mode 100644 index 000000000..ff14e1534 --- /dev/null +++ b/comp/src/gb.map/.src/Tests/Form1.form @@ -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) + } +} diff --git a/comp/src/gb.map/.src/Types/MapBounds.class b/comp/src/gb.map/.src/Types/MapBounds.class index 7e5a4b43c..c4e867199 100644 --- a/comp/src/gb.map/.src/Types/MapBounds.class +++ b/comp/src/gb.map/.src/Types/MapBounds.class @@ -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 \ No newline at end of file diff --git a/comp/src/gb.map/.src/_MapLayer.class b/comp/src/gb.map/.src/_MapLayer.class index 60a3abfec..ba0cd566c 100644 --- a/comp/src/gb.map/.src/_MapLayer.class +++ b/comp/src/gb.map/.src/_MapLayer.class @@ -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 diff --git a/comp/src/gb.map/.src/_MapShape.class b/comp/src/gb.map/.src/_MapShape.class index 188ea7758..74ae08eac 100644 --- a/comp/src/gb.map/.src/_MapShape.class +++ b/comp/src/gb.map/.src/_MapShape.class @@ -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 diff --git a/comp/src/gb.map/.src/_MapTile.class b/comp/src/gb.map/.src/_MapTile.class index c0aae25f2..4235270d4 100644 --- a/comp/src/gb.map/.src/_MapTile.class +++ b/comp/src/gb.map/.src/_MapTile.class @@ -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