Experiment: MapControl

Experiment: MapControl

Postby AntoninoP » Thu Apr 19, 2018 1:42 pm

Hello,
some time ago I navigated on this page https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames where are present all information how to access to OpenStreetMap from any application/language.
So during some lunch pauses I created a fiveWin Control, it is only an rough version:

Code: Select all  Expand view  RUN
#include <fivewin.ch>

********** TEST CODE **********
proc main
    LOCAL oWnd, oMap
    DEFINE WINDOW oWnd TITLE "3D objects"
   SetWndDefault(oWnd)
    oMap := TMapControl():New()
   oMap:SetCenter(-4.806640,36.505522)
   oMap:AddMarker(-4.806640,36.505522)
   oWnd:oClient := oMap  
    ACTIVATE WINDOW oWnd
*******************************

/// https://wiki.openstreetmap.org/wiki/Sli ... _tilenames
class TMapControl FROM TControl
    CLASSDATA lRegistered AS LOGICAL
   CLASSDATA aServers AS ARRAY INIT {'https://a.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                     'https://b.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                     'https://c.tile.openstreetmap.org/{zoom}/{x}/{y}.png'}
   CLASSDATA nMaxZoom AS NUMERIC INIT 19
   DATA aHttps, oTimer
   DATA nZoom, nLat, nLon
   DATA nServer
   DATA aMarkers AS ARRAY INIT {}
   DATA aImages AS ARRAY INIT {}
   DATA aTopLeftTileInfo
   DATA lastMousePos

    METHOD New( nRow, nCol, oWnd, nWidth, nHeight ) CONSTRUCTOR
   METHOD End()
    METHOD Display() INLINE ::BeginPaint(),::Paint(),::EndPaint(),0
    METHOD Paint()
   
   Method SetCenter(nLon,nLat)
   Method AddMarker(nLon,nLat)

   METHOD RButtonDown()  
   METHOD LButtonDown()
   METHOD MouseMove()
   METHOD MouseWheel( )

   METHOD TimerEvent()
   
   METHOD GetImage(x,y,zoom) HIDDEN
   METHOD GetTileNumber(lon,lat,zoom)
   METHOD GetCoordsFromTile(x,y,zoom)  
   METHOD GetCoordsFromPixel(x,y)
   
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
   ::nServer := 1
   ::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()
   
   
return Self

METHOD End() class TMapControl
   if .not. empty(::oTimer)
      ::oTimer:Deactivate()
      ::oTimer:End()
   endif
return ::Super:End()

Method SetCenter(nLon,nLat) class TMapControl
   local r := {::nLon,::nLat}
   ::nLon := nLon
   ::nLat := nLat
return r

Method AddMarker(nLon,nLat) class TMapControl
return aAdd(::aMarkers, {nLon,nLat})
   


METHOD Paint() class TMapControl
   LOCAL x,y, img, ix,iy, top, left, t,l, sx, sy
   LOCAL w := ::nWidth,  h := ::nHeight
   // 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
   for iy:=0 to ceiling(h/256)
      for ix:=0 to ceiling(w/256)
         img := ::GetImage(sx+ix,sy+iy)
         if valtype(img)="A" .and. .not. empty(img[1])
            t := top+iy*256
            l := left+ix*256
            FW_DrawImage(::hDC, img, {t,l,t+256,l+256})
         endif
      next
   next
   // 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
      MoveTo(::hDC,x-5,y-5)
      LineTo(::hDC,x+5,y+5)
      MoveTo(::hDC,x-5,y+5)
      LineTo(::hDC,x+5,y-5)
   next
   // save these infos
   ::aTopLeftTileInfo := {top,left,sx,sy}
     
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
         img := FW_ReadImage(Self, oHttp[1]:ResponseBody())
         if .not. empty(img) .and. .not. empty(img)
            lRedraw := .T.
            aAdd(::aImages, { img, oHttp[2], oHttp[3], oHttp[4] })
         endif
         hb_ADel(::aHttps,idx,.t.)
      endif
   next
   
   if lRedraw
      ::Refresh(.F.)
   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
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
      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(.F.)
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(.T.)
return ::Super:MouseWheel( nKey, nDelta, nXPos, nYPos )


METHOD GetImage(x,y,zoom) class TMapControl
   local n, cUrl, img
   LOCAL oHttp
   DEFAULT zoom := ::nZoom
   
   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
      // TODO: move the last returned image on top of cache
      return ::aImages[n][1]
   endif
   // TODO: Limit cache size
   cUrl := ::aServers[::nServer]
   ::nServer++
   if ::nServer>len(::aServers)
      ::nServer:=1
   endif
   cUrl := StrTran(cUrl,"{zoom}", allTrim(str(zoom)))
   cUrl := StrTran(cUrl,"{x}", allTrim(str(x)))
   cUrl := StrTran(cUrl,"{y}", allTrim(str(y)))
   if aScan(::aHttps, {|x| x[5] = cUrl}) > 0
      return nil
   endif
   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, cUrl })
         endif
      else
         img := FW_ReadImage(Self, oHttp:ResponseBody())
         if .not. empty(img) .and. .not. empty(img)
            aAdd(::aImages, { img, zoom, x, y })
         endif
      endif
   end sequence
