Para este ejemplo hace falta poner sobre el Form un DrawingArea, un Slider y un LCDLabel, y tambien activar los Componentes gb.map, gb.qt5 y gb.qt5.ext .
Private hMap As New Map
Private x As Integer
Private y As Integer
Private mp As MapPoint
Private pt As New Point
Private coo As Boolean
Public Sub _New()
With hMap
.AddTile("GoogleMaps", "https://khms{s}.google.it/kh/v={version}&src=app&x={x}&y={y}&z={z}&s=Galile", ["version": "860"]).SubDomains = ["0", "1", "2"]
'' Ad honorem nostri excellentissimi romani Consulis Shell !
mp = MapPoint(36.528318, -6.293677)
.Center = mp
End With
With Me
.W = Desktop.W
.H = Desktop.H
End With
With DrawingArea1
.X = Me.W * 0.007
.Y = Me.H * 0.01
.W = Me.W * 0.96
.H = Me.H * 0.95
End With
With LCDLabel1
.X = Me.W * 0.967
.Y = Me.H * 0.04
.W = Me.W * 0.02
.H = Me.H * 0.02
.Alignment = Align.Right
.Foreground = Color.Red
.Font.Size = 18
.Font.Bold = True
End With
End
Public Sub Form_Open()
With Slider1
.X = Me.W * 0.975
.Y = Me.H * 0.07
.Value = 6
.MaxValue = 18
.MinValue = 6
End With
hMap.Zoom = Slider1.Value
DrawingArea1.Refresh()
End
Public Sub DrawingArea1_Draw()
Dim lat, lon As Float
With hMap
.Width = Paint.W
.Height = Paint.H
.Draw()
End With
lat = hMap.PixelToMapPointRel(pt).Lat
lon = hMap.PixelToMapPointRel(pt).Lon
If coo Then
With Paint
.Brush = Paint.Color(Color.Red)
.Font.Size = 16
.Ellipse(x - 1, y - 1, 4, 4)
.Font.Size = 8
.Text(" " & Geo.DecToSex(lat, 1) & "\n " & Geo.DecToSex(lon, 2), x, y, 120, 20)
.Fill
.End
End With
Endif
DrawingArea1.Refresh()
End
Public Sub DrawingArea1_MouseMove()
Dim c As New Single[18]
Dim mx, my As Short
c = [0, 0, 0, 0, 0, 5, 6.4, 7.6, 8.8, 9.9, 10.9, 11.9, 12.94, 13.96, 14.98, 15.98, 16.99, 17.994]
mx = (x - Mouse.X)
my = (y - Mouse.Y)
With hMap
.Center.Lat -= ((my ^ 0) * my) / ((Slider1.Value * 10) / (Slider1.Value - c[Slider1.Value - 1]))
.Center.Lon += ((mx ^ 0) * mx) / ((Slider1.Value * 10) / (Slider1.Value - c[Slider1.Value - 1]))
End With
x = Mouse.X
y = Mouse.Y
End
Public Sub DrawingArea1_MouseDown()
pt = pt(Mouse.X, Mouse.Y)
x = Mouse.X
y = Mouse.Y
coo = False
End
Public Sub Slider1_Change()
hMap.Zoom = Slider1.Value
LCDLabel1.Value = Slider1.Value
coo = False
End
Public Sub DrawingArea1_MouseUp()
pt = pt(Mouse.X, Mouse.Y)
mp = MapPoint(hMap.PixelToMapPointRel(pt).Lat, hMap.PixelToMapPointRel(pt).Lon)
coo = True
End
Public Sub Form_Close()
Quit
End
Private x As Integer
Private y As Integer
Private mp As MapPoint
Private pt As New Point
Private coo As Boolean
Public Sub _New()
With hMap
.AddTile("GoogleMaps", "https://khms{s}.google.it/kh/v={version}&src=app&x={x}&y={y}&z={z}&s=Galile", ["version": "860"]).SubDomains = ["0", "1", "2"]
'' Ad honorem nostri excellentissimi romani Consulis Shell !
mp = MapPoint(36.528318, -6.293677)
.Center = mp
End With
With Me
.W = Desktop.W
.H = Desktop.H
End With
With DrawingArea1
.X = Me.W * 0.007
.Y = Me.H * 0.01
.W = Me.W * 0.96
.H = Me.H * 0.95
End With
With LCDLabel1
.X = Me.W * 0.967
.Y = Me.H * 0.04
.W = Me.W * 0.02
.H = Me.H * 0.02
.Alignment = Align.Right
.Foreground = Color.Red
.Font.Size = 18
.Font.Bold = True
End With
End
Public Sub Form_Open()
With Slider1
.X = Me.W * 0.975
.Y = Me.H * 0.07
.Value = 6
.MaxValue = 18
.MinValue = 6
End With
hMap.Zoom = Slider1.Value
DrawingArea1.Refresh()
End
Public Sub DrawingArea1_Draw()
Dim lat, lon As Float
With hMap
.Width = Paint.W
.Height = Paint.H
.Draw()
End With
lat = hMap.PixelToMapPointRel(pt).Lat
lon = hMap.PixelToMapPointRel(pt).Lon
If coo Then
With Paint
.Brush = Paint.Color(Color.Red)
.Font.Size = 16
.Ellipse(x - 1, y - 1, 4, 4)
.Font.Size = 8
.Text(" " & Geo.DecToSex(lat, 1) & "\n " & Geo.DecToSex(lon, 2), x, y, 120, 20)
.Fill
.End
End With
Endif
DrawingArea1.Refresh()
End
Public Sub DrawingArea1_MouseMove()
Dim c As New Single[18]
Dim mx, my As Short
c = [0, 0, 0, 0, 0, 5, 6.4, 7.6, 8.8, 9.9, 10.9, 11.9, 12.94, 13.96, 14.98, 15.98, 16.99, 17.994]
mx = (x - Mouse.X)
my = (y - Mouse.Y)
With hMap
.Center.Lat -= ((my ^ 0) * my) / ((Slider1.Value * 10) / (Slider1.Value - c[Slider1.Value - 1]))
.Center.Lon += ((mx ^ 0) * mx) / ((Slider1.Value * 10) / (Slider1.Value - c[Slider1.Value - 1]))
End With
x = Mouse.X
y = Mouse.Y
End
Public Sub DrawingArea1_MouseDown()
pt = pt(Mouse.X, Mouse.Y)
x = Mouse.X
y = Mouse.Y
coo = False
End
Public Sub Slider1_Change()
hMap.Zoom = Slider1.Value
LCDLabel1.Value = Slider1.Value
coo = False
End
Public Sub DrawingArea1_MouseUp()
pt = pt(Mouse.X, Mouse.Y)
mp = MapPoint(hMap.PixelToMapPointRel(pt).Lat, hMap.PixelToMapPointRel(pt).Lon)
coo = True
End
Public Sub Form_Close()
Quit
End
Albacete
