From f71115e89b0d0ac142467c5ca844251fe95aec85 Mon Sep 17 00:00:00 2001 From: gambix Date: Thu, 4 Jan 2018 11:47:27 +0100 Subject: [PATCH] Adding the circle shape and done some bug corrections [GB.MAP] * NEW: AddCircle Fuction on _MapShape Layer allow to display circles * NEW: Now ShapeItems have a FillColor property that allow to define filling color. * NEW: _ShapeLayer have a generic FillColor too * BUG: The shape layer now not display ShapeItems when theire current display size at zoom is lower than 2 pixels. --- comp/src/gb.map/.component | 2 +- comp/src/gb.map/.project | 4 +- comp/src/gb.map/.src/Shapes/_ShapeItem.class | 1 + comp/src/gb.map/.src/Tests/Form6.class | 21 ++- comp/src/gb.map/.src/Tests/Form6.form | 1 + comp/src/gb.map/.src/_MapShape.class | 139 +++++++++++++------ 6 files changed, 120 insertions(+), 48 deletions(-) diff --git a/comp/src/gb.map/.component b/comp/src/gb.map/.component index 6f502d6d6..3fdbb5698 100644 --- a/comp/src/gb.map/.component +++ b/comp/src/gb.map/.component @@ -1,6 +1,6 @@ [Component] Key=gb.map -Version=3.9.90 +Version=3.10.90 State=1 Authors=Fabien Bodard Needs=Form,ImageIO diff --git a/comp/src/gb.map/.project b/comp/src/gb.map/.project index ae4d3724e..d1b2d396b 100644 --- a/comp/src/gb.map/.project +++ b/comp/src/gb.map/.project @@ -1,9 +1,9 @@ # Gambas Project File 3.0 -# Compiled with Gambas 3.8.90 +# Compiled with Gambas 3.10.90 Title=gb.map Startup=Form6 Icon=.hidden/control/mapview.png -Version=3.9.90 +Version=3.10.90 VersionFile=1 Component=gb.image Component=gb.gui diff --git a/comp/src/gb.map/.src/Shapes/_ShapeItem.class b/comp/src/gb.map/.src/Shapes/_ShapeItem.class index 453c2a69d..e6ae37a38 100644 --- a/comp/src/gb.map/.src/Shapes/_ShapeItem.class +++ b/comp/src/gb.map/.src/Shapes/_ShapeItem.class @@ -8,6 +8,7 @@ Property Read Key As String Public Type As Integer Public Points As Object Public Center As MapPoint +Public FillColor As Integer = -1 Private $bSelected As Boolean Property Selected As Boolean Private $sKey As String diff --git a/comp/src/gb.map/.src/Tests/Form6.class b/comp/src/gb.map/.src/Tests/Form6.class index c0919251d..888de40c4 100644 --- a/comp/src/gb.map/.src/Tests/Form6.class +++ b/comp/src/gb.map/.src/Tests/Form6.class @@ -4,7 +4,7 @@ Public Sub Form_Open() Dim hPolyLine As New MapPoint[] - MapView1.Map.AddTile("GoogleMap", "https://khms{s}.google.fr/kh/v={version}&src=app&x={x}&y={y}&z={z}&s=Galile", ["version": "702"]).SubDomains = ["0", "1", "2"] + MapView1.Map.AddTile("GoogleMap", "https://khms{s}.google.fr/kh/v={version}&src=app&x={x}&y={y}&z={z}&s=Galile", ["version": "748"]).SubDomains = ["0", "1", "2"] MapView1.Map["GoogleMap"].Visible = True @@ -12,7 +12,7 @@ Public Sub Form_Open() hPolyLine = [MapPoint(48.457454, -4.638139), MapPoint(51.123363, 2.217329), MapPoint(48.921609, 8.106001), MapPoint(43.833550, 7.666547), MapPoint(42.487303, 3.008345), MapPoint(43.324192, -1.825640), MapPoint(48.457454, -4.638139)] - + .AddPolyLine("Section 1", hPolyLine) @@ -20,5 +20,22 @@ Public Sub Form_Open() .["Section 1"].Color = Color.Green End With + + With MapView1.Map["Poly"] + + .AddCircle("pop", MapPoint(48.457454, -4.638139), 2000) + .Opacity = 1 + End With +With MapView1.Map["Poly"]["pop"] + .FillColor = Color.SetAlpha(Color.Yellow, 50) + .Color = Color.Red + .LineWidth = 2 +End With +MapView1.Refresh +End + +Public Sub MapView1_MouseDown() + + End diff --git a/comp/src/gb.map/.src/Tests/Form6.form b/comp/src/gb.map/.src/Tests/Form6.form index f769f2453..8619b90a8 100644 --- a/comp/src/gb.map/.src/Tests/Form6.form +++ b/comp/src/gb.map/.src/Tests/Form6.form @@ -5,5 +5,6 @@ Arrangement = Arrange.Fill { MapView1 MapView MoveScaled(3,2,58,58) + AllowEffect = False } } diff --git a/comp/src/gb.map/.src/_MapShape.class b/comp/src/gb.map/.src/_MapShape.class index e04034486..f1097457f 100644 --- a/comp/src/gb.map/.src/_MapShape.class +++ b/comp/src/gb.map/.src/_MapShape.class @@ -7,12 +7,15 @@ Public Const {Point} As Integer = 1 Public Const MultiPoint As Integer = 8 Public Const Polyline As Integer = 3 Public Const Polygon As Integer = 5 +Public Const Circle As Integer = 33 Private $aShapes As New _ShapeItem[] Private $himgPoint As Image 'Property Points As Shapes Property {Color} As Integer +Property FillColor As Integer Private $icolor As Integer +Private $iFillColor As Integer Property LineWidth As Integer Private $iLineWidth As Integer = 2 Private $colKeyShape As New Collection @@ -37,10 +40,10 @@ Public Sub Load() $aInView.Clear For i = 0 To $aShapes.Max - If Not $aShapes[i].Type = Me.Point Then + If Not ($aShapes[i].Type = Me.Point) Then pt1 = Geo.MapPointToPixel($aShapes[i].Bounds.TopLeft, hMap.Zoom) pt2 = Geo.MapPointToPixel($aShapes[i].Bounds.BottomRight, hMap.Zoom) - If pt2.x - pt1.x < 10 And If pt2.y - pt1.y < 10 Then Continue + If pt2.x - pt1.x < 2 And If pt2.y - pt1.y < 2 Then Continue Endif With $aShapes[i].Bounds If .Lon2 > hMap.Bounds.Lon Then @@ -60,7 +63,7 @@ Public Sub Load() End -Public Sub AddPoint(Key As String, Points As MapPoint, Optional {Color} As Integer) +Public Sub AddPoint(Key As String, Points As MapPoint, Optional {Color} As Integer) As _ShapeItem Dim hItem As _ShapeItem @@ -74,9 +77,11 @@ Public Sub AddPoint(Key As String, Points As MapPoint, Optional {Color} As Integ $aShapes.Add(hItem) $colKeyShape[Key] = $aShapes.Max + Return hItem + End -Public Sub AddMultipoint(Key As String, Points As MapPoint[], Optional {Color} As Integer) +Public Sub AddMultipoint(Key As String, Points As MapPoint[], Optional {Color} As Integer) As _ShapeItem Dim hItem As _ShapeItem @@ -92,7 +97,7 @@ Public Sub AddMultipoint(Key As String, Points As MapPoint[], Optional {Color} A End -Public Sub AddPolyLine(Key As String, Points As MapPoint[], Optional {Color} As Integer, Optional LineWidth As Integer) +Public Sub AddPolyLine(Key As String, Points As MapPoint[], Optional {Color} As Integer, Optional LineWidth As Integer) As _ShapeItem Dim hItem As _ShapeItem @@ -107,9 +112,11 @@ Public Sub AddPolyLine(Key As String, Points As MapPoint[], Optional {Color} As $aShapes.Add(hItem) $colKeyShape[Key] = $aShapes.Max + Return hItem + End -Public Sub AddPolygon(Key As String, Points As MapPoint[][], Optional {Color} As Integer, Optional LineWidth As Integer) +Public Sub AddPolygon(Key As String, Points As MapPoint[][], Optional {Color} As Integer, Optional LineWidth As Integer) As _ShapeItem Dim hItem As _ShapeItem @@ -124,39 +131,80 @@ Public Sub AddPolygon(Key As String, Points As MapPoint[][], Optional {Color} As $aShapes.Add(hItem) $colKeyShape[Key] = $aShapes.Max + Return hItem + +End + +Public Sub AddCircle(Key As String, Center As MapPoint, Radius As Float, Optional {Color} As Integer, Optional LineWidth As Integer) As _ShapeItem + + Dim hItem As _ShapeItem + If $colKeyShape.Exist(Key) Then Error.Raise("This key already exist") + hItem = New _ShapeItem(Key) As "Item" + If Not IsMissing({Color}) Then hItem.Color = Color + If Not IsMissing(LineWidth) Then hItem.LineWidth = LineWidth + hItem.Type = Circle + hItem.Center = Center + hItem.Bounds.TopLeft = MapPoint.From(Center, -45, Radius) + hItem.Bounds.BottomRight = MapPoint.From(Center, 135, Radius) + + $aShapes.Add(hItem) + $colKeyShape[Key] = $aShapes.Max + + Return hItem + End Public Sub _Draw() Dim i, j As Integer - Dim pt As Point + Dim pt, pt2 As Point Dim hMap As Map = GetMap() Dim hPoly As Integer[] - Dim iColor As Integer + Dim iColor, iBack As Integer Dim hShape As _ShapeItem + Dim iAlpha As Integer If $aShapes.Count = 0 Then Return - 'Paint.LineWidth = 2 For i = 0 To $aInView.Max hShape = $aShapes[$aInView[i]] - iColor = Color.SetAlpha(IIf(hShape.Color < -1, $icolor, hShape.Color), 255 - 255 * Me.Opacity) + 'Set ForeColor + iColor = IIf(hShape.Color = -1, $icolor, hShape.Color) + iAlpha = Color.GetAlpha(icolor) + iColor = Color.SetAlpha(icolor, Min(iAlpha + (255 - (255 * Me.Opacity)), 255)) + + 'SetBackColor + iBack = IIf(hShape.FillColor = -1, $iFillColor, hShape.FillColor) + If iBack = -1 Then iBack = Color.transparent + 'If hShape.Type = Circle Then Stop + iAlpha = Color.GetAlpha(iBack) + iBack = Color.SetAlpha(iBack, Min(iAlpha + (255 - (255 * Me.Opacity)), 255)) + + 'SetLineWidth Paint.LineWidth = IIf(hShape.LineWidth > -1, hShape.LineWidth, $iLineWidth) + +'TODO: Allow to define color for selected item + 'Force Color for selected If hShape.Selected Then icolor = Color.White + + 'Draw Select Case hShape.Type Case Me.Point pt = Geo.MapPointToPixel(hShape.Points, hMap.zoom) - Paint.Brush = Paint.Color(Color.Green) - 'Paint.Arc(pt.X - hMap.PixelBox.X, pt.Y - hMap.PixelBox.Y, 5) If hShape.Image Then Paint.DrawImage(hShape.Image, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) Else Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) Endif + Case MultiPoint For j = 0 To hShape.Points.Max pt = Geo.MapPointToPixel(hShape.Points[j], hMap.zoom) - Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) + If hShape.Image Then + Paint.DrawImage(hShape.Image, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) + Else + Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) + Endif Next Case Polygon @@ -167,54 +215,48 @@ Public Sub _Draw() hPoly.Add(pt.y - hMap.PixelBox.Y) Next Paint.LineWidth = hShape.LineWidth - Paint.Brush = Paint.Color(Color.SetAlpha(icolor, 125)) + Paint.Brush = Paint.Color(iBack) Paint.Polygon(hPoly) Paint.fill(True) Paint.Brush = Paint.Color(icolor) Paint.Stroke - ' If hShape.Center Then - ' pt = Geo.MapPointToPixel(hShape.Center, hMap.Zoom) - ' 'Print hShape.Center.Lat - ' Paint.Brush = Paint.Color(Color.White) - ' Paint.Fill - ' Endif Case Me.Polyline - 'hPoly = New Integer[] If hShape.Points.Count = 0 Then Continue pt = Geo.MapPointToPixel(hShape.Points[0], hMap.zoom) Paint.MoveTo(pt.x - hMap.PixelBox.X, pt.y - hMap.PixelBox.Y) For j = 1 To hShape.Points.Max pt = Geo.MapPointToPixel(hShape.Points[j], hMap.zoom) Paint.LineTo(pt.x - hMap.PixelBox.X, pt.y - hMap.PixelBox.Y) - ' hPoly.Add(pt.x - hMap.PixelBox.X) - ' hPoly.Add(pt.y - hMap.PixelBox.Y) + Next - 'Paint.LineWidth = hShape.LineWidth - 'Paint.Brush = Paint.Color(Color.SetAlpha(Color.red, 125)) - 'Paint.Polygon(hPoly) - 'Paint.fill(True) Paint.Brush = Paint.Color(icolor) Paint.Stroke + Case Me.Circle + pt = hMap.MapPointToPixelRel(hShape.Bounds.TopLeft) + pt2 = hMap.MapPointToPixelRel(hShape.Bounds.BottomRight) + Paint.Ellipse(pt.x, pt.y, pt2.x - pt.x, pt2.y - pt.y) + Paint.Brush = Paint.Color(iBack) + Paint.Fill(True) + Paint.Brush = Paint.Color(icolor) + Paint.Stroke End Select - ' Paint.Brush = Paint.Color(Color.red) - ' pt = Geo.MapPointToPixel(hShape.Bounds.TopLeft, hMap.Zoom) - ' Paint.Rectangle(pt.x - hMap.PixelBox.x, pt.Y - hMap.PixelBox.Y, 5, 5) - ' Paint.Fill() - ' - ' Paint.Brush = Paint.Color(Color.Blue) - ' pt = Geo.MapPointToPixel(hShape.Bounds.BottomRight, hMap.Zoom) - ' Paint.Rectangle(pt.x - hMap.PixelBox.x, pt.Y - hMap.PixelBox.Y, 5, 5) - ' Paint.Fill() + Next End + + + + + Public Function _get(Key As String) As _ShapeItem + Dim iRet As Integer If $colKeyShape[Key] = Null Then @@ -223,7 +265,6 @@ Public Function _get(Key As String) As _ShapeItem iRet = $colKeyShape[Key] Endif - Return $aShapes[iRet] End @@ -247,12 +288,11 @@ Private Sub Color_Write(Value As Integer) End Static Public Function GetCenter(hPoints As MapPoint[]) As MapPoint - 'Dim PCenter As New FPoint[] + Dim tmpA, A, Gx, Gy As Float Dim j, k As Integer 'calcul du centre - 'fp = New FPoint A = 0 gx = 0 Gy = 0 @@ -338,6 +378,7 @@ Public Sub Refresh() Case Polygon hItem.Center = GetCenter(hItem.Points[0]) hItem.Bounds = GetPointBounds(hItem.Points[0]) + End Select Next @@ -399,7 +440,7 @@ Private Function Key_Read() As String End Public Function Find(hMp As MapPoint) As _ShapeItem - + Dim i As Integer Dim hShape As _ShapeItem Dim hMap As Map = GetMap() @@ -435,13 +476,25 @@ Public Sub Clear() End Private Function LineWidth_Read() As Integer - + Return $iLineWidth - + End Private Sub LineWidth_Write(Value As Integer) - + $iLineWidth = Max(Value, 1) + +End + +Private Function FillColor_Read() As Integer + + Return $iFillColor + +End + +Private Sub FillColor_Write(Value As Integer) + + $iFillColor = Value End