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

oups

Browse source 
git-svn-id: svn://localhost/gambas/trunk@5628 867c0c6c-44f3-4631-809d-bfa615b0a4ec
This commit is contained in:
Fabien Bodard 2013-04-30 14:25:24 +00:00
parent dd5903122e
commit 552692ba94
14 changed files with 5527 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
comp/src/gb.map/.component
View file

@ -1,7 +1,6 @@
[Component]
Key=gb.map
Version=3.3.90
Version=3.4.0
State=2
Authors=Fabien Bodard
Needs=Form,ImageIO

86
comp/src/gb.map/.info
View file

@ -66,10 +66,6 @@ PixelBox
r
Rect
Preload
p
b
_ShowWithEffect
v
b
@ -246,3 +242,85 @@ tmrOnMove_Timer
m
#Shapes
C
Point
C
i
1
MultiPoint
C
i
8
Polyline
C
i
3
Polygon
C
i
5
Count
r
i
Max
r
i
AddMultiPoint
m
(Data)MapPoint[];[(Id)s]
AddPoint
m
(Data)MapPoint;[(Id)s]
AddPolyline
m
(Data)MapPoint[];[(Id)s]
GetCenter
M
MapPoint
(hPoints)MapPoint[];
AddPolygon
m
(Data)MapPoint[][];[(Id)s]
_get
m
_ShapeItem
(Index)i
#_ShapeItem
C
Box
v
RectF
Id
v
s
Type
v
i
Data
v
o
Center
v
MapPoint
Selected
v
b
Contains
m
b
(hMapPoint)MapPoint;

2
comp/src/gb.map/.list
View file

@ -2,3 +2,5 @@ Geo
Map
MapPoint
MapView
Shapes
_ShapeItem

21
comp/src/gb.map/.src/Map.class
View file

@ -23,8 +23,8 @@ Private $PrevBox As Rect
Private $iPrevent As Integer = 256
Private $aLayers As New _MapLayer[]
Private $aLayerNames As New String[]
Property Preload As Boolean
Private $bPreload As Boolean
'Property Preload As Boolean
'Private $bPreload As Boolean
Public _ShowWithEffect As Boolean
Event Refresh
@ -194,6 +194,7 @@ Public Function AddShape(Name As String, Optional Shape As Shapes) As _MapShape
$aLayers.Add(hLayer)
$aLayerNames.Add(Name)
Object.Attach(hLayer, Me, "Layer")
If Shape Then hLayer.Data = Shape
Return hLayer
End
@ -225,7 +226,7 @@ Public Sub Draw()
'Draw.Rect(0, 0, Me.Width, Me.Height)
For Each hLayer In $aLayers
If hLayer.Visible Then
hLayer.Draw
hLayer._Draw
sCopyright &/= hLayer.Copyright
Endif
Next
@ -260,10 +261,10 @@ Public Sub Refresh()
End
Private Function Preload_Read() As Boolean
End
Private Sub Preload_Write(Value As Boolean)
End
' Private Function Preload_Read() As Boolean
'
' End
'
' Private Sub Preload_Write(Value As Boolean)
'
' End

2
comp/src/gb.map/.src/MapView.class
View file

@ -156,7 +156,7 @@ Public Sub View_MouseDown()
$pCurCenterPx = Geo.MapPointToPixel($hmap.Center, $hmap.Zoom)
$bShowInertia = False
$tmrOnMove.Stop
Raise MouseDown
'Raise MouseDown
End

54
comp/src/gb.map/.src/Tests/FMain.class
View file

