Merge branch 'master' of gitlab.com:gambas/gambas
This commit is contained in:
commit
3b9b1d8bfd
4 changed files with 83 additions and 66 deletions
comp/src/gb.map
Binary file not shown.
Before (image error) Size: 4.8 KiB After (image error) Size: 4.3 KiB |
|
@ -1 +1,7 @@
|
|||
' Gambas class file
|
||||
|
||||
Public Sub Form_Open()
|
||||
|
||||
MapView1.Map.AddTile("OpenStreet", "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", Null)
|
||||
|
||||
End
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
# Gambas Form File 3.0
|
||||
|
||||
{ Form Form
|
||||
MoveScaled(0,0,64,64)
|
||||
MoveScaled(0,0,111,64)
|
||||
Arrangement = Arrange.Fill
|
||||
{ MapView1 MapView
|
||||
MoveScaled(0,2,64,61)
|
||||
}
|
||||
|
|
|
@ -8,14 +8,14 @@ Property SubDomains As String[]
|
|||
'Property Opacity As Float inherited '' Returns or sets Tile opacity.
|
||||
Property UseWebMapService As Boolean
|
||||
Property WMSArgs As Collection '' Defines the Static args for the server(build the url)
|
||||
Property MaxBounds As MapBounds
|
||||
Property MaxBounds As MapBounds
|
||||
Property CacheRefreshDelay As Integer '' Delay before refreshing an image in the cache. (By default 30 day)
|
||||
Property WMSProjection As String '' Set the projection used by the WMS server.
|
||||
Property Opacity As Float
|
||||
Property Header As String[] Use $aHeader
|
||||
Private $aStack As New String[]
|
||||
Private $aClients As New HttpClient[]
|
||||
Private $iClientCount As Integer = 4
|
||||
Private $iClientCount As Integer = 10
|
||||
Private $sCachePath As String ' = User.Home &/ ".cache/gb.map"
|
||||
Private $tmrGet As New Timer As "tmrGet"
|
||||
Private $aTiles As New String[]
|
||||
|
@ -27,7 +27,7 @@ Private $aPreload As New String[]
|
|||
Private $bPreloadMode As Boolean
|
||||
Private $fGradStep As Float = 0.1
|
||||
Private $bIsQuadKey As Boolean
|
||||
Private $bLoading As Boolean
|
||||
Private $bLoading As Boolean
|
||||
Private $iCli As Integer
|
||||
'Private $iTileSource As Integer
|
||||
'Property TileSource As Integer
|
||||
|
@ -55,7 +55,7 @@ Public Sub _new(Optional CacheName As String)
|
|||
'Dim hTable As Table
|
||||
|
||||
'db.Debug = True
|
||||
|
||||
|
||||
$prjLatLon = New Proj("epsg:4326")
|
||||
|
||||
$sCachePath = Me._GetMap().DefaultCache
|
||||
|
@ -71,28 +71,19 @@ Public Sub _new(Optional CacheName As String)
|
|||
Endif
|
||||
|
||||
$sCachePath = sTempPath
|
||||
|
||||
$aClients.Resize($iClientCount)
|
||||
For i = 0 To $aClients.Max
|
||||
|
||||
'Init httpClient Array
|
||||
For i = 0 To $iClientCount - 1
|
||||
hClient = New HttpClient As "Client"
|
||||
hClient.Async = True
|
||||
With Me._GetMap()
|
||||
If ._Proxy Then
|
||||
hClient.Proxy.Auth = ._Proxy.Auth
|
||||
hClient.Proxy.Type = ._Proxy.Type
|
||||
hClient.Proxy.Host = ._Proxy.Host
|
||||
hClient.Proxy.User = ._Proxy.User
|
||||
hClient.Proxy.Password = ._Proxy.Password
|
||||
Endif
|
||||
End With
|
||||
$aClients[i] = hClient
|
||||
hClient.Timeout = 10
|
||||
$aClients.Add(hClient)
|
||||
Next
|
||||
|
||||
|
||||
End
|
||||
' svn checkout --username=gambix svn+ssh://gambas@svn.code.sf.net/p/gambas/code/gambas/trunk
|
||||
'
|
||||
'
|
||||
'' Draws the Maptile Layer
|
||||
|
||||
Public Sub Draw()
|
||||
|
||||
Dim s As String
|
||||
|
@ -118,7 +109,7 @@ Public Sub Draw()
|
|||
If hmap._ShowWithEffect Then
|
||||
Try Paint.DrawImage(hTile.Image, hTile.X * 256 - hMap.PixelBox.X, hTile.Y * 256 - hMap.PixelBox.Y,,, Min(hTile.Opacity, Me.Opacity)) '$fOpacity))
|
||||
|
||||
If hTile.Opacity < Me.Opacity Then '$fOpacity Then
|
||||
If hTile.Opacity < Me.Opacity Then '$fOpacity Then
|
||||
hTile.Opacity += $fGradStep
|
||||
Raise Refresh
|
||||
Endif
|
||||
|
@ -166,7 +157,6 @@ Public Sub _Load()
|
|||
' Dim sExec As String
|
||||
' Dim bFirst As Boolean
|
||||
|
||||
|
||||
'***********************************
|
||||
|
||||
mpFirst = Geo.PixelToMapPoint(Point(hMap.PixelBox.x, hMap.PixelBox.y), hmap.Zoom)
|
||||
|
@ -190,7 +180,7 @@ Public Sub _Load()
|
|||
'ptTileCenter = Geo.MapPointToTile(hMap.Center, hMap.Zoom)
|
||||
'Print "Tile Center = " & ptTileCenter.x & " " & ptTileCenter.Y
|
||||
For Each sTileName In aTileOrder
|
||||
ars = Split(sTileName, "/")
|
||||
ars = Split(sTileName, "/")
|
||||
iY = CInt(ars[1])
|
||||
iX = CInt(ars[2])
|
||||
sTileName = Subst("&1-&2-&3-&4.png", hMap.Zoom, iY, iX, $iVersion)
|
||||
|
@ -200,11 +190,11 @@ Public Sub _Load()
|
|||
hTile.Y = iY
|
||||
hTile.Z = hMap.Zoom
|
||||
hTile.Name = sTileName
|
||||
If Exist($sCachePath &/ hTile.Name) Then
|
||||
If Exist($sCachePath &/ hTile.Name) Then
|
||||
'Print $db.Tables["tiles"]
|
||||
' hresult = $db.Exec("Select * from tiles where name=&1", "toto")
|
||||
' 'hresult = $DB.Find("tiles", "name=&1", hTile.Name)
|
||||
'
|
||||
'
|
||||
' If hresult.Available And If $bCacheRefresh And If DateDiff(Now(), hresult!lastmodified, gb.Day) > $iCacheRefreshDelay Then
|
||||
' ReLoadTile(hTile)
|
||||
' Else
|
||||
|
@ -215,7 +205,7 @@ Public Sub _Load()
|
|||
' Else
|
||||
hTile.Status = _Tile.Normal
|
||||
Try hTile.Image = Image.Load($sCachePath &/ hTile.Name)
|
||||
If Error Then
|
||||
If Error Then
|
||||
'Error "Image illisible -> " & hTile.Name
|
||||
ReLoadTile(hTile)
|
||||
Else
|
||||
|
@ -246,7 +236,7 @@ Public Sub _Load()
|
|||
' hTile.TryCount = 0
|
||||
' ReLoadTile(hTile)
|
||||
' Endif
|
||||
Endif
|
||||
Endif
|
||||
|
||||
$aTiles.Add(sTileName)
|
||||
Next
|
||||
|
@ -255,8 +245,8 @@ Public Sub _Load()
|
|||
' If hmap.Zoom > 1 Then
|
||||
' ptFirst = Geo.MapPointToTile(mpFirst, hmap.Zoom - 1)
|
||||
' ptLast = Geo.MapPointToTile(mpLast, hmap.Zoom - 1)
|
||||
' For iX = ptFirst.X To ptLast.X
|
||||
' For iY = ptFirst.Y To ptLast.Y
|
||||
' For iX = ptFirst.X To ptLast.X
|
||||
' For iY = ptFirst.Y To ptLast.Y
|
||||
' sTileName = Subst("&1-&2-&3.png", hMap.Zoom - 1, iY, iX)
|
||||
' If Exist($sCachePath &/ sTileName) Then Continue
|
||||
' $aPreload.Push(sTileName)
|
||||
|
@ -267,8 +257,8 @@ Public Sub _Load()
|
|||
' If hmap.Zoom < 18 Then
|
||||
' ptFirst = Geo.MapPointToTile(mpFirst, hmap.Zoom + 1)
|
||||
' ptLast = Geo.MapPointToTile(mpLast, hmap.Zoom + 1)
|
||||
' For iX = ptFirst.X To ptLast.X
|
||||
' For iY = ptFirst.Y To ptLast.Y
|
||||
' For iX = ptFirst.X To ptLast.X
|
||||
' For iY = ptFirst.Y To ptLast.Y
|
||||
' sTileName = Subst("&1-&2-&3.png", hMap.Zoom + 1, iY, iX)
|
||||
' If Exist($sCachePath &/ sTileName) Then Continue
|
||||
' $aPreload.Push(sTileName)
|
||||
|
@ -288,14 +278,14 @@ Private Sub ReLoadTile(hTile As _Tile)
|
|||
|
||||
'Dim hresult As Result
|
||||
|
||||
If hTile.TryCount > 3 Then
|
||||
If hTile.TryCount > 3 Then
|
||||
hTile.Status = _Tile.Error
|
||||
$tmrGet.Trigger
|
||||
Raise Refresh
|
||||
Return
|
||||
Endif
|
||||
'If the tile exist then remove it
|
||||
If Exist($sCachePath &/ hTile.Name) Then
|
||||
If Exist($sCachePath &/ hTile.Name) Then
|
||||
Kill $sCachePath &/ hTile.Name
|
||||
|
||||
Endif
|
||||
|
@ -336,9 +326,9 @@ Catch
|
|||
End
|
||||
|
||||
' Private Function GetMap() As Map
|
||||
'
|
||||
'
|
||||
' Return Object.Parent(Me)
|
||||
'
|
||||
'
|
||||
' End
|
||||
|
||||
Public Sub tmrGet_Timer()
|
||||
|
@ -356,7 +346,7 @@ Public Sub tmrGet_Timer()
|
|||
sFile = $aPreload.Pop()
|
||||
Else
|
||||
$bLoading = $aStack.Count > 0
|
||||
If $aStack.count = 0 Then
|
||||
If $aStack.count = 0 Then
|
||||
$bPreloadMode = True
|
||||
Return
|
||||
Endif
|
||||
|
@ -377,15 +367,34 @@ End
|
|||
|
||||
Private Sub GetClient() As HttpClient
|
||||
|
||||
Dim hClient As HttpClient
|
||||
For i As Integer = 0 To $aClients.max
|
||||
If $aClients[i].Status = Net.Inactive Then Return $aClients[i]
|
||||
If $aClients[i].Status = Net.Inactive Then
|
||||
$aClients[i].Close
|
||||
hClient = New HttpClient As "Client"
|
||||
hClient.Async = True
|
||||
hClient.Timeout = 10
|
||||
'Setup proxy
|
||||
With Me._GetMap()
|
||||
If ._Proxy Then
|
||||
hClient.Proxy.Auth = ._Proxy.Auth
|
||||
hClient.Proxy.Type = ._Proxy.Type
|
||||
hClient.Proxy.Host = ._Proxy.Host
|
||||
hClient.Proxy.User = ._Proxy.User
|
||||
hClient.Proxy.Password = ._Proxy.Password
|
||||
Endif
|
||||
End With
|
||||
|
||||
$aClients[i] = hClient
|
||||
Return hClient
|
||||
Endif
|
||||
Next
|
||||
|
||||
End
|
||||
|
||||
Public Sub Client_Finished()
|
||||
|
||||
Dim hTile As _Tile
|
||||
Dim hTile As _Tile
|
||||
'Dim hresult As Result
|
||||
|
||||
Dec $iCli
|
||||
|
@ -393,7 +402,7 @@ Public Sub Client_Finished()
|
|||
hTile = $colTiles[Last.Tag]
|
||||
If Not hTile Then Goto Skip
|
||||
Try hTile.Image = Image.Load($sCachePath &/ hTile.Name)
|
||||
If Error Then
|
||||
If Error Then
|
||||
'Error "Image illisible -> " & hTile.Name
|
||||
ReLoadTile(hTile)
|
||||
Return
|
||||
|
@ -401,7 +410,7 @@ Public Sub Client_Finished()
|
|||
'Print hTile.Name
|
||||
hTile.Status = _Tile.Normal
|
||||
'If $bHaveCache Then $aNewTiles.Add(hTile.Name)
|
||||
' 'The tile have been loaded and the file is created so now
|
||||
' 'The tile have been loaded and the file is created so now
|
||||
' 'we add an entry to the database
|
||||
' hresult = $DB.Create("tiles")
|
||||
' hresult!name = hTile.Name
|
||||
|
@ -457,24 +466,24 @@ Private Function GetTileUrl(hTile As _Tile) As String
|
|||
End
|
||||
|
||||
' Private Function GetWMSTilept(X As Integer, Y As Integer, Z As Integer) As String
|
||||
'
|
||||
'
|
||||
' Dim hBound As MapBounds = Geo.TileBounds(X, Y, Z)
|
||||
' Dim hbound2 As MapBounds
|
||||
' ' Dim hbound2 As MapBounds = Geo.TileBounds(x + 1, y - 1, z)
|
||||
' Dim hConv, hConv2 As MapBounds
|
||||
' Dim sTemp As String
|
||||
' Dim s As String
|
||||
'
|
||||
'
|
||||
' If Not Me.MaxBounds.Collide(hbound) Then Return
|
||||
'
|
||||
'
|
||||
' For Each s In $cWMSArgs
|
||||
'
|
||||
' sTemp &= "&" & $cWMSArgs.Key & "=" & s
|
||||
'
|
||||
'
|
||||
' sTemp &= "&" & $cWMSArgs.Key & "=" & s
|
||||
'
|
||||
' Next
|
||||
'
|
||||
' If $cWMSArgs.Exist("bbox") Then
|
||||
'
|
||||
'
|
||||
' If $cWMSArgs.Exist("bbox") Then
|
||||
'
|
||||
' 'Invertion de coordonée
|
||||
' ' Print "de -> ", hbound.lat2, hbound.Lon, hbound.Lat, hbound.Lon2
|
||||
' ' hbound2 = $prjLatLon.TransformMBounds($prjWMS, hbound)
|
||||
|
@ -491,7 +500,7 @@ End
|
|||
' sTemp = Replace(sTemp, "{lon}", CStr(hbound.Lon))
|
||||
' sTemp = Replace(sTemp, "{lat2}", CStr(hbound.lat2))
|
||||
' sTemp = Replace(sTemp, "{lon2}", CStr(hbound.lon2))
|
||||
'
|
||||
'
|
||||
' Else
|
||||
' If $cWMSArgs.Exist("tilerow") Or If $cWMSArgs.Exist("TILEROW") Then
|
||||
' If InStr(sTemp, "{q}") Then
|
||||
|
@ -500,32 +509,32 @@ End
|
|||
' sTemp = Replace(sTemp, "{x}", CStr(X))
|
||||
' sTemp = Replace(sTemp, "{y}", CStr(Y))
|
||||
' sTemp = Replace(sTemp, "{z}", CStr(Z))
|
||||
'
|
||||
'
|
||||
' Endif
|
||||
' Endif
|
||||
' Endif
|
||||
'
|
||||
' 'sTemp = $sPattern &
|
||||
' 'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2
|
||||
'
|
||||
' 'sTemp = $sPattern &
|
||||
' 'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2
|
||||
' Print sTemp
|
||||
' Return $sPattern & "?" & sTemp
|
||||
'
|
||||
'
|
||||
' End
|
||||
Private Function GetWMSTilept(X As Integer, Y As Integer, Z As Integer) As String
|
||||
|
||||
Dim hBound As MapBounds = Geo.TileBounds(X, Y, Z)
|
||||
' Dim hbound2 As MapBounds = Geo.TileBounds(x + 1, y - 1, z)
|
||||
' Dim hConv, hConv2 As MapBounds
|
||||
' Dim hConv, hConv2 As MapBounds
|
||||
Dim sTemp As String
|
||||
Dim s As String
|
||||
|
||||
If Not Me.MaxBounds.Collide(hbound) Then Return
|
||||
|
||||
For Each s In $cWMSArgs
|
||||
sTemp &= "&" & $cWMSArgs.Key & "=" & s
|
||||
sTemp &= "&" & $cWMSArgs.Key & "=" & s
|
||||
Next
|
||||
|
||||
If $cWMSArgs.Exist("bbox") Then
|
||||
If $cWMSArgs.Exist("bbox") Then
|
||||
'Print X, Y, Z, hbound.Lat, hbound.Lon, hbound.lat2, hbound.lon2
|
||||
'Invertion de coordonée
|
||||
'hbound = MapBounds(MapPoint(hBound.lat2, hBound.lon), MapPoint(hBound.lat, hBound.Lon2))
|
||||
|
@ -547,17 +556,17 @@ Private Function GetWMSTilept(X As Integer, Y As Integer, Z As Integer) As Strin
|
|||
sTemp = Replace(sTemp, "{x}", CStr(X))
|
||||
sTemp = Replace(sTemp, "{y}", CStr(Y))
|
||||
sTemp = Replace(sTemp, "{z}", CStr(Z))
|
||||
|
||||
|
||||
Endif
|
||||
Endif
|
||||
Endif
|
||||
|
||||
'sTemp = $sPattern &
|
||||
'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2
|
||||
'sTemp = $sPattern &
|
||||
'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2
|
||||
|
||||
'Print X, Y, Z, hbound.Lat, hbound.Lon, hbound.lat2, hbound.lon2
|
||||
'Print X, Y, Z, Mid(sTemp, InStr(sTemp, "bbox"))
|
||||
' Print
|
||||
' Print
|
||||
' Print
|
||||
|
||||
Return $sPattern & "?" & sTemp
|
||||
|
@ -569,7 +578,7 @@ Private Function GetTileUrlpt(X As Integer, Y As Integer, Z As Integer) As Strin
|
|||
Dim sTemp As String
|
||||
|
||||
If $bUseWMS Then
|
||||
sTemp = GetWMSTilept(X, Y, Z)
|
||||
sTemp = GetWMSTilept(X, Y, Z)
|
||||
If Map.Debug Then Debug sTemp
|
||||
Return sTemp
|
||||
Else
|
||||
|
@ -759,12 +768,13 @@ End
|
|||
'' Remove old files from cache.
|
||||
'' - iLastUse defines file age in days
|
||||
Public Sub ClearCache(Optional iLastUse As Integer)
|
||||
'needs some testing...
|
||||
'needs some testing...
|
||||
|
||||
If $sCachePath = Null Or Len($sCachePath) < 5 Then Return
|
||||
If iLastUse Then
|
||||
Exec ["find", $sCachePath, "-mtime", "+" & Str(iLastUse), "-delete"] With ["PWD", $sCachePath]
|
||||
Else
|
||||
Exec ["rm", $sCachePath &/ "*"]
|
||||
Endif
|
||||
End
|
||||
|
||||
End
|
||||
|
|
Loading…
Reference in a new issue