Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found
Select Git revision

Target

Select target project
  • xmonader/gambas
  • gambas/gambas
  • gbWilly/gambas
  • dtardon/gambas
  • Davidmue/gambas
  • mmu_man/gambas
  • jguardon/gambas
  • tstueker/gambas
  • timsoft/gambas
  • yann64/gambas
  • Matthew-Collins/gambas
  • microhobby/gambas
  • ercoupeflyer/gambas
  • pebauer68/gambas
  • ptmarstech/gambas
  • christhal/gambas
  • tboege/gambas
  • christopherwoo/gambas
  • yusronarif/gambas
  • gen.braga/gambas
  • MelvinG24/gambas
  • Krischel/gambas
  • liang-wei/gambas
  • brucebruen/gambas
  • LibreDWG/gambas
  • SkyN9ne/gambas
  • zxMarce/gambas
  • lordheavy/gambas
  • ddabrahams76/gambas
  • GianluigiOr/gambas
  • rfc1394/gambas
  • wekan/gambas
  • bsteers4/gambas
  • fweimer-rh/gambas
  • CDCDCDCDCDCD/gambas
  • geekdu42/gambas
  • belmotek/gambas
  • jfrank1500/gambas
  • mfischerq/gambas
  • shiny0110/gambas
  • kk667788/gambas
  • bandali/gambas
  • 64sys/gambas
  • justlostintime/gambas
  • aleasto/gambas
  • bgermann/gambas
  • linusky/gambas