return img


I think it is pretty cool 8)
AntoninoP
 
Posts: 375
Joined: Tue Feb 10, 2015 9:48 am
Location: Albenga, Italy

Re: Experiment: MapControl

Postby cnavarro » Thu Apr 19, 2018 1:51 pm

Antonino, great work
Congratulations, I think it's a very good contribution
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6549
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: Experiment: MapControl

Postby Otto » Thu Apr 19, 2018 6:26 pm

Hello Antonino,
thank you. This is a great control.
Best regards,
Otto

PS: I had to change win_oleCreateObject to TOLEAuto():New.
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6346
Joined: Fri Oct 07, 2005 7:07 pm

Re: Experiment: MapControl

Postby Silvio.Falconi » Fri Apr 20, 2018 7:17 am

the zoom (wheel mouse) is bad
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7075
Joined: Thu Oct 18, 2012 7:17 pm

Re: Experiment: MapControl

Postby Uwe.Diemer » Fri Apr 20, 2018 12:34 pm

Read the Title

Experiment: MapControl !!!!!
User avatar
Uwe.Diemer
 
Posts: 98
Joined: Mon Aug 09, 2010 11:00 am

Re: Experiment: MapControl

Postby Silvio.Falconi » Fri Apr 20, 2018 1:36 pm

Uwe.Diemer wrote:Read the Title

Experiment: MapControl !!!!!

I meant that the zoom was too slow but this is probably not due to the class of antonino but to the protocol.
I read carefully that it is an experiment I unlike many others I can still read well in fact at my venerable age of 53 years I still do not use glasses while others are covering their eyes with slices of ham!
:D :D :D :D :D :D
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7075
Joined: Thu Oct 18, 2012 7:17 pm

Re: Experiment: MapControl

Postby rhlawek » Fri Apr 20, 2018 2:05 pm

What library contains FW_DrawImage() and FW_ReadImage()? I get unresolved externals for both of these building with 18.02 and haven't been able to find them in the source code.

Robb
User avatar
rhlawek
 
Posts: 194
Joined: Sun Jul 22, 2012 7:01 pm

Re: Experiment: MapControl

Postby AntoninoP » Fri Apr 20, 2018 6:40 pm

it is very strange, they are included in fivewin since 18.01...
AntoninoP
 
Posts: 375
Joined: Tue Feb 10, 2015 9:48 am
Location: Albenga, Italy

Re: Experiment: MapControl

Postby Silvio.Falconi » Sat Apr 21, 2018 6:51 am

Image

Windows 10
Connection Fiber Optical Telecom Italia Business
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7075
Joined: Thu Oct 18, 2012 7:17 pm

Re: Experiment: MapControl

Postby AntoninoP » Mon Apr 23, 2018 12:09 pm

Here a new version.
  • Double buffer during paint
  • Use images of other zoom if the current zoom is not loaded
  • Abort download of image if they are no more necessary

Looks like the principal problem is the performance of Msxml2.XMLHTTP.6.0, does somebody know an alternative? I can do the download with socket, but because it is https I need to use ssl...I already have the code to do it, maybe I will add it...

Here the current code:
Code: Select all  Expand view  RUN
#include <fivewin.ch>

