luisgulo/gambas-source-code
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of gitlab.com:gambas/gambas

Browse Source
This commit is contained in:
gambas 2018-01-06 13:00:11 +01:00
commit 02a28a22ab
7 changed files with 122 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
comp/src/gb.map/.component
View File

@ -1,6 +1,6 @@
[Component]
Key=gb.map
Version=3.9.90
Version=3.10.90
State=1
Authors=Fabien Bodard
Needs=Form,ImageIO

4
comp/src/gb.map/.project
View File

@ -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

4
comp/src/gb.map/.src/MapView.class
View File

@ -133,7 +133,7 @@ Public Sub View_Draw()
End
Public Sub View_MouseWheel()
Dim hCenter As MapPoint
If $bLock Then Return
Draw.Begin($hZoomBuffer)
Draw.FillRect(0, 0, Draw.Width, Draw.Height, Color.Transparent)
@ -144,8 +144,10 @@ Public Sub View_MouseWheel()
_ZoomUp(Mouse.X, Mouse.Y)
$hMap.Center = Geo.PixelToMapPoint(Point($hMap.PixelBox.X + Mouse.X, $hMap.PixelBox.Y + Mouse.Y), $hmap.Zoom)
Else
hCenter = MapPoint($hmap.Center.Lat, $hmap.Center.Lon)
'$hMap.Center = Geo.PixelToMapPoint(Point($hMap.PixelBox.X - Mouse.X, $hMap.PixelBox.Y - Mouse.Y), $hmap.Zoom)
_ZoomDown(Mouse.X, Mouse.Y)
$hmap.Center = hCenter
Endif
$hView.Refresh

1
comp/src/gb.map/.src/Shapes/_ShapeItem.class
View File

@ -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

20
comp/src/gb.map/.src/Tests/Form6.class
View File

@ -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,21 @@ 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

1
comp/src/gb.map/.src/Tests/Form6.form
View File

@ -5,5 +5,6 @@
Arrangement = Arrange.Fill
{ MapView1 MapView
MoveScaled(3,2,58,58)
AllowEffect = False
}
}

139
comp/src/gb.map/.src/_MapShape.class
View File

@ -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