PureBasic

Forums PureBasic
Nous sommes le Jeu 29/Oct/2020 23:19

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 218 messages ]  Aller à la page 1, 2, 3, 4, 5 ... 15  Suivante
Auteur Message
 Sujet du message: PBMap - Cartes OSM, Here, Geoserver dans un Canvas
MessagePosté: Mar 05/Juil/2016 6:50 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
*** 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 inclus dans pbmap.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:
#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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 12:04 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
ça ne marche pas mieux, mais voilà un code plus claire ...
Code:
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 13:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 9027
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 :. Tour + portable W10 x64 PB 5.6x / 5.7x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 13:14 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 14:14 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4233
Localisation: Arras, France
En parlant d'OSM, un pote vient juste de me parler de ça : http://leafletjs.com/
(je vais jeter un oeil à ton code)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 14:17 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4233
Localisation: Arras, France
C'est quelle version de PB ? Tu peux filer le code pour le proxy ?


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 15:13 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
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:
;*********************************************
;***** 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





Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 15:49 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6874
Localisation: IDF (Yvelines)
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.

_________________

➽ Config PureBasic : Windows 10 Version 64 Bits - DirectX 11 - PB 5.72

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 16:24 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4233
Localisation: Arras, France
Pour l'instant j'ai des soucis de proxy, c'est pas gagné :/


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 18:23 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
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 ?


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 18:45 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4233
Localisation: Arras, France
Oui, mais je regarderai demain


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mar 05/Juil/2016 19:02 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
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)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mer 06/Juil/2016 13:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
Une piste ici ...
https://help.openstreetmap.org/questions/747/given-a-latlon-how-do-i-find-the-precise-position-on-the-tile
Code:
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:
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mer 06/Juil/2016 16:17 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4233
Localisation: Arras, France
J'en suis là pour l'instant :
Code:
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: OpenStreetMap dans un Canvas
MessagePosté: Mer 06/Juil/2016 19:19 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 25/Aoû/2004 6:31
Messages: 2637
Localisation: Eragny
c'est pas mal ^_^

tient change la position avec celle là
Code:
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


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 218 messages ]  Aller à la page 1, 2, 3, 4, 5 ... 15  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 14 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye