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.
This commit is contained in:
gambix
parent
eff768b3c6
commit
f71115e89b
@ -1,6 +1,6 @@
|
||||
[Component]
|
||||
Key=gb.map
|
||||
Version=3.9.90
|
||||
Version=3.10.90
|
||||
State=1
|
||||
Authors=Fabien Bodard
|
||||
Needs=Form,ImageIO
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -5,5 +5,6 @@
|
||||
Arrangement = Arrange.Fill
|
||||
{ MapView1 MapView
|
||||
MoveScaled(3,2,58,58)
|
||||
AllowEffect = False
|
||||
}
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user