@ -33,6 +33,7 @@ Public Sub _new()
MapView1.Map.AddShape("NewShape")
'MapView1.Map["NewShape"].Data = LoadShapes()
'Manage the list of layers
@ -51,8 +52,8 @@ Public Sub Form_Open()
End
Public Sub MapView1_MouseDown()
Dim hMapPoint As New MapPoint[][]
'Print "mousedown"
If Mouse.Control Then
hmap.Zoom = MapView1.map.Zoom + SpinBox1.Value
@ -63,8 +64,16 @@ Public Sub MapView1_MouseDown()
Endif
If Mouse.Shift Then
MapView1.Map["NewShape"].Data.AddPoint(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom))
If MapView1.Map["NewShape"].Data.Count = 0 Then
hMapPoint.Add([Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)])
MapView1.Map["NewShape"].Data.AddPolygon(hMapPoint, "toto")
MapView1.Map["NewShape"].Data[0].Selected = True
Else
MapView1.Map["NewShape"].Data[0].Data[0].Add(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom))
MapView1.Map["NewShape"].Data[0].Center = Shapes.GetCenter(MapView1.Map["NewShape"].Data[0].Data[0])
Endif
'MapView1.Map["NewShape"].Data.AddPoint(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom))
MapView1.Refresh
Endif
@ -74,6 +83,7 @@ Public Sub MapView1_MouseMove()
$iMX = Mouse.X
$iMY = Mouse.Y
Me.Text = Geo.PixelToMapPoint(Point(MapView1.Map.PixelBox.x + Mouse.x, MapView1.Map.PixelBox.y + Mouse.y), MapView1.Map.Zoom).Lon
If $bLens Then
hmap.Center = Geo.PixelToMapPoint(Point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)
@ -168,3 +178,39 @@ Public Sub Panel3_MouseDown()
End
Public Function LoadShapes() As Shapes
Dim hdoc As New XmlDocument
Dim el As XmlElement
Dim el2 As XmlElement
Dim hShapes As New Shapes
Dim hMP As New MapPoint[][]
Dim hmps As MapPoint[]
Dim mp As MapPoint
Dim s As String
hdoc.Open("parcellaire.kml")
For Each el In hdoc.GetElementsByTagName("Polygon")
el.GetAttribute("index")
hmp = New MapPoint[][]
el2 = el.GetChildrenByTagName("Coordinates")[0]
hmps = New MapPoint[]
hMP.Add(hmps)
For Each s In Split(Replace(el2.TextContent, "\n", " "), " ")
mp = New MapPoint
mp.Lon = Split(s)[0]
mp.Lat = Split(s)[1]
hMP[0].Add(mp)
Next
hShapes.AddPolygon(hmp)
Next
Return hShapes
End

1
comp/src/gb.map/.src/Tests/FMain.form
View file

@ -9,6 +9,7 @@
{ MapView1 MapView
MoveScaled(18,16,16,16)
Expand = True
AllowEffect = False
}
{ GridView1 GridView
MoveScaled(72,11,25,35)

2
comp/src/gb.map/.src/Tools/Geo.module
View file

@ -32,7 +32,7 @@ Public Function MapPointToPixel(hMapPoint As MapPoint, Zoom As Integer) As Point
X = (X + $originShift) / res
Y = (Y + $originShift) / res
Return Point(X, Y)
End

2
comp/src/gb.map/.src/_MapLayer.class
View file

@ -9,7 +9,7 @@ Property Data As Shapes
Event Refresh
Public Sub Draw() '(Optional bRefresh As Boolean = True)
Public Sub _Draw() '(Optional bRefresh As Boolean = True)

92
comp/src/gb.map/.src/_MapShape.class
View file

@ -4,7 +4,9 @@ Inherits _MapLayer
Private $hShapes As New Shapes
Private $himgPoint As Image
Property Data As Shapes
Property {Color} As Integer
Private $icolor As Integer
Private $sCurrent As String
Public Sub _new(Optional hShape As Shapes)
$himgPoint = Image.Load("point.png")
@ -13,9 +15,6 @@ End
Public Sub Load()
End
Public Sub AddPoint(Data As MapPoint)
@ -24,39 +23,96 @@ Public Sub AddPoint(Data As MapPoint)
End
Public Sub Draw()
Public Sub _Draw()
Dim hItem As _ShapeItem
Dim i As Integer
Dim i, j As Integer
Dim pt As Point
Dim hMap As Map = GetMap()
Dim hPoly As Integer[]
Dim iColor As Integer
If $hShapes.Count = 0 Then Return
For i = 0 To $hShapes.Max
pt = Geo.MapPointToPixel($hShapes[i].Data, hMap.zoom)
Paint.Brush = Paint.Color(Color.Green)
'Paint.Arc(pt.X - hMap.PixelBox.X, pt.Y - hMap.PixelBox.Y, 5)
Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32)
Paint.Fill
iColor = Me.Color
If $hShapes[i].Selected Then icolor = Color.White
Select Case $hShapes[i].Type
Case Shapes.Point
pt = Geo.MapPointToPixel($hShapes[i].Data, hMap.zoom)
Paint.Brush = Paint.Color(Color.Green)
'Paint.Arc(pt.X - hMap.PixelBox.X, pt.Y - hMap.PixelBox.Y, 5)
Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32)
Case Shapes.MultiPoint
For j = 0 To $hShapes[i].Data.Max
pt = Geo.MapPointToPixel($hShapes[i].Data[j], hMap.zoom)
Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32)
Next
Case Shapes.Polygon
hPoly = New Integer[]
For j = 0 To $hShapes[i].Data[0].Max
pt = Geo.MapPointToPixel($hShapes[i].Data[0][j], hMap.zoom)
hPoly.Add(pt.x - hMap.PixelBox.X)
hPoly.Add(pt.y - hMap.PixelBox.Y)
Next
Paint.LineWidth = 2
Paint.Brush = Paint.Color(Color.SetAlpha(icolor, 125))
Paint.Polygon(hPoly)
Paint.fill(True)
Paint.Brush = Paint.Color(icolor)
Paint.Stroke
' If $hShapes[i].Center Then
' pt = Geo.MapPointToPixel($hShapes[i].Center, hMap.Zoom)
' 'Print $hShapes[i].Center.Lat
' Paint.Brush = Paint.Color(Color.White)
' Paint.Fill
' Endif
Case Shapes.Polyline
For j = 0 To $hShapes[i].Data.Max
pt = Geo.MapPointToPixel($hShapes[i].Data[0][j], hMap.zoom)
hPoly.Add(pt.x - hMap.PixelBox.X)
hPoly.Add(pt.y - hMap.PixelBox.Y)
Next
Paint.LineWidth = 2
'Paint.Brush = Paint.Color(Color.SetAlpha(Color.red, 125))
Paint.Polygon(hPoly)
'Paint.fill(True)
Paint.Brush = Paint.Color(icolor)
Paint.Stroke
End Select
Next
End
Private Function Data_Read() As Shapes
Return $hShapes
End
Private Sub Data_Write(Value As Shapes)
$hShapes = Value
End
Public Function GetMap() As Map
Private Function GetMap() As Map
Return Object.Parent(Me)
End
Private Function Color_Read() As Integer
Return $icolor
End
Private Sub Color_Write(Value As Integer)
$icolor = Value
End