47 results
Select Git revision
Show changes
Commits on Source (2)
...@@ -11,6 +11,7 @@ Component=gb.net ...@@ -11,6 +11,7 @@ Component=gb.net
Component=gb.net.curl Component=gb.net.curl
Description="Map viewer" Description="Map viewer"
Authors="Fabien Bodard" Authors="Fabien Bodard"
Environment="GB_GUI=gb.qt5"
TabSize=2 TabSize=2
Language=fr Language=fr
Type=Component Type=Component
......
...@@ -9,7 +9,7 @@ Property Selected As Boolean '' Returns or sets if this Item is sel ...@@ -9,7 +9,7 @@ Property Selected As Boolean '' Returns or sets if this Item is sel
'Property Color As Integer 'Property Color As Integer
Property Bounds As MapBounds Property Bounds As MapBounds
Private $sKey As String Private $sKey As String
Private $bSelected As Boolean Private $bSelected As Boolean = False
Private $hBounds As MapBounds Private $hBounds As MapBounds
'Private $fLineStyle As Integer 'Private $fLineStyle As Integer
Public Type As Integer '' Returns or sets this Item's type (Point, MultiPoint, Polyline, Polygon, Circle) Public Type As Integer '' Returns or sets this Item's type (Point, MultiPoint, Polyline, Polygon, Circle)
......
...@@ -21,6 +21,9 @@ Dim hbound As MapBounds ...@@ -21,6 +21,9 @@ Dim hbound As MapBounds
'MapView1.Map.DefaultCache = "/home/tmp" 'MapView1.Map.DefaultCache = "/home/tmp"
MapView1.Map.AddTile("OpenStreetMap", "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", Null, "OpenStreetMap1").Copyright = "© OpenStreetMap contributors" MapView1.Map.AddTile("OpenStreetMap", "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", Null, "OpenStreetMap1").Copyright = "© OpenStreetMap contributors"
MapView1.Map.AddTile("NOAA", "https://tileservice.charts.noaa.gov/tiles/50000_1/{z}/{x}/{y}.png",, "NOAA") ', ["projection": "EPSG:3857"])
'MapView1.Map.AddTile("NOAA", "https://tileservice.charts.noaa.gov/tiles/13003_1/{z}/{x}/{y}.png", ["projection": "EPSG:3857", "displayProjection": " EPSG: 4326 "])
'" http: / / tileservice.charts.noaa.gov / tiles / 50000 _1 / {z} / {x} / {y}.png ").SubDomains = [" 0 ", " 1 ", " 2 "]"
MapView1.Map.GetTile("OpenStreetMap").Opacity = 0.3 MapView1.Map.GetTile("OpenStreetMap").Opacity = 0.3
MapView1.Map.Center = MapPoint(48.866667, 2.333333) MapView1.Map.Center = MapPoint(48.866667, 2.333333)
...@@ -33,6 +36,7 @@ Dim hbound As MapBounds ...@@ -33,6 +36,7 @@ Dim hbound As MapBounds
MapView1.Map.GetShape("Shape").AddPoint("point 1", MapPoint(48.866667, 2.333333)) MapView1.Map.GetShape("Shape").AddPoint("point 1", MapPoint(48.866667, 2.333333))
MapView1.Map.GetShape("Shape").AddPoint("point 2", MapPoint(48.866667, 2.533333)).Selected = False MapView1.Map.GetShape("Shape").AddPoint("point 2", MapPoint(48.866667, 2.533333)).Selected = False
MapView1.Map.GetShape("Shape").AddPoint("point 3", MapPoint(48.866667, 2.533333), Color.Yellow, Image.Load("plus.png"))
Dim tmp1 As New MapPoint[] Dim tmp1 As New MapPoint[]
Dim tmp2 As New MapPoint Dim tmp2 As New MapPoint
...@@ -40,7 +44,7 @@ Dim hbound As MapBounds ...@@ -40,7 +44,7 @@ Dim hbound As MapBounds
tmp2 = MapPoint.GetCenter(tmp1) tmp2 = MapPoint.GetCenter(tmp1)
MapView1.Map.GetShape("Shape").AddMultipoint("multipoint1", tmp1, Color.green, Image.Load("plus.png")) MapView1.Map.GetShape("Shape").AddMultipoint("multipoint1", tmp1, Color.green, Image.Load("plus.png"))
'
MapView1.Map.GetShape("Shape").AddPolyLine("poly1", tmp1, Color.Yellow, 4, Line.DashDotDot) MapView1.Map.GetShape("Shape").AddPolyLine("poly1", tmp1, Color.Yellow, 4, Line.DashDotDot)
MapView1.Map.GetShape("Shape").AddCircle("cir1", tmp2, 5000, Color.green, 4, Line.dot, Color.Transparent) MapView1.Map.GetShape("Shape").AddCircle("cir1", tmp2, 5000, Color.green, 4, Line.dot, Color.Transparent)
MapView1.Map.GetShape("Shape").AddCircle("cir2", tmp2, 2500, Color.red, 4, Line.dash, Color.Transparent) MapView1.Map.GetShape("Shape").AddCircle("cir2", tmp2, 2500, Color.red, 4, Line.dash, Color.Transparent)
......
...@@ -21,32 +21,32 @@ End ...@@ -21,32 +21,32 @@ End
Public Function MapPointToPixel(hMapPoint As MapPoint, Zoom As Integer) As Point Public Function MapPointToPixel(hMapPoint As MapPoint, Zoom As Integer) As Point
Dim Res As Float = $initialResolution / (2 ^ zoom) Dim fRes As Float = $initialResolution / (2 ^ Zoom)
Dim X, Y As Float Dim fX, fY As Float
'Convert in Meters 'Convert in Meters
X = hMapPoint.lon * $OriginShift / 180.0 fX = hMapPoint.lon * $OriginShift / 180.0
Y = - (Log(Tan((90 + hMapPoint.lat) * Pi / 360.0)) / (Pi / 180.0)) * $OriginShift / 180.0 fY = -(Log(Tan((90 + hMapPoint.lat) * Pi / 360.0)) / (Pi / 180.0)) * $OriginShift / 180.0
'Convert in Pixels 'Convert in Pixels
X = (X + $originShift) / res fX = (fX + $originShift) / fRes
Y = (Y + $originShift) / res fY = (fY + $originShift) / fRes
Return Point(X, Y) Return Point(fX, fY)
End End
Public Function PixelToMapPoint(hPoint As Point, Zoom As Integer) As MapPoint Public Function PixelToMapPoint(hPoint As Point, Zoom As Integer) As MapPoint
Dim X, Y As Float Dim fX, fY As Float
Dim Res As Float = $initialResolution / (2 ^ zoom) Dim fRes As Float = $initialResolution / (2 ^ Zoom)
Dim mpPoint As New MapPoint Dim mpPoint As New MapPoint
'Convert in Meters 'Convert in Meters
X = hPoint.x * res - $originShift fX = hPoint.x * fRes - $originShift
Y = hPoint.y * res - $originShift fY = hPoint.y * fRes - $originShift
'Convert in Latlon mappoint 'Convert in Latlon mappoint
mpPoint.Lon = (X / $originShift) * 180.0 mpPoint.Lon = (fX / $originShift) * 180.0
mpPoint.Lat = (Y / $originShift) * 180.0 mpPoint.Lat = (fY / $originShift) * 180.0
mpPoint.Lat = -(180 / Pi * (2 * ATan(Exp(mpPoint.Lat * Pi / 180.0)) - Pi / 2.0)) mpPoint.Lat = -(180 / Pi * (2 * ATan(Exp(mpPoint.Lat * Pi / 180.0)) - Pi / 2.0))
Return mpPoint Return mpPoint
...@@ -106,7 +106,7 @@ Public Function DecToSex(Value As Float, Type As Integer) As String ...@@ -106,7 +106,7 @@ Public Function DecToSex(Value As Float, Type As Integer) As String
fSec = Frac(fSec) * 60 fSec = Frac(fSec) * 60
sret = Subst("&1°&2'&3''", iDeg, iMin, Format(fSec, "0.##")) & sRet sret = Subst("&1°&2'&3''", iDeg, iMin, Format(fSec, "0.##")) & sRet
Return sret Return sRet
End End
......
...@@ -3,17 +3,14 @@ ...@@ -3,17 +3,14 @@
'Export 'Export
Static Public Sub Polygone(Pt As Integer[]) Static Public Sub Polygone(Pt As Integer[])
Dim i As Integer
If pt.Count < 2 Then Return If pt.Count < 2 Then Return
Paint.MoveTo(pt[0], pt[1]) Paint.MoveTo(pt[0], pt[1])
For i = 2 To pt.Max Step 2 For i As Integer = 2 To pt.Max Step 2
Paint.LineTo(pt[i], pt[i + 1]) Paint.LineTo(pt[i], pt[i + 1])
Next Next
Paint.LineTo(pt[0], pt[1]) Paint.LineTo(pt[0], pt[1])
End End
Static Public Sub RectangleRectF(hFbox As RectF) Static Public Sub RectangleRectF(hFbox As RectF)
Paint.Rectangle(hFbox.x, hFbox.Y, hFbox.Right - hFbox.X, hFbox.Bottom - hFbox.Y) Paint.Rectangle(hFbox.x, hFbox.Y, hFbox.Right - hFbox.X, hFbox.Bottom - hFbox.Y)
......
...@@ -20,8 +20,6 @@ Static Public Function _call(sInit As String) As Proj ...@@ -20,8 +20,6 @@ Static Public Function _call(sInit As String) As Proj
End End
Public Function TransformPF(ProjTo As Proj, PF As PointF) As PointF Public Function TransformPF(ProjTo As Proj, PF As PointF) As PointF
Dim sCom, sRes As String Dim sCom, sRes As String
Dim a As String[] Dim a As String[]
...@@ -45,7 +43,6 @@ Public Function TransformMPoint(ProjTo As Proj, MP As MapPoint) As MapPoint ...@@ -45,7 +43,6 @@ Public Function TransformMPoint(ProjTo As Proj, MP As MapPoint) As MapPoint
If ProjTo._strProj <> LastTransformString Then If ProjTo._strProj <> LastTransformString Then
LastTransformString = ProjTo._strProj LastTransformString = ProjTo._strProj
Endif Endif
sCom = Subst("cs2cs -f \"%f\" +init=&1 +to +init=&2<<EOF\n", $strProj, ProjTo._strProj) sCom = Subst("cs2cs -f \"%f\" +init=&1 +to +init=&2<<EOF\n", $strProj, ProjTo._strProj)
......
...@@ -166,7 +166,7 @@ End ...@@ -166,7 +166,7 @@ End
'fillcolor should come after color, but i dont want to break anything... 'fillcolor should come after color, but i dont want to break anything...
Public Sub AddCircle(Key As String, Center As MapPoint, Radius As Float, Optional {Color} As Integer, Optional {LineWidth} As Integer, Optional {LineStyle} As Integer, Optional {FillColor} As Integer) As _ShapeItem Public Sub AddCircle(Key As String, Center As MapPoint, Radius As Float, Optional {Color} As Integer, Optional {LineWidth} As Integer, Optional {LineStyle} As Integer, Optional {FillColor} As Integer) As _ShapeItem
If $aShapeNames.Exist(Key) Then Error.Raise("Key already exist: " & Key) 'If $aShapeNames.Exist(Key) Then Error.Raise("Key already exist: " & Key)
Dim P1, P2, P3, P4 As MapPoint Dim P1, P2, P3, P4 As MapPoint
Dim hItem As New _ShapeItem(Key) As "Item" Dim hItem As New _ShapeItem(Key) As "Item"
...@@ -254,7 +254,8 @@ Public Sub Draw() ...@@ -254,7 +254,8 @@ Public Sub Draw()
pt = Geo.MapPointToPixel(hShape.Points, hMap.zoom) pt = Geo.MapPointToPixel(hShape.Points, hMap.zoom)
If hShape.Image Then If hShape.Image Then
'Draws centralized 'Draws centralized
Paint.DrawImage(IIf(hShape.Color, hShape.Image.Colorize(hShape.Color), hShape.Image), pt.X - hMap.PixelBox.X - hShape.Image.Height / 2, pt.Y - hMap.PixelBox.Y - hShape.Image.width / 2) If hShape.Color <> -1 Then hShape.Image.Colorize(hShape.Color)
Paint.DrawImage(hShape.Image, pt.X - hMap.PixelBox.X - hShape.Image.Height / 2, pt.Y - hMap.PixelBox.Y - hShape.Image.width / 2)
Else Else
'Draws with default "red point" icon offset 'Draws with default "red point" icon offset
Paint.DrawImage(Me.Image, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) Paint.DrawImage(Me.Image, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32)
...@@ -270,7 +271,9 @@ Public Sub Draw() ...@@ -270,7 +271,9 @@ Public Sub Draw()
' Endif ' Endif
If hShape.Image Then If hShape.Image Then
'Draws centralized 'Draws centralized
Paint.DrawImage(IIf(hShape.Color, hShape.Image.Colorize(hShape.Color), hShape.Image), pt.X - hMap.PixelBox.X - hShape.Image.Height / 2, pt.Y - hMap.PixelBox.Y - hShape.Image.width / 2) If hShape.Color <> -1 Then hShape.Image.Colorize(hShape.Color)
Paint.DrawImage(hShape.Image, pt.X - hMap.PixelBox.X - hShape.Image.Height / 2, pt.Y - hMap.PixelBox.Y - hShape.Image.width / 2)
'Paint.DrawImage(IIf(hShape.Color, hShape.Image.Colorize(hShape.Color), hShape.Image), pt.X - hMap.PixelBox.X - hShape.Image.Height / 2, pt.Y - hMap.PixelBox.Y - hShape.Image.width / 2)
Else Else
'Draws with default "red point" icon offset 'Draws with default "red point" icon offset
Paint.DrawImage(Me.Image, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) Paint.DrawImage(Me.Image, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32)
...@@ -388,20 +391,20 @@ End ...@@ -388,20 +391,20 @@ End
Private Function GetPointBounds(hMapPoints As MapPoint[]) As MapBounds Private Function GetPointBounds(hMapPoints As MapPoint[]) As MapBounds
Dim X, Y, X2, Y2 As Float Dim fX, fY, fX2, fY2 As Float
X = hMapPoints[0].Lon fX = hMapPoints[0].Lon
Y = hMapPoints[0].Lat fY = hMapPoints[0].Lat
X2 = X fX2 = fX
Y2 = Y fY2 = fY
For Each hPoint As MapPoint In hMapPoints For Each hPoint As MapPoint In hMapPoints
X = Min(hPoint.lon, X) fX = Min(hPoint.lon, fX)
Y2 = Min(hPoint.lat, Y2) fY2 = Min(hPoint.lat, fY2)
X2 = Max(hPoint.lon, X2) fX2 = Max(hPoint.lon, fX2)
Y = Max(hPoint.lat, Y) fY = Max(hPoint.lat, fY)
Next Next
Return MapBounds(MapPoint(Y, X), MapPoint(Y2, X2)) Return MapBounds(MapPoint(fY, fX), MapPoint(fY2, fX2))
End End
......
...@@ -589,14 +589,12 @@ End ...@@ -589,14 +589,12 @@ End
Public Sub SetPattern(sPattern As String, Optional cArgs As Collection) Public Sub SetPattern(sPattern As String, Optional cArgs As Collection)
Dim s As Variant
$sPattern = sPattern $sPattern = sPattern
If InStr($sPattern, "{q}") Then $bIsQuadKey = True Else $bIsQuadKey = False If InStr($sPattern, "{q}") Then $bIsQuadKey = True Else $bIsQuadKey = False
If cArgs Then If cArgs Then
For Each s In cArgs For Each s As Variant In cArgs
$sPattern = Replace($sPattern, "{" & cArgs.Key & "}", s) $sPattern = Replace($sPattern, "{" & cArgs.Key & "}", s)
Next Next
Endif Endif
...@@ -629,18 +627,18 @@ End ...@@ -629,18 +627,18 @@ End
Private Function TileToQuadKey(X As Integer, Y As Integer, Z As Integer) As String Private Function TileToQuadKey(X As Integer, Y As Integer, Z As Integer) As String
Dim quadKey As String Dim sQuadKey As String
Dim i, digit, mask As Integer Dim iDigit, iMask As Integer
For i = z To 1 Step -1 For i As Integer = z To 1 Step -1
digit = 0 iDigit = 0
mask = Lsl(1, (i - 1)) iMask = Lsl(1, (i - 1))
If (x And mask) <> 0 Then digit += 1 If (x And iMask) <> 0 Then iDigit += 1
If (y And mask) <> 0 Then digit += 2 If (y And iMask) <> 0 Then iDigit += 2
quadKey &= digit sQuadKey &= iDigit
Next Next
Return quadKey Return sQuadKey
End End
...@@ -680,17 +678,17 @@ End ...@@ -680,17 +678,17 @@ End
'' Usefull for using with some server that query a session. '' Usefull for using with some server that query a session.
Public Function SetCoockieFile(sFile As String) As Object Public Function SetCoockieFile(sFile As String) As Object
Dim hc As HttpClient Dim hClient As HttpClient
If Not sFile Then If Not sFile Then
For Each hc In $aClients For Each hClient In $aClients
hc.UpdateCookies = False hClient.UpdateCookies = False
hc.CookiesFile = "" hClient.CookiesFile = ""
Next Next
Else Else
For Each hc In $aClients For Each hClient In $aClients
hc.UpdateCookies = True hClient.UpdateCookies = True
hc.CookiesFile = sFile hClient.CookiesFile = sFile
Next Next
Endif Endif
......