********** TEST CODE **********
proc main
    LOCAL oWnd, oMap
    DEFINE WINDOW oWnd TITLE "3D objects"
    SetWndDefault(oWnd)
    oMap := TMapControl():New()
    oMap:SetCenter(-4.806640,36.505522)
    oMap:AddMarker(-4.806640,36.505522)
    oWnd:oClient := oMap   
    ACTIVATE WINDOW oWnd
*******************************

/// https://wiki.openstreetmap.org/wiki/Sli ... _tilenames
class TMapControl FROM TControl
    CLASSDATA lRegistered AS LOGICAL
    CLASSDATA aServers AS ARRAY INIT {'https://a.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                                 'https://b.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                                 'https://c.tile.openstreetmap.org/{zoom}/{x}/{y}.png'}
    CLASSDATA nMaxZoom AS NUMERIC INIT 19
    DATA aHttps, oTimer
    DATA nZoom, nLat, nLon
    DATA nServer
    DATA aMarkers AS ARRAY INIT {}
    DATA aImages AS ARRAY INIT {}
    DATA aTopLeftTileInfo
    DATA lastMousePos, lastRenderTime

    METHOD New( nRow, nCol, oWnd, nWidth, nHeight ) CONSTRUCTOR
    METHOD End()
    METHOD Display() INLINE ::BeginPaint(),::Paint(),::EndPaint(),0
   METHOD EraseBkGnd( hDC ) INLINE 1
    METHOD Paint()
   
    Method SetCenter(nLon,nLat)
    Method AddMarker(nLon,nLat)

    METHOD RButtonDown()   
    METHOD LButtonDown()
    METHOD MouseMove()
    METHOD MouseWheel( )

    METHOD TimerEvent()
   
    METHOD GetImage(x,y,zoom) HIDDEN
    METHOD GetTileNumber(lon,lat,zoom)
    METHOD GetCoordsFromTile(x,y,zoom) 
    METHOD GetCoordsFromPixel(x,y)
       
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
    ::nServer := 1
    ::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()
   
return Self

METHOD End() class TMapControl
    if .not. empty(::oTimer)
        ::oTimer:Deactivate()
        ::oTimer:End()
    endif
return ::Super:End()

Method SetCenter(nLon,nLat) class TMapControl
    local r := {::nLon,::nLat}
    ::nLon := nLon
    ::nLat := nLat
return r

Method AddMarker(nLon,nLat) class TMapControl
return aAdd(::aMarkers, {nLon,nLat})

#define SRCCOPY 13369376

METHOD Paint() class TMapControl
    LOCAL x,y, img, ix,iy, top, left, t,l, sx,sy,  hBmpMem
    LOCAL w := ::nWidth,  h := ::nHeight, hDCMem, hBmpDB, 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/256)
        for ix:=0 to ceiling(w/256)
         t := top+iy*256
         l := left+ix*256
            img := ::GetImage(sx+ix,sy+iy)
            if valtype(img)="A" .and. .not. empty(img[1])
            SelectObject(hDCBmp, img[1])
            BitBlt( hDCMem, l,t, 256, 256, hDCBmp, 0,0, SRCCOPY )
                //FW_DrawImage(hDCMem, img, {t,l,t+256,l+256})
         else
            // try less zoomed images (if they are not in cache it are not downloaded)
            img := ::GetImage(hb_bitShift((sx+ix),-1),hb_bitShift((sy+iy),-1),::nZoom-1,.F.)
            if valtype(img)="A" .and. .not. empty(img[1])
               SelectObject(hDCBmp, img[1])
               StretchBlt( hDCMem, l,t, 256, 256, hDCBmp, hb_bitAnd((sx+ix),1)*128,hb_bitAnd((sy+iy),1)*128,128,128, SRCCOPY )
            else
               // try more zoomed images (if they are not in cache it are not downloaded)
               img := ::GetImage(hb_bitShift((sx+ix),1),hb_bitShift((sy+iy),1),::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l,t, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
               img := ::GetImage(hb_bitShift((sx+ix),1)+1,hb_bitShift((sy+iy),1),::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l+128,t, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
               img := ::GetImage(hb_bitShift((sx+ix),1),hb_bitShift((sy+iy),1)+1,::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l,t+128, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
               img := ::GetImage(hb_bitShift((sx+ix),1)+1,hb_bitShift((sy+iy),1)+1,::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l+128,t+128, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
             endif
            endif
        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
        MoveTo(hDCMem,x-5,y-5)
        LineTo(hDCMem,x+5,y+5)
        MoveTo(hDCMem,x-5,y+5)
        LineTo(hDCMem,x+5,y-5)
    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 TimerEvent() class TMapControl
    LOCAL lRedraw := .F., oHttp, img, idx
   
    for idx:=1 to len(::aHttps)
        oHttp := ::aHttps[idx]
        if oHttp[1]:readyState = 4
            img := FW_ReadImage(Self, oHttp[1]:ResponseBody())
            if .not. empty(img) .and. .not. empty(img)
                lRedraw := .T.
                aAdd(::aImages, { img, oHttp[2], oHttp[3], oHttp[4] })
            endif
            hb_ADel(::aHttps,idx,.t.)
      else
         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
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
    cUrl := ::aServers[::nServer]
    ::nServer++
    if ::nServer>len(::aServers)
        ::nServer:=1
    endif
    cUrl := StrTran(cUrl,"{zoom}", allTrim(str(zoom)))
    cUrl := StrTran(cUrl,"{x}", allTrim(str(x)))
    cUrl := StrTran(cUrl,"{y}", allTrim(str(y)))
    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
    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 := FW_ReadImage(Self, oHttp:ResponseBody())
            if .not. empty(img) .and. .not. empty(img)
                aAdd(::aImages, { img, zoom, x, y })
            endif
        endif
    end sequence
return img
AntoninoP
 
Posts: 375
Joined: Tue Feb 10, 2015 9:48 am
Location: Albenga, Italy

Re: Experiment: MapControl

Postby cnavarro » Mon Apr 23, 2018 1:39 pm

Antonino, I do not know if this code will serve your purpose

Code: Select all  Expand view  RUN

#include <fivewin.ch>
//#include "hbcurl.ch"

#ifndef HBCURL_CH_

#define HB_CURLOPT_FILE                  1
#define HB_CURLOPT_URL                   2
#define HB_CURLOPT_ERRORBUFFER          10
#define HB_CURLOPT_CUSTOMREQUEST        36
#define HB_CURLOPT_FAILONERROR          45
#define HB_CURLOPT_FOLLOWLOCATION       52
#define HB_CURLOPT_TRANSFERTEXT         53
#define HB_CURLOPT_SSL_VERIFYPEER       64
#define HB_CURLOPT_CONNECTTIMEOUT       78
#define HB_CURLOPT_SSL_VERIFYHOST       81
#define HB_CURLOPT_BUFFERSIZE           98
#define HB_CURLOPT_RETURNTRANSFER       500
#define HB_CURLOPT_DOWNLOAD             1001
#define HB_CURLOPT_PROGRESSBLOCK        1002
#define HB_CURLOPT_DL_BUFF_SETUP        1008

#endif


REQUEST __HBEXTERN__HBSSL__

********** TEST CODE **********
proc main
    LOCAL oWnd, oMap
    DEFINE WINDOW oWnd TITLE "3D objects"
    SetWndDefault(oWnd)
    oMap := TMapControl():New()
    oMap:SetCenter(-4.806640,36.505522)
    oMap:AddMarker(-4.806640,36.505522)
    oWnd:oClient := oMap    
    ACTIVATE WINDOW oWnd
*******************************

/// https://wiki.openstreetmap.org/wiki/Sli ... _tilenames
class TMapControl FROM TControl
    CLASSDATA lRegistered AS LOGICAL
    CLASSDATA aServers AS ARRAY INIT {'https://a.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                                 'https://b.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                                 'https://c.tile.openstreetmap.org/{zoom}/{x}/{y}.png'}
    CLASSDATA nMaxZoom AS NUMERIC INIT 19
    DATA aHttps, oTimer
    DATA nZoom, nLat, nLon
    DATA nServer
    DATA aMarkers AS ARRAY INIT {}
    DATA aImages AS ARRAY INIT {}
    DATA aTopLeftTileInfo
    DATA lastMousePos, lastRenderTime

    METHOD New( nRow, nCol, oWnd, nWidth, nHeight ) CONSTRUCTOR
    METHOD End()
    METHOD Display() INLINE ::BeginPaint(),::Paint(),::EndPaint(),0
   METHOD EraseBkGnd( hDC ) INLINE 1
    METHOD Paint()
   
    Method SetCenter(nLon,nLat)
    Method AddMarker(nLon,nLat)

    METHOD RButtonDown()    
    METHOD LButtonDown()
    METHOD MouseMove()
    METHOD MouseWheel( )

    METHOD TimerEvent()
   
    METHOD GetImage(x,y,zoom) HIDDEN
    METHOD GetTileNumber(lon,lat,zoom)
    METHOD GetCoordsFromTile(x,y,zoom)  
    METHOD GetCoordsFromPixel(x,y)

    METHOD GetMyImg(x,y,zoom,lQueue)

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
    ::nServer := 1
    ::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()
   
return Self

METHOD End() class TMapControl
    if .not. empty(::oTimer)
        ::oTimer:Deactivate()
        ::oTimer:End()
    endif
return ::Super:End()

Method SetCenter(nLon,nLat) class TMapControl
    local r := {::nLon,::nLat}
    ::nLon := nLon
    ::nLat := nLat
return r

Method AddMarker(nLon,nLat) class TMapControl
return aAdd(::aMarkers, {nLon,nLat})

#define SRCCOPY 13369376

METHOD Paint() class TMapControl
    LOCAL x,y, img, ix,iy, top, left, t,l, sx,sy,  hBmpMem
    LOCAL w := ::nWidth,  h := ::nHeight, hDCMem, hBmpDB, 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/256)
        for ix:=0 to ceiling(w/256)
         t := top+iy*256
         l := left+ix*256
            //img := ::GetImage(sx+ix,sy+iy)
            img := ::GetMyImg(sx+ix,sy+iy)
            if valtype(img)="A" .and. .not. empty(img[1])
            SelectObject(hDCBmp, img[1])
            BitBlt( hDCMem, l,t, 256, 256, hDCBmp, 0,0, SRCCOPY )
                //FW_DrawImage(hDCMem, img, {t,l,t+256,l+256})
         else
            // try less zoomed images (if they are not in cache it are not downloaded)
            //img := ::GetImage(hb_bitShift((sx+ix),-1),hb_bitShift((sy+iy),-1),::nZoom-1,.F.)
            img := ::GetMyImg(hb_bitShift((sx+ix),-1),hb_bitShift((sy+iy),-1),::nZoom-1,.F.)
            if valtype(img)="A" .and. .not. empty(img[1])
               SelectObject(hDCBmp, img[1])
               StretchBlt( hDCMem, l,t, 256, 256, hDCBmp, hb_bitAnd((sx+ix),1)*128,hb_bitAnd((sy+iy),1)*128,128,128, SRCCOPY )
            else
               // try more zoomed images (if they are not in cache it are not downloaded)
               //img := ::GetImage(hb_bitShift((sx+ix),1),hb_bitShift((sy+iy),1),::nZoom+1,.F.)
               img  := ::GetMyImg(hb_bitShift((sx+ix),1),hb_bitShift((sy+iy),1),::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l,t, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
               //img := ::GetImage(hb_bitShift((sx+ix),1)+1,hb_bitShift((sy+iy),1),::nZoom+1,.F.)
               img := ::GetMyImg(hb_bitShift((sx+ix),1)+1,hb_bitShift((sy+iy),1),::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l+128,t, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
               //img := ::GetImage(hb_bitShift((sx+ix),1),hb_bitShift((sy+iy),1)+1,::nZoom+1,.F.)
               img  := ::GetMyImg( hb_bitShift((sx+ix),1),hb_bitShift((sy+iy),1)+1,::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l,t+128, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
               //img := ::GetImage(hb_bitShift((sx+ix),1)+1,hb_bitShift((sy+iy),1)+1,::nZoom+1,.F.)
               img := ::GetMyImg( hb_bitShift((sx+ix),1)+1,hb_bitShift((sy+iy),1)+1,::nZoom+1,.F.)
               if valtype(img)="A" .and. .not. empty(img[1])
                  SelectObject(hDCBmp, img[1])
                  StretchBlt( hDCMem, l+128,t+128, 128, 128, hDCBmp, 0,0,255,255, SRCCOPY )
               endif            
             endif
            endif
        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
        MoveTo(hDCMem,x-5,y-5)
        LineTo(hDCMem,x+5,y+5)
        MoveTo(hDCMem,x-5,y+5)
        LineTo(hDCMem,x+5,y-5)
    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 TimerEvent() class TMapControl
    LOCAL lRedraw := .F., oHttp, img, idx
   
    for idx:=1 to len(::aHttps)
        oHttp := ::aHttps[idx]
        if oHttp[1]:readyState = 4
            img := FW_ReadImage(Self, oHttp[1]:ResponseBody())
            if .not. empty(img) .and. .not. empty(img)
                lRedraw := .T.
                aAdd(::aImages, { img, oHttp[2], oHttp[3], oHttp[4] })
            endif
            hb_ADel(::aHttps,idx,.t.)
      else
         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
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
    cUrl := ::aServers[::nServer]
    ::nServer++
    if ::nServer>len(::aServers)
        ::nServer:=1
    endif
    cUrl := StrTran(cUrl,"{zoom}", allTrim(str(zoom)))
    cUrl := StrTran(cUrl,"{x}", allTrim(str(x)))
    cUrl := StrTran(cUrl,"{y}", allTrim(str(y)))
    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
    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 := FW_ReadImage(Self, oHttp:ResponseBody())
            if .not. empty(img) .and. .not. empty(img)
                aAdd(::aImages, { img, zoom, x, y })
            endif
        endif
    end sequence
return img

//----------------------------------------------------------------------------//

METHOD GetMyImg(x,y,zoom,lQueue) class TMapControl

    local n
    local cUrl
    local img
    local oHttp
    local cResult
    local cErrorB
    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
    cUrl := ::aServers[::nServer]
    ::nServer++
    if ::nServer>len(::aServers)
        ::nServer:=1
    endif
    cUrl := StrTran(cUrl,"{zoom}", allTrim(str(zoom)))
    cUrl := StrTran(cUrl,"{x}", allTrim(str(x)))
    cUrl := StrTran(cUrl,"{y}", allTrim(str(y)))
    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_global_init()
   oHttp := curl_easy_init()
   
   If !empty( oHttp )
     curl_easy_setopt( oHttp,  HB_CURLOPT_URL, cUrl )
     curl_easy_setopt( oHttp,  HB_CURLOPT_RETURNTRANSFER, 1 )
     curl_easy_setopt( oHttp,  HB_CURLOPT_SSL_VERIFYHOST, 0 )
     curl_easy_setopt( oHttp,  HB_CURLOPT_SSL_VERIFYPEER, 0 )
     curl_easy_setopt( oHttp,  HB_CURLOPT_DL_BUFF_SETUP )
     curl_easy_setopt( oHttp,  HB_CURLOPT_FAILONERROR, 1 )
     curl_easy_setopt( oHttp,  HB_CURLOPT_ERRORBUFFER, cErrorB )
     cResult := curl_easy_perform( oHttp )
   
     if cResult = 0
            img := FW_ReadImage(Self, curl_easy_dl_buff_get( oHttp ) )
            if .not. empty(img) .and. .not. empty(img)
                aAdd(::aImages, { img, zoom, x, y })
            endif
     else
        ? cResult
        MsgInfo( curl_easy_strerror( cResult ), "Error: " + cErrorB )
     endif
   
   endif
   
   curl_easy_reset( oHttp )
   curl_easy_cleanup( oHttp )
   curl_global_cleanup()
   oHttp   := nil

Return img

//----------------------------------------------------------------------------//

 
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6549
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: Experiment: MapControl

Postby Silvio.Falconi » Wed Mar 20, 2019 8:11 am

Antonino,

How found coordinates ?
I tried this website https://www.openstreetmap.org/export#map=12/42.6581/13.6989&layers=NDG
but then when I put the coordinates it show me another point of the globe
then How create a line route on the map ?
sample : Rome->Ostia
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7075
Joined: Thu Oct 18, 2012 7:17 pm

Re: Experiment: MapControl

Postby nageswaragunupudi » Wed Mar 20, 2019 8:44 am

This is very good.
But as a user from India, it is not of much use for us. This is still not as universally useful as Google. For all practical purposes, we still need Google. The same may be the case with many countries.
Regards

G. N. Rao.
Hyderabad, India
User avatar
nageswaragunupudi
 
Posts: 10656
Joined: Sun Nov 19, 2006 5:22 am
Location: India

Re: Experiment: MapControl

Postby AntoninoP » Wed Mar 20, 2019 10:43 am

The conversion street -> lat long is a problem.
OpenStreetMap uses nominatim that has an API too.
There is other free geolocation services, but I did not try them so much.

I take this opportunity to put the updated code in this thread :)
Code: Select all  Expand view  RUN
#include <fivewin.ch>

********** TEST CODE **********
proc main
    LOCAL oWnd, oMap
    DEFINE WINDOW oWnd TITLE "3D objects"
    SetWndDefault(oWnd)
    oMap := TMapControl():New()
    oMap:SetCenter(-4.806640,36.505522)
    oMap:AddMarker(-4.806640,36.505522)
    oWnd:oClient := oMap    
    ACTIVATE WINDOW oWnd
*******************************

/// https://wiki.openstreetmap.org/wiki/Sli ... _tilenames
class TMapControl FROM TControl
    CLASSDATA lRegistered AS LOGICAL
    CLASSDATA aServers AS ARRAY INIT {'https://a.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                                 'https://b.tile.openstreetmap.org/{zoom}/{x}/{y}.png', ;
                                                 'https://c.tile.openstreetmap.org/{zoom}/{x}/{y}.png'}
    CLASSDATA nMaxZoom AS NUMERIC INIT 19
    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 nServer            // Last used server Id (from aServers)
    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)
    Method AddMarker(nLon,nLat)

    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,zoom)
    METHOD GetCoordsFromTile(x,y,zoom)  
    METHOD GetCoordsFromPixel(x,y)
   
   METHOD PaintTile(hDCMem,hDCBmp,l,t,tx,ty,zoom)
       
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
    ::nServer := 1
    ::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()
   
return Self

METHOD End() class TMapControl
    if .not. empty(::oTimer)
        ::oTimer:Deactivate()
        ::oTimer:End()
    endif
return ::Super:End()

Method SetCenter(nLon,nLat) class TMapControl
    local r := {::nLon,::nLat}
    ::nLon := nLon
    ::nLat := nLat
return r

Method AddMarker(nLon,nLat) class TMapControl
return aAdd(::aMarkers, {nLon,nLat})

#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
        MoveTo(hDCMem,x-5,y-5)
        LineTo(hDCMem,x+5,y+5)
        MoveTo(hDCMem,x-5,y+5)
        LineTo(hDCMem,x+5,y-5)
    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
    cUrl := ::aServers[::nServer]
    ::nServer++
    if ::nServer>len(::aServers)
        ::nServer:=1
    endif
    cUrl := StrTran(cUrl,"{zoom}", allTrim(str(zoom)))
    cUrl := StrTran(cUrl,"{x}", allTrim(str(x)))
    cUrl := StrTran(cUrl,"{y}", allTrim(str(y)))
    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
    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
AntoninoP
 
Posts: 375
Joined: Tue Feb 10, 2015 9:48 am
Location: Albenga, Italy

Re: Experiment: MapControl

Postby Silvio.Falconi » Wed Mar 20, 2019 5:56 pm

Antonino,

I saw there is an error because Now I try to inverte the coordinates and I found my city

with oMap:SetCenter(13.7025,42.6582)

on https://www.openstreetmap.org/export#map=16/42.6572/13.7015

on this box

Image

How I can make a router sample :
https://www.openstreetmap.org/way/27972081#map=12/42.7093/13.6910
or
https://www.openstreetmap.org/way/27972119


then when I draw a Marker it draw X ..

How insert a marker as this ?

Image


then If I have a city,address ( of customer) how I can search with your classs the city ?

I tried with sample
https://nominatim.openstreetmap.org/sea ... rio+veneto
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7075
Joined: Thu Oct 18, 2012 7:17 pm

Next

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 37 guests