PBMap - Cartes OSM, Here, Geoserver dans un Canvas

Programmation d'applications complexes
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

PBMap - Cartes OSM, Here, Geoserver dans un Canvas

Message par Thyphoon »

*** PBMap ***

Description
PBMap est un module servant à l'intégration de cartes telles que OpenStreetMap, Here, Geoserver/geocache dans un gadget de type Canvas. Le projet est basé sur le code de Progi1984 et d'autres.

Utilisation
Le programme de démonstration dans demo.pb affiche une fenêtre avec le gadget pbmap fonctionnel permettant :
  • le déplacement à la souris, (cliquer/déplacer, roulette pour zoomer, double-clic),
  • le redimensionnement,
  • la pose et le déplacement de balises (avec l'édition en cliquant sur le bouton edit mode et double clic),
  • la lecture, le dessin et la sélection de fichiers GPX, la sauvegarde (partielle)
  • l'affichage de calques avec les services OpenSea, vue aérienne HERE, Geoserver (représentation type google maps, voir http://geowebcache.org/docs/current/services/gmaps.html)
  • la recherche par adresse.
Il supporte les proxys.

Le programme Multiple-PBMaps-Demo.pb montre comment utiliser plusieurs gadgets pbmap dans vos projets.

Version
0.91 (PB 5.60 mini), versions plus anciennes disponible sur le dépôt.
Ce programme est en version beta, l'utilisation est de votre responsabilité.

Téléchargement
Etant donné que le développement est toujours en cours, vous trouverez les fichiers sources ici : https://github.com/djes/PBMap

Participer
N'importe qui peut participer au projet, n'hésitez pas à poster vos démos et vos améliorations. Vous pouvez également disposer d'un accès GIT pour pouvoir faire vos tests et vos intégrations directement dans le code source.
Actuellement, le dépôt est maintenu par Thyphoon (qui a lancé le projet), djes et a reçu des contributions d'Idle.

Copyright
Auteurs : Thyphoon, djes, Idle, yves86
Merci : Progi1984, falsam, fred et l'équipe de Fantaisie Software
PBMap est open source, sentez-vous libre de l'utiliser comme bon vous semble, crédits et remerciements appréciés.
OpenStreetMap : https://www.openstreetmap.org/copyright

Image

-------------------------------

Ci-dessous, pour mémoire


Bonjour,

Voilà déjà plusieurs mois que je bosse sur un gros projet que j'éspère bientôt pouvoir partager avec vous.
ça fait déjà quelques semaines que je bosse pour ce projet a intégré une carte OpenStreetMap. Le but étant au final d'avoir la simplicité d'utilisation d'un google Map. d'afficher des points et de les déplacer sur cette même carte, mais aussi l'affichage de fichier GPX. Au départ j'ai fait mes propres tentative et ça n'a pas donné grand chose. Et j'ai découvert que Progi1984 c'était penché sur le problème donc depuis 2 jours je torture son code.
j'ai essayé de reprendre son travail et de le modifier pour l'intégré dans un canvas voici ou j'en suis. Le code est pas super propre c'est vraiment du bidouillage pour l'instant mais si j'arrive a faire fonctionner ça je ferais un module propre.
Mon souci actuellement est lorsque je fais glisser la carte de plus d'une case... en rafraîchissant il en saute une ... mais je vois pas pourquoi. Si quelqu'un a une idée ...
Je mettrai le code a jour ici au fur et a mesure.

Code : Tout sélectionner

#USEPROXY=#False
UsePNGImageDecoder()
UsePNGImageEncoder()
CompilerIf #USEPROXY=#True
  IncludeFile("C:\Users\lebrun_y_413\Documents\Developpement\Purebasic\includes Share\http.pbi")
CompilerEndIf

EnableExplicit
InitNetwork()
UsePNGImageDecoder()
UseSQLiteDatabase()

Structure osm
  gfLatitude.d   ;49.0422777
  gfLongitude.d  ;2.035566
  gfxTile.d
  gfyTile.d
  glZoom.l       ;= 17
  
  sName.s
  sURL.s
  lZoomMin.l
  lZoomMax.l
  
  cachePath.S
  
  StartCursorX.l
  StartCursorY.l
  DeltaCursorX.l
  DeltaCursorY.l
EndStructure

Global osm.osm
osm\gfLatitude   = 49.04599
osm\gfLongitude  = 2.03347
osm\glZoom       = 17

osm\sName="OSM Mapnik"
osm\sURL="http://tile.openstreetmap.org/"
osm\lZoomMin=0
osm\lZoomMax=18

osm\cachePath.s=GetTemporaryDirectory()

;@desc Permits to translate XY Coordinates to Lon/Lat Coordinates
;@author Progi1984
Procedure OSM_LatLon2XY()
  Protected n.l = Pow(2, osm\glZoom)
  osm\gfxTile = (((osm\gfLongitude + 180) / 360) * n)
  osm\gfyTile = ((1-(Log(Tan(osm\gfLatitude * #PI / 180)+(1/Cos(osm\gfLatitude*#PI/180)))/#PI))/2*n)
EndProcedure
;@desc Permits to translate Lon/Lat Coordinates to XY Coordinates
;@author Progi1984
Procedure OSM_XY2LatLon()
  Protected n.l = Pow(2, osm\glZoom)
  Protected pfLatitudeRad.f
  osm\gfLongitude   = osm\gfxTile / n * 360.0 - 180.0
  pfLatitudeRad = ATan(SinH(#PI * (1 - 2 * osm\gfyTile / n)))
  osm\gfLatitude    = pfLatitudeRad * 180.0 / #PI
  
EndProcedure

Procedure OSM_GetImage(Image.l, Zoom.l, XTile.l, YTile.l)
  Protected plMemory.l
  Protected psURL.s = osm\sURL+Str(Zoom)+"/"+Str(XTile)+"/"+Str(YTile)+".png"
  Protected plImageSize.l
  Protected plImageMem.l
  Protected psSQLRequest.s
  Protected pbImageOK.b
  Protected plRes.l
  ; Test if in cache else download it
  Protected cacheFile.s="OSM_"+Str(Zoom)+"_"+Str(XTile)+"_"+Str(YTile)+".png"
  ;Debug osm\cachePath+cacheFile
  If FileSize(osm\cachePath+cacheFile)>0
    ;Debug "Use Cache :"+cacheFile
    LoadImage(Image,osm\cachePath+cacheFile)
  Else 
    ;Debug "DOWNLOAD : "+psURL
    CompilerIf #USEPROXY=#True
      Protected http.HTTP_Query
      HTTP_proxy(@http,"spxy.bpi.fr",3128)
      HTTP_DownloadToMem(@http,psURL)
      If IsImage(image)
        FreeImage(image)
      EndIf
      If CatchImage(image, http\data, MemorySize(http\data))
        SaveImage(image,osm\cachePath+cacheFile,#PB_ImagePlugin_PNG)
      EndIf
    CompilerElse
      plMemory = ReceiveHTTPMemory(psURL)
      If IsImage(Image)
        FreeImage(Image)
      EndIf
      If CatchImage(Image, plMemory, MemorySize(plMemory))
        SaveImage(image,osm\cachePath+cacheFile,#PB_ImagePlugin_PNG)
        FreeMemory(plMemory)
      EndIf
    CompilerEndIf
    
  EndIf
  
EndProcedure


Procedure OSM_GetSquareTile()
  Protected x.l,y.l,nx.l,ny.l,mx.l,my.l,n.l=0,tx.l,ty.l
  nx=Round(512/256,#PB_Round_Up ):
  ny=Round(512/256,#PB_Round_Up ):
  For x=0 To nx
    For y=0 To ny
      tx=x-Int(nx/2)
      ty=y-Int(ny/2)
      OSM_GetImage(n, osm\glZoom+1,Int(2*osm\gfxTile+tx)  ,Int(2*osm\gfyTile+ty))
      n=n+1
    Next
  Next
EndProcedure

Procedure drawmap()
  Protected x.l,y.l,nx.l,ny.l,mx.l,my.l,n.l=0
  Protected deltaX.l,deltaY.l
  Protected cx.l,cy.l,tx.l,ty.l
  deltaX=512*(osm\gfxTile-Int(osm\gfxTile))-256
  deltaY=512*(osm\gfyTile-Int(osm\gfyTile))-256
  nx=Round(512/256,#PB_Round_Up ):
  ny=Round(512/256,#PB_Round_Up ):
  Box(0,0,512,512,RGB(255,255,255))
  cx=512/2
  cy=512/2
  For x=0 To nx
    For y=0 To ny
      tx=(x-Int(nx/2))*256-deltaX+osm\DeltaCursorX
      ty=(y-Int(ny/2))*256-deltaY+osm\DeltaCursorY
      If IsImage(n):DrawImage(ImageID(n), tx, ty, 254, 254):EndIf
      DrawText( tx,ty,Str(x-Int(nx/2))+","+Str(y-Int(ny/2)))
      n=n+1
    Next
  Next
  Circle(256,256,5,#Red)
  DrawText(0,0,"DeltaCursorX:"+Str(osm\DeltaCursorX)+" deltaX:"+Str(deltaX)+" gfxTile:"+StrD(osm\gfxTile))
EndProcedure

Procedure move(tx.d,ty.d)
  Debug "-move-"
  Debug tx
  Debug osm\gfxTile
  Protected l.l,pfValue.f
  If tx<>0
      pfValue = osm\gfxTile - tx
      If pfValue > Pow(2, osm\glZoom) - 1
        osm\gfxTile = Pow(2, osm\glZoom) - 2
      ElseIf pfValue < 0 
        osm\gfxTile = Pow(2, osm\glZoom) - 2
      Else
        osm\gfxTile = pfValue
     
      EndIf
    EndIf
    
      If ty<>0
      pfValue = osm\gfyTile - ty
 If pfValue > Pow(2, osm\glZoom) - 1
                osm\gfyTile = Pow(2, osm\glZoom) - 2
      ElseIf pfValue < 0 
                osm\gfyTile = Pow(2, osm\glZoom) - 2
      Else
        osm\gfyTile = pfValue
     
      EndIf
    EndIf
    
 
    Debug osm\gfxTile
    OSM_GetSquareTile()
    OSM_XY2LatLon()
 
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  
  
  Enumeration
    #Window_0
    #Map
    #Button_0
    #Button_1
    #Button_2
    #Button_3
    #Button_4
    #Button_5
    #Combo_0
    #Text_0
    #Text_1
    #Text_2
    #Text_3
    #Text_4
    #String_0
    #String_1
  EndEnumeration
  
  
  
  If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    LoadFont(0,"Wingdings",12)
    LoadFont(1,"Arial",12,#PB_Font_Bold)
    
    
    CanvasGadget(#Map,10,10,512,512)
    
    TextGadget(#Text_1, 530, 50, 60, 15, "Movements :")
    ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7))  : SetGadgetFont(#Button_0, FontID(0)) 
    ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8))  : SetGadgetFont(#Button_1, FontID(0)) 
    ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9))  : SetGadgetFont(#Button_2, FontID(0)) 
    ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA))  : SetGadgetFont(#Button_3, FontID(0)) 
    TextGadget(#Text_2, 530, 160, 60, 15, "Zoom :")
    ButtonGadget(#Button_4, 550, 180, 50, 30, "+")      : SetGadgetFont(#Button_4, FontID(1)) 
    ButtonGadget(#Button_5, 600, 180, 50, 30, "-")      : SetGadgetFont(#Button_5, FontID(1)) 
    TextGadget(#Text_3, 530, 230, 60, 15, "Latitude :")
    StringGadget(#String_0, 600, 230, 90, 20, StrD(osm\gfLatitude))
    TextGadget(#Text_4, 530, 250, 60, 15, "Longitude :")
    StringGadget(#String_1, 600, 250, 90, 20, StrD(osm\gfLongitude))
    
    Define Event.l,Gadget.l,Quit.b=#False
    Define pfValue.f
    OSM_LatLon2XY()
    OSM_GetSquareTile()
    StartDrawing(CanvasOutput(#Map))
    drawmap()
    StopDrawing()
    
    Repeat
      Event = WaitWindowEvent()
      Select Event
        Case #PB_Event_CloseWindow : Quit = 1
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case #Button_0 ;{ To left
              pfValue = osm\gfxTile - 0.5
              If pfValue < 0 
                osm\gfxTile = Pow(2, osm\glZoom) - 2
              Else
                osm\gfxTile = pfValue
              EndIf
              OSM_GetSquareTile()
              OSM_XY2LatLon()
              SetGadgetText(#String_1, StrD(osm\gfLongitude))
              ;}
            Case #Button_1 ;{ To Right
              Debug osm\gfxTile
              pfValue = osm\gfxTile + 0.5
              If pfValue > Pow(2, osm\glZoom) - 1
                osm\gfxTile = Pow(2, osm\glZoom) - 2
              Else
                osm\gfxTile = pfValue
              EndIf
              Debug osm\gfxTile
              OSM_GetSquareTile()
              OSM_XY2LatLon()
              SetGadgetText(#String_1, StrD(osm\gfLongitude))
              ;}
            Case #Button_2 ;{ To Top
              pfValue = osm\gfyTile - 0.5
              If pfValue < 0 
                osm\gfyTile = Pow(2, osm\glZoom) - 2
              Else
                osm\gfyTile = pfValue
              EndIf
              OSM_GetSquareTile()
              OSM_XY2LatLon()
              SetGadgetText(#String_0, StrD(osm\gfLatitude))
              ;}
            Case #Button_3 ;{ To Bottom
              pfValue = osm\gfyTile + 0.5
              If pfValue > Pow(2, osm\glZoom) - 1
                osm\gfyTile = Pow(2, osm\glZoom) - 2
              Else
                osm\gfyTile = pfValue
              EndIf
              
              OSM_GetSquareTile()
              OSM_XY2LatLon()
              SetGadgetText(#String_0, StrD(osm\gfLatitude))
              ;}
            Case #Button_4 ;{ Zoom +
              If osm\glZoom < osm\lZoomMax
                osm\glZoom + 1
                OSM_LatLon2XY()
                OSM_GetSquareTile()
              EndIf
              ;}
            Case #Button_5 ;{ Zoom -
              If osm\glZoom > osm\lZoomMin
                osm\glZoom - 1
                OSM_LatLon2XY()
                OSM_GetSquareTile()
              EndIf
              ;}
              ;           Case #Image_0 ;{
              ;             gfxTile = 2*gfxTile  
              ;             gfyTile = 2*gfyTile
              ;             glZoom + 1
              ;             OSM_XY2LatLon()
              ;             OSM_GetSquareTile()
              ;           ;}
              ;           Case #Image_1 ;{
              ;             gfxTile = 2*gfxTile  +1
              ;             gfyTile = 2*gfyTile
              ;             glZoom + 1
              ;             OSM_XY2LatLon()
              ;             OSM_GetSquareTile()
              ;           ;}
              ;           Case #Image_2 ;{
              ;             gfxTile = 2*gfxTile  
              ;             gfyTile = 2*gfyTile+1
              ;             glZoom + 1
              ;             OSM_XY2LatLon()
              ;             OSM_GetSquareTile()
              ;           ;}
              ;           Case #Image_3 ;{
              ;             gfxTile = 2*gfxTile  +1
              ;             gfyTile = 2*gfyTile+1
              ;             glZoom + 1
              ;             OSM_XY2LatLon()
              ;             OSM_GetSquareTile()
              ;             ;}
            Case #String_0,#String_1
              osm\gfLatitude=ValD(GetGadgetText(#String_0))
              osm\gfLongitude=ValD(GetGadgetText(#String_1))
              OSM_LatLon2XY()
              OSM_GetSquareTile()
            Case #Map
              Select  EventType()
                Case #PB_EventType_LeftButtonDown 
                  osm\StartCursorX=GetGadgetAttribute(#Map, #PB_Canvas_MouseX)
                  osm\StartCursorY=GetGadgetAttribute(#Map, #PB_Canvas_MouseY)
                Case #PB_EventType_MouseMove 
                  If osm\StartCursorX<>0 And osm\StartCursorY<>0
                    osm\DeltaCursorX=GetGadgetAttribute(#Map, #PB_Canvas_MouseX)-osm\StartCursorX
                    osm\DeltaCursorY=GetGadgetAttribute(#Map, #PB_Canvas_MouseY)-osm\StartCursorY
                  EndIf 
                Case #PB_EventType_LeftButtonUp
                  Define tx.d,ty.d
                  tx=(osm\DeltaCursorX/512)
                  ty=(osm\DeltaCursory/512)
                  osm\StartCursorY=0
                  osm\StartCursorX=0
                  osm\DeltaCursorX=0
                  osm\DeltaCursorY=0
                  Debug tx
                  move(tx,ty)
                  SetGadgetText(#String_1, StrD(osm\gfLongitude))
                  SetGadgetText(#String_0, StrD(osm\gfLatitude))
              EndSelect
          EndSelect
          StartDrawing(CanvasOutput(#Map))
          drawmap()
          StopDrawing()
          ;}
      EndSelect
    Until Quit = #True
    
    
    
  EndIf
  
CompilerEndIf
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

ça ne marche pas mieux, mais voilà un code plus claire ...

Code : Tout sélectionner

DeclareModule OSM
  Declare InitOSM()
  Declare OSMGadget(Gadget.i,X.l,Y.l,Width.l,Height.l)
  Declare Event(Event.l)
  Declare SetLocation(latitude.d,longitude.d,zoom=15)
  Declare DrawMap()
  Declare SetZoom(Zoom.l,mode.l=#PB_Relative)
EndDeclareModule

Module OSM
  #USEPROXY=#False
  UsePNGImageDecoder()
  UsePNGImageEncoder()
  
  CompilerIf #USEPROXY=#True
      IncludeFile("C:\Users\lebrun_y_413\Documents\Developpement\Purebasic\includes Share\http.pbi")
  CompilerEndIf
  
  Structure Location
    Longitude.d
    Latitude.d
  EndStructure
  
  Structure Tile
    X.f
    Y.f
  EndStructure
  
  Structure Pixel
    X.l
    Y.l
  EndStructure
  
  Structure OSM
    Gadget.i
    TargetLocation.Location
    TargetTile.tile
    
  ServerURL.s
  ZoomMin.l
  ZoomMax.l
  Zoom.l
  
  CachePath.S
  
  StartCursor.Pixel
  DeltaCursor.Pixel
EndStructure

Global OSM.OSM

Procedure InitOSM()
  OSM\CachePath=GetTemporaryDirectory()
  OSM\ServerURL="http://tile.openstreetmap.org/"
  OSM\ZoomMin=0
  OSM\ZoomMax=18
EndProcedure

Procedure OSMGadget(Gadget.i,X.l,Y.l,Width.l,Height.l)
  If Gadget=#PB_Any
    OSM\Gadget=CanvasGadget(OSM\Gadget,X,Y,Width,Height)
  Else
  OSM\Gadget=Gadget
  CanvasGadget(OSM\Gadget,X,Y,Width,Height)
  EndIf 
EndProcedure



Procedure LatLon2XY(*Location.Location,*Tile.Tile)
  Protected n.l = Pow(2, OSM\Zoom)
  *Tile\X = (((*Location\Longitude + 180) / 360) * n)
  *Tile\Y = ((1-(Log(Tan(*Location\Latitude * #PI / 180)+(1/Cos(*Location\Latitude*#PI/180)))/#PI))/2*n)
EndProcedure

Procedure XY2LatLon(*Tile.Tile,*Location.Location)
  Protected n.l = Pow(2, OSM\Zoom)
  Protected LatitudeRad.f
  *Location\Longitude  = *Tile\X / n * 360.0 - 180.0
  LatitudeRad = ATan(SinH(#PI * (1 - 2 * *Tile\Y / n)))
  *Location\Latitude    = LatitudeRad * 180.0 / #PI
EndProcedure

Procedure LoadMapTile(Image.l, Zoom.l, XTile.l, YTile.l)
  Protected *Buffer
  Protected TileURL.s = OSM\ServerURL+Str(Zoom)+"/"+Str(XTile)+"/"+Str(YTile)+".png"
  ; Test if in cache else download it
  Protected CacheFile.s="OSM_"+Str(Zoom)+"_"+Str(XTile)+"_"+Str(YTile)+".png"
  If FileSize(osm\cachePath+cacheFile)>0
    ;Debug "Use Cache :"+cacheFile
    LoadImage(Image,OSM\CachePath+CacheFile)
  Else 
    ;Debug "DOWNLOAD : "+psURL
    CompilerIf #USEPROXY=#True
      Protected http.HTTP_Query
      HTTP_proxy(@http,"spxy.bpi.fr",3128)
      HTTP_DownloadToMem(@http,TileURL)
      If IsImage(Image)
        FreeImage(Image)
      EndIf
      If CatchImage(Image, http\data, MemorySize(http\data))
        SaveImage(Image,OSM\CachePath+CacheFile,#PB_ImagePlugin_PNG)
      EndIf
    CompilerElse
      *Buffer = ReceiveHTTPMemory(TileURL)
      If IsImage(Image)
        FreeImage(Image)
      EndIf
      If CatchImage(Image, *Buffer, MemorySize(*Buffer))
        SaveImage(image,OSM\CachePath+CacheFile,#PB_ImagePlugin_PNG)
        FreeMemory(*Buffer)
      EndIf
    CompilerEndIf

  EndIf
  
EndProcedure

Procedure GetSquareTile()
  Protected x.l,y.l,nx.l,ny.l,n.l=0,tx.l,ty.l
  nx=Round(GadgetWidth(OSM\Gadget)/256,#PB_Round_Up):
  ny=Round(GadgetHeight(OSM\Gadget)/256,#PB_Round_Up):
  For x=0 To nx
    For y=0 To ny
      tx=x-Int(nx/2)
      ty=y-Int(ny/2)
      LoadMapTile(n, OSM\Zoom+1,Int(2* OSM\TargetTile\X+tx)  ,Int(2* OSM\TargetTile\Y+ty))
      n=n+1
    Next
  Next
  Debug Str(n)+" Images Chargées";
EndProcedure

Procedure DrawMap()
  Protected x.l,y.l,nx.l,ny.l,mx.l,my.l,n.l=0
  Protected deltaX.l,deltaY.l
  Protected tx.l,ty.l
  deltaX=512*(OSM\TargetTile\X-Int(OSM\TargetTile\X))-256 ;TODO Why -256 ?????
  deltaY=512*(OSM\TargetTile\Y-Int(OSM\TargetTile\Y))-512 ;TODO Why -512 ?????
  nx=Round(GadgetWidth(OSM\Gadget)/256,#PB_Round_Up ):
  ny=Round(GadgetHeight(OSM\Gadget)/256,#PB_Round_Up ):
  StartDrawing(CanvasOutput(OSM\Gadget))
  Box(0,0,512,512,RGB(255,255,255))

  For x=0 To nx
    For y=0 To ny
      tx=(x-Int(nx/2))*256-deltaX+OSM\DeltaCursor\X
      ty=(y-Int(ny/2))*256-deltaY+OSM\DeltaCursor\Y
      If IsImage(n):DrawImage(ImageID(n), tx, ty, 254, 254):EndIf
      DrawText( tx,ty,Str(x-Int(nx/2))+","+Str(y-Int(ny/2)))
      n=n+1
    Next
  Next
  Circle(256,256,5,#Red)
  DrawText(0,0,"DeltaCursorX:"+Str(OSM\DeltaCursor\X)+" deltaX:"+Str(deltaX)+" Tile X:"+StrD(OSM\TargetTile\X))
  StopDrawing()
EndProcedure

Procedure SetLocation(latitude.d,longitude.d,zoom=15)
  If zoom>OSM\ZoomMax:zoom=OSM\ZoomMax:EndIf
  If zoom<OSM\ZoomMin:zoom=OSM\ZoomMin:EndIf
  OSM\Zoom=zoom
  OSM\TargetLocation\Latitude=latitude
  OSM\TargetLocation\Longitude=longitude
  LatLon2XY(@OSM\TargetLocation,@OSM\TargetTile)
  GetSquareTile()
  DrawMap()
EndProcedure

Procedure TileTranslate(*Tile.Tile,tx.d,ty.d)
  Debug "-move-"

  Protected l.l,pfValue.f
  If tx<>0
      pfValue = *Tile\X - tx
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\X = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\X = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\X = pfValue
     
      EndIf
    EndIf
    
      If ty<>0
      pfValue = *Tile\Y - ty
 If pfValue > Pow(2, OSM\Zoom) - 1
                *Tile\Y = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
                *Tile\Y = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\Y = pfValue
     
      EndIf
    EndIf
 EndProcedure
 
 Procedure SetZoom(Zoom.l,mode.l=#PB_Relative)
   Select mode
     Case #PB_Relative
       OSM\Zoom=OSM\Zoom+zoom
     Case #PB_Absolute
       OSM\Zoom=zoom
    EndSelect
  If OSM\Zoom>OSM\ZoomMax:OSM\Zoom=OSM\ZoomMax:EndIf
  If OSM\Zoom<OSM\ZoomMin:OSM\Zoom=OSM\ZoomMin:EndIf
  LatLon2XY(@OSM\TargetLocation,@OSM\TargetTile)
  GetSquareTile()
  DrawMap()
 EndProcedure
 
Procedure Event(Event.l)
  Protected Gadget.i
  If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget)=#PB_GadgetType_Canvas 
  Select Event
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case OSM\Gadget
              Select EventType()
                Case #PB_EventType_LeftButtonDown
                  ;Mem cursor Coord
                  OSM\StartCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
                  OSM\StartCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
                Case #PB_EventType_MouseMove 
                  If OSM\StartCursor\X<>0 Or OSM\StartCursor\Y<>0
                    OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
                    OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
                  EndIf 
                Case #PB_EventType_LeftButtonUp
                  Define tx.d,ty.d
                  tx=(OSM\DeltaCursor\X/512)
                  ty=(OSM\DeltaCursor\Y/512)
                  OSM\DeltaCursor\X=0
                  OSM\DeltaCursor\Y=0
                  OSM\StartCursor\X=0
                  OSM\StartCursor\Y=0
                  TileTranslate(@OSM\TargetTile,tx.d,ty.d)
                  XY2LatLon(@OSM\TargetTile,@OSM\TargetLocation)
                  GetSquareTile()
                  ;move(tx,ty)
                  ;SetGadgetText(#String_1, StrD(osm\gfLongitude))
                  ;SetGadgetText(#String_0, StrD(osm\gfLatitude))
              EndSelect
          EndSelect
          
          OSM::DrawMap()
          
      EndSelect
    Else
      MessageRequester("Module OSM","You must use OSMGadget before",#PB_MessageRequester_Ok )
      End
   EndIf  
EndProcedure




EndModule

  Enumeration
    #Window_0
    #Map
    #Button_0
    #Button_1
    #Button_2
    #Button_3
    #Button_4
    #Button_5
    #Combo_0
    #Text_0
    #Text_1
    #Text_2
    #Text_3
    #Text_4
    #String_0
    #String_1
  EndEnumeration

  If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    OSM::InitOSM()
    LoadFont(0,"Wingdings",12)
    LoadFont(1,"Arial",12,#PB_Font_Bold)
    
    
    OSM::OSMGadget(#Map,10,10,512,512)
    
    TextGadget(#Text_1, 530, 50, 60, 15, "Movements :")
    ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7))  : SetGadgetFont(#Button_0, FontID(0)) 
    ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8))  : SetGadgetFont(#Button_1, FontID(0)) 
    ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9))  : SetGadgetFont(#Button_2, FontID(0)) 
    ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA))  : SetGadgetFont(#Button_3, FontID(0)) 
    TextGadget(#Text_2, 530, 160, 60, 15, "Zoom :")
    ButtonGadget(#Button_4, 550, 180, 50, 30, "+")      : SetGadgetFont(#Button_4, FontID(1)) 
    ButtonGadget(#Button_5, 600, 180, 50, 30, "-")      : SetGadgetFont(#Button_5, FontID(1)) 
    TextGadget(#Text_3, 530, 230, 60, 15, "Latitude :")
    StringGadget(#String_0, 600, 230, 90, 20, "")
    TextGadget(#Text_4, 530, 250, 60, 15, "Longitude :")
    StringGadget(#String_1, 600, 250, 90, 20, "")
    
    Define Event.l,Gadget.l,Quit.b=#False
    Define pfValue.f
   OSM::SetLocation(49.04599,2.03347)
   OSM::SetLocation(49.0361165,2.0456982)


    
    Repeat
      Event = WaitWindowEvent()
      
      OSM::Event(Event)
      Select Event
        Case #PB_Event_CloseWindow : Quit = 1
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case #Button_4
              OSM::SetZoom(1)
            Case #Button_5
              OSM::SetZoom(-1)
          EndSelect
      EndSelect
    Until Quit = #True
  EndIf
Avatar de l’utilisateur
Ar-S
Messages : 9476
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: OpenStreetMap dans un Canvas

Message par Ar-S »

Je pige pas grand chose la dedans, mais effectivement les déplacements sont étranges.
Tu n'aurais pas eu meilleurs compte d'utiliser un webgadget ?
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

Ar-S a écrit :Je pige pas grand chose la dedans, mais effectivement les déplacements sont étranges.
Tu n'aurais pas eu meilleurs compte d'utiliser un webgadget ?
non avec un webgadget je peux pas afficher les points que je veux et je ne peux pas non plus les déplacer et récupérer leur position...
Je m'arrache les cheveux avec leur histoire de quadrant. Et je trouve nul part des explications claire ...
le mieux que je trouve c'est ça
http://wiki.openstreetmap.org/wiki/Slippy_map_tilenames
http://wiki.openstreetmap.org/wiki/QuadTiles
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

En parlant d'OSM, un pote vient juste de me parler de ça : http://leafletjs.com/
(je vais jeter un oeil à ton code)
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

C'est quelle version de PB ? Tu peux filer le code pour le proxy ?
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

voilà l'usine a gaz pour télécharger via le proxy.
Leaflet c'est très sympa pourl es application web, mais difficile d'interfacé avec du purebasic

fichier :http.pbi

Code : Tout sélectionner

;*********************************************
;***** Envoi de fichier par requete HTTP *****
;******** Par lepiaf31 le 28/06/2011 *********
;******** client event by DarkPlayer *********
;****** et quelques modif part thyphoon ******
;*********************************************
;TODO Cookie support

EnableExplicit

;-#################################
;- Client Event4 support by DarkPlayer, PureFan
; Source :http://www.purebasic.fr/english/viewtopic.php?f=12&t=42559&hilit=Disconnect
;EDIT 2010-06-13: Improved the MacOS and Linux version, added some checks to prevent crashing in case of incorrect usage
CompilerIf #PB_Compiler_OS = #PB_OS_Linux ;{
  #FIONREAD     = $541B
 
  #__FD_SETSIZE = 1024
  #__NFDBITS    = 8 * SizeOf(LONG)
 
  Macro __FDELT(d)
    ((d) / #__NFDBITS)
  EndMacro
 
  Macro __FDMASK(d)
    (1 << ((d) % #__NFDBITS))
  EndMacro
 
  Structure FD_SET
    fds_bits.l[#__FD_SETSIZE / #__NFDBITS]
  EndStructure
 
  Procedure.i __FD_SET(d.i, *set.FD_SET)
    If d >= 0 And d < #__FD_SETSIZE
      *set\fds_bits[__FDELT(d)] | __FDMASK(d)
    EndIf
  EndProcedure
 
  Procedure.i __FD_ISSET(d.i, *set.FD_SET)
    If d >= 0 And d < #__FD_SETSIZE
      ProcedureReturn *set\fds_bits[__FDELT(d)] & __FDMASK(d)
    EndIf
  EndProcedure
 
  Procedure.i __FD_ZERO(*set.FD_SET)
    FillMemory(*set, SizeOf(FD_SET), 0, #PB_Byte)
  EndProcedure
 
 
  #FD_SETSIZE = #__FD_SETSIZE
  #NFDBITS    = #__NFDBITS
 
  Macro FD_SET(fd, fdsetp)
    __FD_SET(fd, fdsetp)
  EndMacro
 
  Macro FD_ISSET(fd, fdsetp)
    __FD_ISSET(fd, fdsetp)
  EndMacro
 
  Macro FD_ZERO(fdsetp)
    __FD_ZERO(fdsetp)
  EndMacro
 
  ; Returns the minimum value for NFDS
  Procedure.i _NFDS(*set.FD_SET)
    Protected I.i, J.i
   
    For I = SizeOf(FD_SET)/SizeOf(LONG) - 1 To 0 Step -1
      If *set\fds_bits[I]
       
        For J = (#__NFDBITS - 1) To 0 Step -1
          If *set\fds_bits[I] & (1 << J)
            ProcedureReturn I * #__NFDBITS + J + 1
          EndIf
        Next
       
      EndIf
    Next
   
    ProcedureReturn 0
  EndProcedure
  ;}
CompilerEndIf

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS ;{
  #IOC_OUT  = $40000000 ;(__uint32_t)
  Macro _IOR(g,n,t)
    _IOC(#IOC_OUT, (g), (n), (t))
  EndMacro
  #IOCPARM_MASK = $1fff
  Macro _IOC(inout,group,num,len)
    ((inout) | (((len) & #IOCPARM_MASK) << 16) | ((group) << 8) | (num))
  EndMacro
  #FIONREAD = _IOR('f', 127, SizeOf(LONG))
 
  #__DARWIN_FD_SETSIZE = 1024
  #__DARWIN_NBBY       = 8
  #__DARWIN_NFDBITS    = SizeOf(LONG) * #__DARWIN_NBBY
 
  Structure FD_SET
    fds_bits.l[ (#__DARWIN_FD_SETSIZE + #__DARWIN_NFDBITS - 1) / #__DARWIN_NFDBITS ]
  EndStructure
 
  Procedure.i __DARWIN_FD_SET(fd.i, *p.FD_SET)
    If fd >= 0 And fd < #__DARWIN_FD_SETSIZE
      *p\fds_bits[fd / #__DARWIN_NFDBITS] | (1 << (fd % #__DARWIN_NFDBITS))
    EndIf
  EndProcedure
 
  Procedure.i __DARWIN_FD_ISSET(fd.i, *p.FD_SET)
    If fd >= 0 And fd < #__DARWIN_FD_SETSIZE
      ProcedureReturn *p\fds_bits[fd / #__DARWIN_NFDBITS] & (1 << (fd % #__DARWIN_NFDBITS))
    EndIf
  EndProcedure
 
  Procedure.i __DARWIN_FD_ZERO(*p.FD_SET)
    FillMemory(*p, SizeOf(FD_SET), 0, #PB_Byte)
  EndProcedure
 
  #FD_SETSIZE = #__DARWIN_FD_SETSIZE
 
  Macro FD_SET(n, p)
    __DARWIN_FD_SET(n, p)
  EndMacro
 
  Macro FD_ISSET(n, p)
    __DARWIN_FD_ISSET(n, p)
  EndMacro
 
  Macro FD_ZERO(p)
    __DARWIN_FD_ZERO(p)
  EndMacro
 
  ; Returns the minimum value for NFDS
  Procedure.i _NFDS(*p.FD_SET)
    Protected I.i, J.i
   
    For I = SizeOf(FD_SET)/SizeOf(LONG) - 1 To 0 Step -1
      If *p\fds_bits[I]
       
        For J = (#__DARWIN_NFDBITS - 1) To 0 Step -1
          If *p\fds_bits[I] & (1 << J)
            ProcedureReturn I * #__DARWIN_NFDBITS + J + 1
          EndIf
        Next
       
      EndIf
    Next
   
    ProcedureReturn 0
  EndProcedure
  ;}
CompilerEndIf

CompilerIf #PB_Compiler_OS = #PB_OS_Windows ;{
  ; #FIONREAD is already defined
  ; FD_SET is already defined
 
  Macro FD_ZERO(set)
    set\fd_count = 0
  EndMacro
 
  Procedure.i FD_SET(fd.i, *set.FD_SET)
    If *set\fd_count < #FD_SETSIZE
      *set\fd_array[ *set\fd_count ] = fd
      *set\fd_count + 1
    EndIf
  EndProcedure
 
  Procedure.i FD_ISSET(fd.i, *set.FD_SET)
    Protected I.i
    For I = *set\fd_count - 1 To 0 Step -1
      If *set\fd_array[I] = fd
        ProcedureReturn #True
      EndIf
    Next
   
    ProcedureReturn #False
  EndProcedure
 
  Procedure.i _NFDS(*set.FD_SET)
    ProcedureReturn *set\fd_count
  EndProcedure
  ;}
CompilerEndIf
 
 
CompilerIf Defined(TIMEVAL, #PB_Structure) = #False ;{
  Structure TIMEVAL
    tv_sec.l
    tv_usec.l
  EndStructure ;}
CompilerEndIf

Procedure.i Hook_NetworkClientEvent(Connection.i)
  Protected Event.i = NetworkClientEvent(Connection)
  If Event
    ProcedureReturn Event
  EndIf
 
  Protected hSocket.i = ConnectionID(Connection)
  Protected tv.timeval, readfds.fd_set, RetVal.i, Length.i
  tv\tv_sec  = 0 ; Dont even wait, just query status
  tv\tv_usec = 0
 
  FD_ZERO(readfds)
  FD_SET(hSocket, readfds)
 
  ; Check if there is something new
  RetVal = select_(_NFDS(readfds), @readfds, #Null, #Null, @tv)
  If RetVal < 0 ; Seems to be an error
    ProcedureReturn #PB_NetworkEvent_Disconnect
  ElseIf RetVal = 0 Or Not FD_ISSET(hSocket, readfds) ; No data available
    ProcedureReturn 0
  EndIf
 
  ; Check if data is available?
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    RetVal = ioctlsocket_(hSocket, #FIONREAD, @Length)
  CompilerElse
    RetVal = ioctl_(hSocket, #FIONREAD, @Length)
  CompilerEndIf
  If RetVal Or Length = 0 ; Not successful to query for data available OR no data available ? This seems to be an error!
    ProcedureReturn #PB_NetworkEvent_Disconnect
  EndIf
 
  ProcedureReturn 0
EndProcedure

Macro NetworkClientEvent(Connection)
  Hook_NetworkClientEvent(Connection)
EndMacro

;-#################################
;- HTTP by Le Piaf31

Structure HTTP_file
  name.s
  path.s
EndStructure

Structure HTTP_Proxy
  host.s
  port.i
  login.s
  password.s
EndStructure

Structure HTTP_Query
  method.b         ;see enumeration under structure
  host.s
  port.i
  path.s
  boundary.s
  proxy.HTTP_Proxy
  List headers.s()
  List postData.s()
  List files.HTTP_file()
  conn.i          
  *buffer         ; buffer to received data
  *rawdata        ; all datareceived header and data mixed
  *data           ; complete received data
  *header         ; received header data
  error.b         ; return error
  *downCallback   ; CallBack funtion procedure()
  *upCallback     ; CallBack funtion procedure()
EndStructure

#HTTP_BUFFER=2048; Buffer size to reveive data

Enumeration
  #HTTP_2xx_Success
  #HTTP_3xx_Redirection
  #HTTP_4xx_Client_Error
  #HTTP_5xx_Server_Error 
  #HTTP_ERROR_NO_CONNEXION
  #HTTP_ERROR_ANSWER_NO_HEADER
EndEnumeration


Enumeration
  #HTTP_METHOD_GET
  #HTTP_METHOD_POST
  #HTTP_METHOD_FILE
EndEnumeration

Procedure HTTP_free(*query.HTTP_Query)
  ;*query\method=0
  ;*query\host=""
  ;*query\path=""
  ;*query\boundary=""
  ClearList(*query\headers())
  ClearList(*query\postData())
  ClearList(*query\files())
  If *query\buffer>0 And MemorySize(*query\buffer)>0:FreeMemory(*query\buffer):EndIf
  If *query\rawdata>0 And MemorySize(*query\rawdata)>0:FreeMemory(*query\rawdata):EndIf
  If *query\data>0 And MemorySize(*query\data)>0:FreeMemory(*query\data):EndIf
  If *query\header>0 And MemorySize(*query\header)>0:FreeMemory(*query\header):EndIf
  *query\error=0;
  *query\downCallback=0;
  *query\upCallback=0;
EndProcedure

Procedure HTTP_addQueryHeader(*query.HTTP_Query, name.s, value.s)
  Protected string.s
  string = name+": "+value
  AddElement(*query\headers())
  *query\headers() = string
EndProcedure

Procedure HTTP_createQuery(*query.HTTP_Query, method.b, path.s, host.s, port.i=80, proxyHost.s="", login.s="", password.s="")
  Protected query.HTTP_Query, result.i, string.s, res.s
  
  *query\method = method
  *query\host = host
  *query\port = port
  *query\path = path
  
  If proxyHost <> ""
    *query\host = proxyHost
    If login <> ""
      string = login+":"+password
      res = Space(Len(string)*4)
      Base64Encoder(@string, Len(string), @res, Len(string)*4)
      HTTP_addQueryHeader(*query, "Proxy-Authorization", "Basic "+res)
    EndIf
  EndIf
  
  HTTP_addQueryHeader(*query, "Host", host)
  If method = #HTTP_METHOD_POST
    HTTP_addQueryHeader(*query, "Content-type", "application/x-www-form-urlencoded")
  ElseIf method = #HTTP_METHOD_FILE
    *query\boundary = "----------"+Str(ElapsedMilliseconds())
    HTTP_addQueryHeader(*query, "Content-type", "multipart/form-data; boundary="+*query\boundary)
  EndIf
EndProcedure

Procedure HTTP_addPostData(*query.HTTP_Query, name.s, value.s)
  Protected string.s
  
  If *query\method =#HTTP_METHOD_POST Or *query\method = #HTTP_METHOD_FILE
    string = ReplaceString(URLEncoder(name), "=", "%3D")+"="+ReplaceString(URLEncoder(value), "=", "%3D")
    AddElement(*query\postData())
    *query\postData() = string
    ProcedureReturn 1
  EndIf
  
  ProcedureReturn 0
EndProcedure

Procedure HTTP_addFile(*query.HTTP_Query, name.s, fileName.s)
  If *query\method = #HTTP_METHOD_FILE And FileSize(fileName) > -1
    AddElement(*query\files())
    *query\files()\name = name
    *query\files()\path = fileName
    ProcedureReturn 1
  EndIf
  
  ProcedureReturn 0
EndProcedure

Macro SendNetworkAscii(__cnx,__txt)
  *tmpbuffer=AllocateMemory(StringByteLength(__txt, #PB_Ascii)+1)
  PokeS(*tmpbuffer,__txt,Len(__txt),#PB_Ascii)
  SendNetworkData(__cnx, *tmpbuffer, StringByteLength(__txt, #PB_Ascii))
  FreeMemory(*tmpbuffer)
EndMacro

Procedure HTTP_sendQuery(*query.HTTP_Query)
  Protected head.s, postData.s, size.i, fileHeaderSize.i, file.i, readed.i, *buffer,*tmpbuffer
  
  ;Methode
  Select *query\method
    Case #HTTP_METHOD_GET
      head = "GET "
    Case #HTTP_METHOD_POST
      head = "POST "
    Case #HTTP_METHOD_FILE
      head = "POST "
  EndSelect
  
  ;En-tetes
  head + *query\path + " HTTP/1.0" + #CRLF$
  ForEach *query\headers()
    head + *query\headers() + #CRLF$
  Next
  
  *query\conn = OpenNetworkConnection(*query\host, *query\port)
  If *query\conn
    Select *query\method
      Case #HTTP_METHOD_GET
        head + #CRLF$
        SendNetworkAscii(*query\conn,head)
        
      Case #HTTP_METHOD_POST
        ForEach *query\postData()
          postData + *query\postData() + "&"
        Next
        postData = Left(postData, Len(postData)-1)
        
        head + "Content-Length: "+Str(Len(postData)) + #CRLF$
        head + #CRLF$
        head + postData
        SendNetworkAscii(*query\conn, head)
        
      Case #HTTP_METHOD_FILE
        ForEach *query\postData()
          postData + "--"+*query\boundary+#CRLF$
          postData +"Content-Disposition: form-data; name="+Chr(34)+StringField(*query\postData(), 1, "=")+Chr(34)+#CRLF$
          postData + #CRLF$
          postData + StringField(*query\postData(), 2, "=")+#CRLF$
        Next
        
        fileHeaderSize = Len("Content-Disposition: form-data; name="+Chr(34)+Chr(34) +"; filename="+Chr(34)+Chr(34)+#CRLF$+"Content-Type: application/octet-stream" + #CRLF$ + #CRLF$)
        size = fileHeaderSize * ListSize(*query\files())
        ForEach *query\files()
          size + Len(GetFilePart(*query\files()\path))
          size + Len(*query\files()\name)
          size + 4
          size + FileSize(*query\files()\path)
          size + Len("--"+*query\boundary)
        Next
        size + Len(postData)
        size + (2+Len(*query\boundary)+2)
        
        head + "Content-Length: "+Str(size)+#CRLF$
        head + #CRLF$
        head + postData
        SendNetworkAscii(*query\conn,head)
        *buffer = AllocateMemory(2048)
        ForEach *query\files()
          postData = "--"+*query\boundary+#CRLF$
          postData + "Content-Disposition: form-data; name="+Chr(34)+*query\files()\name+Chr(34) +"; filename="+Chr(34)+GetFilePart(*query\files()\path)+Chr(34)+#CRLF$
          postData + "Content-Type: application/octet-stream" + #CRLF$ + #CRLF$
          SendNetworkAscii(*query\conn,postData)
          file = OpenFile(#PB_Any, *query\files()\path)
          
          If file
            While Eof(file) = 0
              readed = ReadData(file, *buffer, 2048)
              SendNetworkData(*query\conn, *buffer, readed)
              ;-Up CallBack
              If *query\upCallback>0
                  CallFunctionFast(*query\upCallback,Loc(file),Lof(file))
              EndIf
            Wend
            SendNetworkAscii(*query\conn,#CRLF$)
            CloseFile(file)
          EndIf
        Next
        FreeMemory(*buffer)
        
        postData = "--"+*query\boundary+"--"
        SendNetworkData(*query\conn, @postData, Len(postData))
    EndSelect
    
    ProcedureReturn #True
  Else
    *query\error=#HTTP_ERROR_NO_CONNEXION
    MessageRequester("Http Error","No Connexion"+#CRLF$+*query\host+" port:"+Str(*query\port))
    ProcedureReturn #False
  EndIf
EndProcedure

;-#################################
;- Easy HTTP Function by Thyphoon 

Procedure HTTP_proxy(*query.HTTP_Query,host.s="",port.i=80,login.s="",password.s="")
  *query\proxy\host=host
  *query\proxy\port=port
  *query\proxy\login=login
  *query\proxy\password=password
EndProcedure



Procedure HTTP_receiveRawData(*query.HTTP_Query)
  Protected *rawdata,time.i,readed.i,size.i,NEvent.i
  
  If *query\rawdata>0
    FreeMemory(*query\rawdata):*query\rawdata=0
  EndIf
  
  If *query\header>0
    FreeMemory(*query\header):*query\header=0
  EndIf
  
  If *query\data>0
    FreeMemory(*query\data):*query\data=0
  EndIf
  
  If *query\conn
    *query\buffer = AllocateMemory(#HTTP_BUFFER)
    *query\rawdata=AllocateMemory(1)
    time = ElapsedMilliseconds()
    Repeat
      NEvent=NetworkClientEvent(*query\conn);NetworkClientEvent(*query\conn) 
      If NEvent=#PB_NetworkEvent_Data
        readed = ReceiveNetworkData(*query\conn, *query\buffer, #HTTP_BUFFER)
        If readed>0
          size=MemorySize(*query\rawdata)
          If size=1:size=0:EndIf
          *query\rawdata=ReAllocateMemory(*query\rawdata,size+readed)
          CopyMemory(*query\buffer,*query\rawdata+size,readed)
          ;-Search Header
          If *query\header=0
            ;found the lenght of the header
            Protected z.i,lenght.i
            For z=-4 To readed-5
              ;If PeekB(*query\rawdata+size+z)=13 And PeekB(*query\rawdata+size+z+1)=10 And PeekB(*query\rawdata+size+z+2)=13 And PeekB(*query\rawdata+size+z+3)=10
              If size+z>=0 And PeekL(*query\rawdata+size+z)=168626701
                lenght=size+z+4
                *query\header=AllocateMemory(lenght)
                CopyMemory(*query\rawdata,*query\header,lenght);
                ;Analyse the header !
                Protected txt.s,nbline.l,line.s,nbFound.l
                txt=PeekS(*query\header,MemorySize(*query\header),#PB_Ascii)
                nbline=CountString(txt,#LF$)
                ;Debug "___Header__"
                For z=1 To nbline
                  line=StringField(txt, z, #LF$)
                  line=ReplaceString(line,#LF$,"")
                  line=ReplaceString(line,#CR$,"")
                  If z=1
                    If CreateRegularExpression(0, "^HTTP.+\s[0-9][0-9][0-9]\s.+")
                      Dim Result$(0)
                      nbFound = ExtractRegularExpression(0, line, Result$())
                      FreeRegularExpression(0)
                    Else
                      Debug RegularExpressionError()
                    EndIf
                    
                    If NbFound>0
                      *query\error=Val(StringField(line,3," "))
                      ;http://www.w3.org/Protocols/rfc2616/rfc2616-sec6.html
                      Select   *query\error
                          ;1xx: Informational - Request received, continuing process
                        Case 1:
                          ;"100"  ; Section 10.1.1: Continue
                          ;"101"  ; Section 10.1.2: Switching Protocols
                          
                          ; 2xx: Success - The action was successfully received, understood, And accepted
                        Case 2
                          ;"200"  ; Section 10.2.1: OK
                          ;"201"  ; Section 10.2.2: Created
                          ;"202"  ; Section 10.2.3: Accepted
                          ;"203"  ; Section 10.2.4: Non-Authoritative Information
                          ;"204"  ; Section 10.2.5: No Content
                          ;"205"  ; Section 10.2.6: Reset Content
                          ;"206"  ; Section 10.2.7: Partial Content
                          
                          ; 3xx: Redirection - Further action must be taken in order To complete the request
                        Case 3
                          ;"300"  ; Section 10.3.1: Multiple Choices
                          ;"301"  ; Section 10.3.2: Moved Permanently
                          ;"302"  ; Section 10.3.3: Found
                          ;"303"  ; Section 10.3.4: See Other
                          ;"304"  ; Section 10.3.5: Not Modified
                          ;"305"  ; Section 10.3.6: Use Proxy
                          ;"307"  ; Section 10.3.8: Temporary Redirect
                          
                          ; 4xx: Client Error - The request contains bad syntax Or cannot  be fulfilled
                        Case 4
                          ;"400"  ; Section 10.4.1: Bad Request
                          ;"401"  ; Section 10.4.2: Unauthorized
                          ;"402"  ; Section 10.4.3: Payment Required
                          ;"403"  ; Section 10.4.4: Forbidden
                          ;"404"  ; Section 10.4.5: Not Found
                          ;"405"  ; Section 10.4.6: Method Not Allowed
                          ;"406"  ; Section 10.4.7: Not Acceptable
                          
                          ; 5xx: Server Error - The server failed To fulfill an apparently  valid request
                        Case 5
                          ;"500"  ; Section 10.5.1: Internal Server Error
                          ;"501"  ; Section 10.5.2: Not Implemented
                          ;"502"  ; Section 10.5.3: Bad Gateway
                          ;"503"  ; Section 10.5.4: Service Unavailable
                          ;"504"  ; Section 10.5.5: Gateway Time-out
                          ;"505"  ; Section 10.5.6: HTTP Version not supported
                      EndSelect
                      
                    EndIf
                  Else 
                    ;Debug line
                  EndIf
                Next
                Break;
              EndIf
            Next
          EndIf
          
          ;-Down CallBack
          If *query\downCallback>0
            ;Debug "down callback"
            CallFunctionFast(*query\downCallback,size+readed,lenght)
          EndIf
        Else 
          Debug "HTTP_receiveRawData() rien"
        EndIf
        time = ElapsedMilliseconds()
      EndIf
      Delay(10)
      
    Until NEvent=#PB_NetworkEvent_Disconnect ;ElapsedMilliseconds() - time >= 3000
    CloseNetworkConnection(*query\conn)
    FreeMemory(*query\buffer):*query\buffer=0;
    ;-Search Data
    If *query\header>0
      size=MemorySize(*query\rawdata)-MemorySize(*query\header)
      ;Debug "size:"+Str(size)
      *query\data=AllocateMemory(size)
      CopyMemory(*query\rawdata+MemorySize(*query\header),*query\data,size);
      FreeMemory(*query\rawdata):*query\rawdata=0
      ;Debug "___DATA__"
      ;Debug PeekS(*query\data,MemorySize(*query\data),#PB_Ascii)
      ProcedureReturn #True
    Else
      Debug "HTTP_ERROR_ANSWER_NO_HEADER"
      *query\error=#HTTP_ERROR_ANSWER_NO_HEADER
      ProcedureReturn #False
    EndIf
    
    
  Else
    Debug "no Networkconnection"
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure HTTP_query(*query.HTTP_Query,method.b,url.s)
  Protected host.s,port.l,path.s,login.s,pass.s,res.s,string.s
  ; si on a un proxy
  If *query\proxy\host<>""
    ;Debug "Use Proxy:"+*query\proxy\host+" port:"+Str(*query\proxy\port)
    HTTP_createQuery(*query, method, url, *query\proxy\host,*query\proxy\port,*query\proxy\login,*query\proxy\password)
    ;si on a pas de proxy 
  Else
    host = GetURLPart(url, #PB_URL_Site); the main domain
    path =GetURLPart(url,#PB_URL_Path); the path
    port= Val(GetURLPart(url, #PB_URL_Port))
    If port=0:port=80:EndIf
    HTTP_createQuery(*query, method, "/"+path, host,port)
  EndIf
  ;si on a une protection part login/password via un htacess
  login=GetURLPart(url, #PB_URL_User)
  pass=GetURLPart(url, #PB_URL_Password)
  If login <> ""
    string = login+":"+pass
    res = Space(Len(string)*4)
    Base64Encoder(@string, Len(string), @res, Len(string)*4)
    HTTP_addQueryHeader(*query, "Authorization", "Basic "+res)
  EndIf
EndProcedure

Procedure HTTP_DownloadToMem(*query.HTTP_Query,url.s)
  Protected  *rawdata,lenght.i
  HTTP_query(*query, #HTTP_METHOD_GET, url)
  HTTP_addQueryHeader(*query, "User-Agent", "PB")
  HTTP_sendQuery(*query)
  HTTP_receiveRawData(*query)
  ProcedureReturn #True
EndProcedure

Procedure HTTP_DownloadToFile(*query.HTTP_Query,url.s,file.s)
  HTTP_DownloadToMem(*query,url.s)
  If *query\data<>0
    CreateFile(0,file)
    WriteData(0,*query\data,MemorySize(*query\data))
    CloseFile(0)
    FreeMemory(*query\data):*query\data=0
    ProcedureReturn #True
  Else  
    ProcedureReturn #False  
  EndIf
EndProcedure


;-Exemple !
CompilerIf Defined(INCLUDEINPROJECT,#PB_Constant)=0
  InitNetwork()
  
Procedure mytestCallBack(l.i,max.i)
Debug Str(l)+"/"+Str(max)
EndProcedure
  
  
  Procedure test1()
    Protected test.HTTP_Query, string.s, readed.i, conn.i, time.i,*string,*rawdata
    OpenConsole()
    ;HTTP_proxy(@test,"spxy.bpi.fr",3128)
    test\upCallback=@mytestCallBack() ;if you want a call Back
    HTTP_query(@test, #HTTP_METHOD_FILE, "http://www.thyphoon.com/test.php")
    HTTP_addQueryHeader(@test, "User-Agent", "PB")
    HTTP_addPostData(@test, "pseudo", "lepiaf31")
    HTTP_addPostData(@test, "nom", "Kevin")
    HTTP_addFile(@test, "datafile", OpenFileRequester("Please choose file to load", "", "*.*", 0))
    HTTP_sendQuery(@test)
    HTTP_receiveRawData(@test)
    Print(PeekS(test\data,MemorySize(test\data),#PB_Ascii))
    Input()
  EndProcedure
  
  
  Procedure test2()
    Protected test.HTTP_Query,url.s
    ;HTTP_proxy(@test,"spxy.bpi.fr",3128)
    url="http://www.purebasic.com/images/box.png"
    test\downCallback=@mytestCallBack() ;if you want a call Back
    HTTP_DownloadToFile(@test,url,GetTemporaryDirectory()+GetFilePart(url))
    RunProgram(GetTemporaryDirectory()+GetFilePart(url))
  EndProcedure
  
  ;test1()
  ;test2()
  
;http://sites.google.com/site/tomihasa/google-language-codes
Procedure.s translate(text.s,langSource.s,langTarget.s)
    Protected test.HTTP_Query,url.s
    text.s="bonjour"
    langSource.s="fr"
    langTarget.s="en"
    url.s="http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q="+text+"&langpair="+langSource+"|"+langTarget
    ;HTTP_proxy(@test,"spxy.bpi.fr",3128) ;<<<<<<<<<<<<<<<if you have a proxy change it
    HTTP_query(@test, #HTTP_METHOD_GET, url)
    ;HTTP_addQueryHeader(@test, "X-Requested-With", "XMLHttpRequest")
    HTTP_sendQuery(@test)
    HTTP_receiveRawData(@test)
    Protected s.l,e.l,result.s
    result.s=PeekS(test\data,MemorySize(test\data),#PB_Ascii)
    s=FindString(result,"translatedText",0)+Len("translatedText")+3
    If s>0
      e=FindString(result,Chr(34)+"}, "+Chr(34),s)
      ProcedureReturn Mid(result,s,e-s)
    Else
      ProcedureReturn ""
    EndIf
  EndProcedure
  

CompilerEndIf



Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: OpenStreetMap dans un Canvas

Message par falsam »

djes a écrit :un pote vient juste de me parler de ça : http://leafletjs.com/
Merci pour l'info. Un peu de hors sujet : La mise en oeuvre n'a pas l'air compliquée. Je pense qu'il est facile de l'adapter à une application codée avec SpiderBasic.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

Pour l'instant j'ai des soucis de proxy, c'est pas gagné :/
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

djes a écrit :Pour l'instant j'ai des soucis de proxy, c'est pas gagné :/
mince ... tu as un login et mot de passe sur ton proxy ?
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

Oui, mais je regarderai demain
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

djes a écrit :Oui, mais je regarderai demain
j'ai jamais pu tester le proxy avec mot de passe, mon proxy en a pas. :P
Vivement un support du proxy nativement dans PB. J'ai fait la demande sur le forum anglais car c'est pénible. Même pour mes applications professionnel (d'ou le http.pbi)
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

Une piste ici ...
https://help.openstreetmap.org/question ... n-the-tile

Code : Tout sélectionner

Friend Sub LatLongToPixelXYOSM(ByVal latitude As Double, ByVal longitude As Double, ByVal zoomLevel As Integer, ByRef pixelX As Integer, ByRef pixelY As Integer)
        Dim MinLatitude = -85.05112878
        Dim MaxLatitude = 85.05112878
        Dim MinLongitude = -180
        Dim MaxLongitude = 180
        Dim mapSize = Math.Pow(2, zoomLevel) * 256

        latitude = Clip(latitude, MinLatitude, MaxLatitude)
        longitude = Clip(longitude, MinLongitude, MaxLongitude)

        Dim p As PointF = New Point()
        p.X = CSng((longitude + 180.0) / 360.0 * (1 << zoomLevel))
        p.Y = CSng((1.0 - Math.Log(Math.Tan(latitude * Math.PI / 180.0) + 1.0 / Math.Cos(toRadians(latitude))) / Math.PI) / 2.0 * (1 << zoomLevel))

        Dim tilex As Integer = CInt(Math.Truncate(p.X))
        Dim tiley As Integer = CInt(Math.Truncate(p.Y))
        pixelX = ClipByRange((tilex * 256) + ((p.X - tilex) * 256), mapSize - 1)
        pixelY = ClipByRange((tiley * 256) + ((p.Y - tiley) * 256), mapSize - 1)
    End Sub

Friend Sub PixelXYToLatLongOSM(ByVal pixelX As Integer, ByVal pixelY As Integer, ByVal zoomLevel As Integer, ByRef latitude As Double, ByRef longitude As Double)
        Dim mapSize = Math.Pow(2, zoomLevel) * 256
        Dim tileX As Integer = Math.Truncate(pixelX / 256)
        Dim tileY As Integer = Math.Truncate(pixelY / 256)

        Dim p As PointF = New Point()
        Dim n As Double = Math.PI - ((2.0 * Math.PI * (ClipByRange(pixelY, mapSize - 1) / 256)) / Math.Pow(2.0, zoomLevel))

        longitude = CSng(((ClipByRange(pixelX, mapSize - 1) / 256) / Math.Pow(2.0, zoomLevel) * 360.0) - 180.0)
        latitude = CSng(180.0 / Math.PI * Math.Atan(Math.Sinh(n)))
    End Sub

Private Function ClipByRange(ByVal n As Double, ByVal range As Double)
        Return n Mod range
End Function

Private Function Clip(ByVal n As Double, ByVal minValue As Double, ByVal maxValue As Double)
      Return Math.Min(Math.Max(n, minValue), maxValue)
End Function
en PB ça donne ça

Code : Tout sélectionner

 Structure Location
    Longitude.d
    Latitude.d
  EndStructure
  
  Structure Tile
    X.f
    Y.f
  EndStructure
  
  Structure Pixel
    X.l
    Y.l
  EndStructure
Macro Min(a,b)
  (Bool((a) <= (b)) * (a) + Bool((b) < (a)) * (b))
EndMacro

Macro Max(a,b)
  (Bool((a) >= (b)) * (a) + Bool((b) > (a)) * (b))
EndMacro

Procedure Clip(n.d,minValue.d,maxValue.d)
      ProcedureReturn Min(Max(n, minValue), maxValue)
EndProcedure

Procedure ClipByRange(n.d, range.d)
        ProcedureReturn  Mod(n, range)
EndProcedure

Procedure LatLongToPixelXYOSM(*Location.Location, *Pixel.Pixel)
        Protected MinLatitude.d = -85.05112878
        Protected MaxLatitude.d = 85.05112878
        Protected MinLongitude.d = -180
        Protected MaxLongitude.d = 180
        Protected mapSize = Pow(2, OSM\Zoom) * 256
        Protected n=Pow(2, OSM\Zoom)
        *Location\Latitude = Clip(*Location\Latitude, MinLatitude, MaxLatitude)
        *Location\Longitude = Clip(*Location\Longitude, MinLongitude, MaxLongitude)

        Protected p.Pixel
        p\X = (((*Location\Longitude + 180) / 360) * n)
        p\Y = ((1-(Log(Tan(*Location\Latitude * #PI / 180)+(1/Cos(*Location\Latitude*#PI/180)))/#PI))/2*n)

        Protected tilex.i= Int(p\X)
        Protected tiley.i= Int(p\Y)
        *Pixel\X = ClipByRange((tilex * 256) + ((p\X - tilex) * 256), mapSize - 1)
        *Pixel\Y = ClipByRange((tiley * 256) + ((p\Y - tiley) * 256), mapSize - 1)
        Debug Str(*Pixel\X)+","+Str(*Pixel\Y)
EndProcedure
Mais je trouve des chiffres délirent pour le retour en Pixel\X Pixel\Y
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

J'en suis là pour l'instant :

Code : Tout sélectionner

InitNetwork()

DeclareModule OSM
  Declare InitOSM()
  Declare OSMGadget(Gadget.i,X.l,Y.l,Width.l,Height.l)
  Declare Event(Event.l)
  Declare SetLocation(latitude.d,longitude.d,zoom=15)
  Declare DrawMap()
  Declare SetZoom(Zoom.l,mode.l=#PB_Relative)
EndDeclareModule

Module OSM
  #USEPROXY=#False
  UsePNGImageDecoder()
  UsePNGImageEncoder()
  
  CompilerIf #USEPROXY=#True
    IncludeFile("C:\Users\lebrun_y_413\Documents\Developpement\Purebasic\includes Share\http.pbi")
  CompilerEndIf
  
  Structure Location
    Longitude.d
    Latitude.d
  EndStructure
  
  Structure Tile
    X.f
    Y.f
  EndStructure
  
  Structure Pixel
    X.l
    Y.l
  EndStructure
  
  Structure OSM
    Gadget.i
    TargetLocation.Location
    TargetTile.tile
    
    ServerURL.s
    ZoomMin.l
    ZoomMax.l
    Zoom.l
    
    CachePath.S
    
    StartCursor.Pixel
    DeltaCursor.Pixel
  EndStructure
  
  Global OSM.OSM
  
  Procedure InitOSM()
    OSM\CachePath=GetTemporaryDirectory()
    OSM\ServerURL="http://tile.openstreetmap.org/"
    OSM\ZoomMin=0
    OSM\ZoomMax=18
    OSM\StartCursor\X=-1
  EndProcedure
  
  Procedure OSMGadget(Gadget.i,X.l,Y.l,Width.l,Height.l)
    If Gadget=#PB_Any
      OSM\Gadget=CanvasGadget(OSM\Gadget,X,Y,Width,Height)
    Else
      OSM\Gadget=Gadget
      CanvasGadget(OSM\Gadget,X,Y,Width,Height)
    EndIf 
  EndProcedure
  
  
  
  Procedure LatLon2XY(*Location.Location,*Tile.Tile)
    Protected n.l = Pow(2, OSM\Zoom)
    *Tile\X = (((*Location\Longitude + 180) / 360) * n)
    *Tile\Y = ((1-(Log(Tan(*Location\Latitude * #PI / 180)+(1/Cos(*Location\Latitude*#PI/180)))/#PI))/2*n)
  EndProcedure
  
  Procedure XY2LatLon(*Tile.Tile,*Location.Location)
    Protected n.l = Pow(2, OSM\Zoom)
    Protected LatitudeRad.f
    *Location\Longitude  = *Tile\X / n * 360.0 - 180.0
    LatitudeRad = ATan(SinH(#PI * (1 - 2 * *Tile\Y / n)))
    *Location\Latitude    = LatitudeRad * 180.0 / #PI
  EndProcedure
  
  Procedure LoadMapTile(Image.l, Zoom.l, XTile.l, YTile.l)
    Protected *Buffer
    Protected TileURL.s = OSM\ServerURL+Str(Zoom)+"/"+Str(XTile)+"/"+Str(YTile)+".png"
    ; Test if in cache else download it
    Protected CacheFile.s="OSM_"+Str(Zoom)+"_"+Str(XTile)+"_"+Str(YTile)+".png"
    If FileSize(osm\cachePath+cacheFile)>0
      ;Debug "Use Cache :"+cacheFile
      LoadImage(Image,OSM\CachePath+CacheFile)
    Else 
      ;Debug "DOWNLOAD : "+psURL
      CompilerIf #USEPROXY=#True
        Protected http.HTTP_Query
        HTTP_proxy(@http,"spxy.bpi.fr",3128)
        HTTP_DownloadToMem(@http,TileURL)
        If IsImage(Image)
          FreeImage(Image)
        EndIf
        If CatchImage(Image, http\data, MemorySize(http\data))
          SaveImage(Image,OSM\CachePath+CacheFile,#PB_ImagePlugin_PNG)
        EndIf
      CompilerElse
        *Buffer = ReceiveHTTPMemory(TileURL)  ;TODO to thread by using #PB_HTTP_Asynchronous
        If IsImage(Image)
          FreeImage(Image)
        EndIf
        If *Buffer
          If CatchImage(Image, *Buffer, MemorySize(*Buffer))
            SaveImage(image,OSM\CachePath+CacheFile,#PB_ImagePlugin_PNG)
            FreeMemory(*Buffer)
          EndIf
        EndIf
      CompilerEndIf
      
    EndIf
    
  EndProcedure
  
  Procedure GetSquareTile()
    Protected x.l,y.l,nx.l,ny.l,n.l=0,tx.l,ty.l
    nx=Round(GadgetWidth(OSM\Gadget)/256,#PB_Round_Up):
    ny=Round(GadgetHeight(OSM\Gadget)/256,#PB_Round_Up):
    tx = 2 * OSM\TargetTile\X
    ty = 2 * OSM\TargetTile\Y
    For y = ty - ny To ty + ny + ny - 1    
      For x = tx - nx To tx + nx + nx - 1
        ;Debug Str(x) + " " + Str(y)
        LoadMapTile(n, OSM\Zoom+1, x, y)
        n=n+1
      Next
    Next
    Debug Str(n)+" Images Chargées";
  EndProcedure
  
  Procedure DrawMap()
    Protected x.l,y.l,nx.l,ny.l,mx.l,my.l,n.l=0
    Protected deltaX.l,deltaY.l
    Protected tx.l,ty.l
    ;deltaX=512*(OSM\TargetTile\X-Int(OSM\TargetTile\X))-256 ;TODO Why -256 ?????
    ;deltaY=512*(OSM\TargetTile\Y-Int(OSM\TargetTile\Y))-512 ;TODO Why -512 ?????
    tx = 2 * OSM\TargetTile\X
    ty = 2 * OSM\TargetTile\Y
    nx=Round(GadgetWidth(OSM\Gadget)/256,#PB_Round_Up ):
    ny=Round(GadgetHeight(OSM\Gadget)/256,#PB_Round_Up ):
    StartDrawing(CanvasOutput(OSM\Gadget))
    Box(0,0,GadgetWidth(OSM\Gadget),GadgetHeight(OSM\Gadget),RGB(255,255,255))
    
;     For x=0 To nx
;       For y=0 To ny
    For y = - ny To ny + ny - 1    
      For x = - nx To nx + nx - 1
        ;tx=(x-Int(nx/2))*256-deltaX+OSM\DeltaCursor\X
        ;ty=(y-Int(ny/2))*256-deltaY+OSM\DeltaCursor\Y
        If IsImage(n):DrawImage(ImageID(n), x*256 + OSM\DeltaCursor\X, y*256 + OSM\DeltaCursor\Y, 254, 254):EndIf        
        ;If IsImage(n):DrawImage(ImageID(n), tx, ty, 254, 254):EndIf
        DrawText( tx,ty,Str(x-Int(nx/2))+","+Str(y-Int(ny/2)))
        n=n+1
      Next
    Next
    Circle(GadgetWidth(OSM\Gadget)/2,GadgetHeight(OSM\Gadget)/2,5,#Red)
    DrawText(0,0,"DeltaCursorX:"+Str(OSM\DeltaCursor\X)+" deltaX:"+Str(deltaX)+" Tile X:"+StrD(OSM\TargetTile\X))
    StopDrawing()
  EndProcedure
  
  Procedure SetLocation(latitude.d,longitude.d,zoom=15)
    If zoom>OSM\ZoomMax:zoom=OSM\ZoomMax:EndIf
    If zoom<OSM\ZoomMin:zoom=OSM\ZoomMin:EndIf
    OSM\Zoom=zoom
    OSM\TargetLocation\Latitude=latitude
    OSM\TargetLocation\Longitude=longitude
    LatLon2XY(@OSM\TargetLocation,@OSM\TargetTile)
    GetSquareTile()
    DrawMap()
  EndProcedure
  
  Procedure TileTranslate(*Tile.Tile,tx.d,ty.d)
    Debug "-move-"
    
    Protected l.l,pfValue.f
    If tx<>0
      pfValue = *Tile\X - tx
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\X = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\X = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\X = pfValue
        
      EndIf
    EndIf
    
    If ty<>0
      pfValue = *Tile\Y - ty
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\Y = pfValue
        
      EndIf
    EndIf
  EndProcedure
  
  Procedure SetZoom(Zoom.l,mode.l=#PB_Relative)
    Select mode
      Case #PB_Relative
        OSM\Zoom=OSM\Zoom+zoom
      Case #PB_Absolute
        OSM\Zoom=zoom
    EndSelect
    If OSM\Zoom>OSM\ZoomMax:OSM\Zoom=OSM\ZoomMax:EndIf
    If OSM\Zoom<OSM\ZoomMin:OSM\Zoom=OSM\ZoomMin:EndIf
    LatLon2XY(@OSM\TargetLocation,@OSM\TargetTile)
    GetSquareTile()
    DrawMap()
  EndProcedure
  
  Procedure Event(Event.l)
    Protected Gadget.i
    If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget)=#PB_GadgetType_Canvas 
      Select Event
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case OSM\Gadget
              Select EventType()
                Case #PB_EventType_LeftButtonDown
                  ;Mem cursor Coord
                  OSM\StartCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
                  OSM\StartCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
                Case #PB_EventType_MouseMove 
                  If OSM\StartCursor\X<>-1
                    OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
                    OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
                    OSM::DrawMap()
                  EndIf 
                Case #PB_EventType_LeftButtonUp
                  Define tx.d,ty.d
                    OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
                    OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
                   ;tx=(OSM\DeltaCursor\X/512)
                   ;ty=(OSM\DeltaCursor\Y/512)
                   ;OSM\DeltaCursor\X=0
                   ;OSM\DeltaCursor\Y=0
                   OSM\StartCursor\X=-1
                   ;OSM\StartCursor\Y=0
                   TileTranslate(@OSM\TargetTile,tx.d,ty.d)
                   XY2LatLon(@OSM\TargetTile,@OSM\TargetLocation)
                   GetSquareTile()
                   OSM::DrawMap()
                  ;move(tx,ty)
                  ;SetGadgetText(#String_1, StrD(osm\gfLongitude))
                  ;SetGadgetText(#String_0, StrD(osm\gfLatitude))
              EndSelect
          EndSelect
          

          
      EndSelect
    Else
      MessageRequester("Module OSM","You must use OSMGadget before",#PB_MessageRequester_Ok )
      End
    EndIf  
  EndProcedure
  
  
  
  
EndModule

Enumeration
  #Window_0
  #Map
  #Button_0
  #Button_1
  #Button_2
  #Button_3
  #Button_4
  #Button_5
  #Combo_0
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #String_0
  #String_1
EndEnumeration

If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
  OSM::InitOSM()
  LoadFont(0,"Wingdings",12)
  LoadFont(1,"Arial",12,#PB_Font_Bold)
  
  
  OSM::OSMGadget(#Map,10,10,512,512)
  
  TextGadget(#Text_1, 530, 50, 60, 15, "Movements :")
  ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7))  : SetGadgetFont(#Button_0, FontID(0)) 
  ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8))  : SetGadgetFont(#Button_1, FontID(0)) 
  ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9))  : SetGadgetFont(#Button_2, FontID(0)) 
  ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA))  : SetGadgetFont(#Button_3, FontID(0)) 
  TextGadget(#Text_2, 530, 160, 60, 15, "Zoom :")
  ButtonGadget(#Button_4, 550, 180, 50, 30, "+")      : SetGadgetFont(#Button_4, FontID(1)) 
  ButtonGadget(#Button_5, 600, 180, 50, 30, "-")      : SetGadgetFont(#Button_5, FontID(1)) 
  TextGadget(#Text_3, 530, 230, 60, 15, "Latitude :")
  StringGadget(#String_0, 600, 230, 90, 20, "")
  TextGadget(#Text_4, 530, 250, 60, 15, "Longitude :")
  StringGadget(#String_1, 600, 250, 90, 20, "")
  
  Define Event.l,Gadget.l,Quit.b=#False
  Define pfValue.f
  OSM::SetLocation(49.04599,2.03347)
  OSM::SetLocation(49.0361165,2.0456982)
  
  

  Repeat
    Event = WaitWindowEvent()
    
    OSM::Event(Event)
    Select Event
      Case #PB_Event_CloseWindow : Quit = 1
      Case #PB_Event_Gadget ;{
        Gadget = EventGadget()
        Select Gadget
          Case #Button_4
            OSM::SetZoom(1)
          Case #Button_5
            OSM::SetZoom(-1)
        EndSelect
    EndSelect
  Until Quit = #True
EndIf
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

c'est pas mal ^_^

tient change la position avec celle là

Code : Tout sélectionner

 OSM::SetLocation(49.045998, 2.033442)
ça te permet d'avoir un point facilement reconnaissable. Il s'agit des coordonées exactes de la Tour Belvédère a Cergy. et donc la carte devrait être centré comme celle là
http://www.openstreetmap.org/node/11889 ... 4&layers=C
Répondre