Anyway it is not private, it was an experiment, so I re-share this messy and undocumented code:
Code: Select all
#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/Slippy_map_tilenames
static 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)
next
return "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
endclass
METHOD 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) }
endif
return Self
METHOD End() class TMapControl
if .not. empty(::oTimer)
::oTimer:Deactivate()
::oTimer:End()
endif
return ::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 := 5
return aAdd(::aMarkers, {nLon,nLat, pixelSize,bDraw})
#define SRCCOPY 13369376
METHOD 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 nil
METHOD 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
next
return nil
METHOD 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()
endif
return nil
// directly from OpenStreetMap wiki
METHOD 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
endif
return {x,y}
// directly from OpenStreetMap wiki
METHOD 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 aTopLeftTileInfo
METHOD 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