16
comp/src/gb.map/.src/_MapTile.class
View file

@ -4,7 +4,7 @@ Inherits _MapLayer
Private $aClients As New HttpClient[]
Private $iClientCount As Integer = 4
Private $sCachePath As String = User.Home &/ ".cache/gb.map"
Private $tmrGet As New Timer As "Get"
Private $tmrGet As New Timer As "tmrGet"
Private $aTiles As New String[]
Private $colTiles As New Collection
Public $aStack As New String[]
@ -48,8 +48,14 @@ Public Sub _new(Optional CacheName As String)
End
' svn checkout --username=gambix svn+ssh://gambas@svn.code.sf.net/p/gambas/code/gambas/trunk
'
'
Public Sub ClearCache()
Try Exec ["rm", $sCachePath &/ "*.png"]
End
Public Sub Draw()
Public Sub _Draw()
Dim s As String
Dim hTile As _Tile
@ -241,13 +247,13 @@ Catch
End
Public Function GetMap() As Map
Private Function GetMap() As Map
Return Object.Parent(Me)
End
Public Sub Get_Timer()
Public Sub tmrGet_Timer()
Dim sUrl, sFile As String
Dim hClient As HttpClient
@ -279,7 +285,7 @@ Public Sub Get_Timer()
End
Public Sub GetClient() As HttpClient
Private Sub GetClient() As HttpClient
Dim i As Integer

0
comp/src/gb.map/parcellaire.kml Normal file
View file

5268
comp/src/gb.map/parcellaire.xml Normal file
View file

File diff suppressed because it is too large Load diff

24
comp/src/gb.map/parcellaire2.xml Normal file
View file

@ -0,0 +1,24 @@
<parcelle>
<s2 numero-parcelle="1" localisee-indicative="false">
<culture code-culture="VY" />
<surface-declaree>187</surface-declaree>
</s2>
<geometrie>
<gml:Polygon srsName='0'>
<gml:outerBoundaryIs>
<gml:LinearRing srsName='0'>
<gml:coordinates>
441724.98,6497264.717 441628.585,6497331.443
441639.754,6497354.361 441570.109,6497389.964
441525.321,6497288.344 441568.15,6497277.0
441606.055,6497264.669 441584.743,6497220.884
441686.418,6497196.127 441724.98,6497264.717
</gml:coordinates>
</gml:LinearRing>
</gml:outerBoundaryIs>
</gml:Polygon>
</geometrie>
</parcelle>