#include <fivewin.ch>
********** TEST CODE **********
proc main
LOCAL oWnd, oMap, oMarker, bDraw
Local oDataLink := CreateObject
("Datalinks") DEFINE WINDOW oWnd
TITLE "Map Test" SetWndDefault
(oWnd
) oMarker := FW_ReadImage
(oWnd,
"667px-Map_marker.svg.png") oMap := TMapControl
():
New() //oMap:bUrl := {|x,y,z| MapControlGooogleMaps(x,y,z)} //oMap:nMaxZoom := 20 //oMap:bUrl := {|x,y,z| MapControlBing(x,y,z)} //oMap:nMaxZoom := 20 oMap:
SetCenter(13.7,
42.6,
10) bDraw :=
{|hDC,x,y| FW_DrawImage
(hDC, oMarker,
{y
-30,x
-10,y,x
+10},.t.
) } oMap:
AddMarker(13.7025,
42.6582,
30,bDraw
) oWnd:
oClient := oMap
ACTIVATE WINDOW oWnd
*******************************
/// https://wiki.openstreetmap.org/wiki/Sli ... _tilenamesstatic function MapControlOSMMaps
(x,y,z
) LOCAL cUrl
static lastServerUsed:=
0 lastServerUsed+=
1 if lastServerUsed>
3 lastServerUsed:=
1 endif cUrl :=
'https://' +
{"a",
"b",
"c"}[lastServerUsed
] +
'.tile.openstreetmap.org/{z}/{x}/{y}.png' cUrl := StrTran
(cUrl,
"{z}", allTrim
(str
(z
))) cUrl := StrTran
(cUrl,
"{x}", allTrim
(str
(x
))) cUrl := StrTran
(cUrl,
"{y}", allTrim
(str
(y
)))return cUrl
function MapControlGooogleMaps
(x,y,z
) LOCAL cUrl
static lastServerUsed:=
-1 lastServerUsed+=
1 if lastServerUsed>
3 lastServerUsed:=
0 endif cUrl :=
'http://mt'+str
(lastServerUsed,
1)+
'.google.com/vt/lyrs=m&' +
'x={x}&' +
'y={y}&' +
'z={z}&' +
's=Ga' cUrl := StrTran
(cUrl,
"{z}", allTrim
(str
(z
))) cUrl := StrTran
(cUrl,
"{x}", allTrim
(str
(x
))) cUrl := StrTran
(cUrl,
"{y}", allTrim
(str
(y
)))return cUrl
function MapControlBing
(x,y,z
) LOCAL cQuad:=
"", i, n, v
static lastServerUsed:=
-1 lastServerUsed+=
1 if lastServerUsed>
3 lastServerUsed:=
0 endif for i:=z
-1 to 0 step
-1 n := hb_bitShift
(1,i
) v:=
0 if(hb_bitAnd
(x,n
)>
0); v+=
1;
endif if(hb_bitAnd
(y,n
)>
0); v+=
2;
endif cQuad += str
(v,
1) nextreturn "http://ecn.t"+str
(lastServerUsed,
1)+
".tiles.virtualearth.net/tiles/r"+cQuad+
".jpeg?g=414&mkt=en"class TMapControl
FROM TControl
CLASSDATA lRegistered AS LOGICAL
CLASSDATA bUrl as codeBlock
INIT {|x,y,z| MapControlOSMMaps
(x,y,z
) } CLASSDATA nMaxZoom AS NUMERIC
INIT 19 CLASSDATA bDefaultMarkerDraw as CodeBlock
DATA oTimer
DATA aHttps
// Queue of downloading images, array of { "Msxml2.XMLHTTP.6.0", zoom, x, y, Seconds(), cUrl } DATA nZoom, nLat, nLon
// current zoom and center of the screen DATA aMarkers AS ARRAY
INIT {} // Couples of lat+lon to mark on map DATA aImages AS ARRAY
INIT {} // Array of loaded images DATA aTopLeftTileInfo
// Information about tile at top left corner { xpos, ypos, x-tile, y-tile } DATA lastMousePos, lastRenderTime
// mouse down position and seconds of last rendering METHOD New( nRow, nCol, oWnd, nWidth, nHeight
) CONSTRUCTOR
METHOD End
() METHOD Display() INLINE ::
BeginPaint(),::
Paint(),::
EndPaint(),
0 METHOD EraseBkGnd
( ) INLINE 1 METHOD Paint() Method SetCenter
(nLon,nLat,zoom
) Method AddMarker
(nLon,nLat, bDraw
) METHOD RButtonDown
(nRow, nCol, nKeyFlags, lTouch
) METHOD LButtonDown
(nRow, nCol, nKeyFlags, lTouch
) METHOD MouseMove
( nRow, nCol, nKeyFlags
) METHOD MouseWheel
( nKey, nDelta, nXPos, nYPos
) METHOD TimerEvent
() METHOD GetImage
(x,y,zoom,lQueue
) HIDDEN
METHOD GetTileNumber
(lon,lat,pixelSize,zoom
) METHOD GetCoordsFromTile
(x,y,zoom
) METHOD GetCoordsFromPixel
(x,y
) METHOD PaintTile
(hDCMem,hDCBmp,l,t,tx,ty,zoom
) HIDDEN
endclassMETHOD New( nRow, nCol, oWnd, nWidth, nHeight
) CLASS TMapControl
DEFAULT nRow :=
10, nCol :=
10, oWnd := GetWndDefault
() DEFAULT nWidth :=
500 DEFAULT nHeight :=
300 ::
nZoom :=
15 ::
nLon :=
0 ::
nLat :=
0 ::
aMarkers :=
{} ::
oWnd := oWnd
::
nId := ::
GetNewId() ::
nStyle := nOR
( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER
) ::
nTop := nRow
::
nLeft := nCol
::
nBottom := ::
nTop + nHeight -
1 ::
nRight := ::
nLeft + nWidth
::
aHttps :=
{} ::
Register( nOR
( CS_VREDRAW, CS_HREDRAW
) ) if ! Empty
( oWnd:
hWnd ) ::
Create( ) oWnd:
AddControl( Self ) else oWnd:
DefControl( Self ) endif DEFINE TIMER ::
oTimer OF SELF INTERVAL 0.1 ACTION ::
TimerEvent() ::
oTimer:
Activate() if empty
(::
bDefaultMarkerDraw) ::
bDefaultMarkerDraw :=
{|hDC,x,y| MoveTo
(hDC,x
-5,y
-5), LineTo
(hDC,x
+5,y
+5),MoveTo
(hDC,x
-5,y
+5),LineTo
(hDC,x
+5,y
-5) } endifreturn SelfMETHOD End
() class TMapControl
if .not. empty
(::
oTimer) ::
oTimer:
Deactivate() ::
oTimer:
End() endifreturn ::
Super:
End()Method SetCenter
(nLon,nLat,zoom
) class TMapControl
local r :=
{::
nLon,::
nLat} ::
nLon := nLon
::
nLat := nLat
::
nZoom := zoom
return r
Method AddMarker
(nLon,nLat,pixelSize,bDraw
) class TMapControl
default bDraw := ::
bDefaultMarkerDraw default pixelSize :=
5return aAdd
(::
aMarkers,
{nLon,nLat, pixelSize,bDraw
})#define SRCCOPY
13369376METHOD Paint() class TMapControl
LOCAL x,y, img, ix,iy, top,
left, sx,sy, hBmpMem
LOCAL w := ::
nWidth, h := ::
nHeight, hDCMem, hDCBmp
hDCMem = CreateCompatibleDC
( ::
hDC ) hBmpMem = CreateCompatibleBitmap
( ::
hDC, w, h
) SelectObject
( hDCMem, hBmpMem
) FillRect
( hDCMem,
{0,
0,h,w
}, ::
oBrush:
hBrush ) // get tile of center x := ::
GetTileNumber(::
nLon,::
nLat) y := x
[2] x := x
[1] // move the desired pixel in the centre of canvas sx := floor
(x
) sy := floor
(y
) top := h/
2 - int
((y-sy
)*
256) left := w/
2 - int
((x-sx
)*
256) // check for fill all area do while top>
0 sy-=
1 top-=
256 enddo do while left>
0 sx-=
1 left-=
256 enddo // draw the map ::
lastRenderTime := Seconds
() hDCBmp := CreateCompatibleDC
( ::
hDC ) for iy:=
0 to ceiling
((h-top
)/
256) for ix:=
0 to ceiling
((w-
left)/
256) ::
PaintTile(hDCMem,hDCBmp,
left+ix*
256,top+iy*
256 ,sx+ix,sy+iy,::
nZoom) next next DeleteDC
( hDCBmp
) // draw the markers for ix:=
1 to len
(::
aMarkers) x := ::
GetTileNumber(::
aMarkers[ix,
1],::
aMarkers[ix,
2]) y :=
(x
[2] - sy
) *
256 + top
x :=
(x
[1] - sx
) *
256 +
left if x>-::
aMarkers[ix,
3] .and. x<w+::
aMarkers[ix,
3] .and. ;
y>-::
aMarkers[ix,
3] .and. Y<h+::
aMarkers[ix,
3] Eval
(::
aMarkers[ix,
4],hDCMem,x,y
) endif next // save these infos ::
aTopLeftTileInfo :=
{top,
left,sx,sy
} //img := "Queue len: " + alltrim(str(len(::aHttps))) //TextOut( hDCMem, 4, 4, img, Len( img ) ) BitBlt
( ::
hDC,
0,
0, w, h, hDCMem,
0,
0, SRCCOPY
) DeleteDC
(hDCMem
)return nilMETHOD PaintTile
(hDCMem,hDCBmp,l,t,tx,ty,zoom
) LOCAL img, sx,sy, ix, iy, n
img := ::
GetImage(tx,ty,zoom
) if .not. empty
(img
) SelectObject
(hDCBmp, img
) BitBlt
( hDCMem, l,t,
256,
256, hDCBmp,
0,
0, SRCCOPY
) return nil endif // try less zoomed images (if they are not in cache it are not downloaded) img := ::
GetImage(hb_bitShift
(tx,
-1),hb_bitShift
(ty,
-1),zoom
-1,.F.
) if .not. empty
(img
) SelectObject
(hDCBmp, img
) StretchBlt
( hDCMem, l,t,
256,
256, hDCBmp, hb_bitAnd
(tx,
1)*
128,hb_bitAnd
(ty,
1)*
128,
128,
128, SRCCOPY
) return nil endif sx := hb_bitShift
(tx,
1) sy := hb_bitShift
(ty,
1) for iy:=
0 to 1 for ix:=
0 to 1 img := ::
GetImage(sx+ix,sy+iy,zoom
+1,.F.
) if .not. empty
(img
) SelectObject
(hDCBmp, img
) StretchBlt
( hDCMem, l+ix*
128,t+iy*
128,
128,
128, hDCBmp,
0,
0,
255,
255, SRCCOPY
) endif next nextreturn nilMETHOD TimerEvent
() class TMapControl
LOCAL lRedraw := .F., oHttp, img, idx
for idx:=
1 to len
(::
aHttps) oHttp := ::
aHttps[idx
] if oHttp
[1]:
readyState =
4 // downloaded a missing image! img := GDIP_ImageFromStr
(oHttp
[1]:
ResponseBody(), .t., .f.
) if .not. empty
(img
) // correctly created lRedraw := .T.
aAdd
(::
aImages,
{ img, oHttp
[2], oHttp
[3], oHttp
[4] }) endif hb_ADel
(::
aHttps,idx,.t.
) else // stop the unfinisched download that are not relative of current view if oHttp
[5]<::
lastRenderTime oHttp
[1]:
abort() hb_ADel
(::
aHttps,idx,.t.
) endif endif next if lRedraw
::
Refresh() endifreturn nil// directly from OpenStreetMap wikiMETHOD GetTileNumber
(lon,lat,zoom
) class TMapControl
LOCAL x,y,n, latRad
DEFAULT zoom := ::
nZoom n := hb_bitShift
(1, zoom
) latRad := lat * PI
() /
180 x := n *
(lon +
180) /
360 y := n *
(1-
(log
(tan(latRad
) +
1/
cos(latRad
)) / PI
())) /
2 do while(x<
0) x+=n
enddo do while(x>=n
) x-=n
enddo if y<
0 y:=
0 endif if y>=n
y:=n
-1 endifreturn {x,y
}// directly from OpenStreetMap wikiMETHOD GetCoordsFromTile
(x,y,zoom
) class TMapControl
LOCAL lon, lat, n, lat_rad
DEFAULT zoom := ::
nZoom n := hb_bitShift
(1, zoom
) lon = x / n *
360.0 -
180.0 lat_rad =
atan(sinh(PI
() *
(1 -
2 * y / n
))) lat = lat_rad *
180.0 / PI
()return {lon,lat
}// screen to tile, with decimal, using aTopLeftTileInfoMETHOD GetCoordsFromPixel
(x,y
) class TMapControl
LOCAL top := ::
aTopLeftTileInfo[1] LOCAL left := ::
aTopLeftTileInfo[2] LOCAL sx := ::
aTopLeftTileInfo[3] LOCAL sy := ::
aTopLeftTileInfo[4]return ::
GetCoordsFromTile(sx+
(x-
left)/
256,sy+
(y-top
)/
256)METHOD LButtonDown
(nRow, nCol, nKeyFlags, lTouch
) class TMapControl
::
lastMousePos :=
{nRow,nCol
}return ::
Super:
LButtonDown( nRow, nCol, nKeyFlags, lTouch
)METHOD RButtonDown
(nRow, nCol, nKeyFlags, lTouch
) class TMapControl
::
lastMousePos :=
{nRow,nCol
}return ::
Super:
RButtonDown( nRow, nCol, nKeyFlags, lTouch
)METHOD MouseMove
( nRow, nCol, nKeyFlags
) class TMapControl
LOCAL oldMouseCoords,newMouseCoords
if (nKeyFlags<>
1 .and. nKeyFlags<>
2) .or. empty
(::
lastMousePos) return 0 endif oldMouseCoords := ::
GetCoordsFromPixel(::
lastMousePos[2],::
lastMousePos[1]) newMouseCoords := ::
GetCoordsFromPixel(nCol,nRow
) ::
nLon += oldMouseCoords
[1] - newMouseCoords
[1] ::
nLat += oldMouseCoords
[2] - newMouseCoords
[2] ::
lastMousePos :=
{nRow,nCol
} ::
Refresh()return ::
Super:
MouseMove( nRow, nCol, nKeyFlags
)METHOD MouseWheel
( nKey, nDelta, nXPos, nYPos
) class TMapControl
if nDelta>
0 .and. ::
nZoom<::
nMaxZoom ::
nZoom+=
1 endif if nDelta<
0 .and. ::
nZoom>
0 ::
nZoom-=
1 endif ::
Refresh()return ::
Super:
MouseWheel( nKey, nDelta, nXPos, nYPos
)METHOD GetImage
(x,y,zoom,lQueue
) class TMapControl
local n, cUrl, img
LOCAL oHttp
DEFAULT zoom := ::
nZoom DEFAULT lQueue := .T.
x:=int
(x
) y:=int
(y
) // looking for the image in the "cache" n:= aScan
(::
aImages,
{|v| v
[2]=zoom .and. v
[3]=x .and. v
[4]=y
}) if n>
0 // move the last returned image on top of cache img := ::
aImages[n
][1] //aDel(::aImages,n) //::aImages[len(::aImages)] := img return img
endif if .not. lQueue
return nil endif // TODO: Limit cache size if (n:=aScan
(::
aHttps,
{|v| v
[2] = zoom .and. v
[3] = x .and. v
[4] = y
})) >
0 // already in download, update last query time ::
aHttps[n,
5]:=Seconds
() return nil endif cUrl := eval
(::
bUrl, x,y, zoom
) begin sequence
oHttp := win_oleCreateObject
( "Msxml2.XMLHTTP.6.0" ) oHttp:
Open("GET", cUrl, .T.
) oHttp:
Send() if oHttp:
readyState <>
4 if oHttp:
readyState=
1 .or. oHttp:
readyState=
3 aAdd
(::
aHttps,
{ oHttp, zoom, x, y, Seconds
(), cUrl
}) endif else img := GDIP_ImageFromStr
(oHttp:
ResponseBody(), .t., .f.
) if .not. empty
(img
) aAdd
(::
aImages,
{ img, zoom, x, y
}) endif endif end sequence
return img
