;;************************************************************** ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module ; Author: Thyphoon, Djes And Idle ; Date: Mai 17, 2016 ; License: Free, unrestricted, credit appreciated ; but not required. ; Note: Please share improvement ! ; Thanks: Progi1984 ; Usage: Change the Proxy global variables if needed ; (see also Proxy Details) ;************************************************************** ;#Red = 255 CompilerIf #PB_Compiler_Thread = #False MessageRequester("Warning !!","You must enable ThreadSafe support in compiler options",#PB_MessageRequester_Ok ) End CompilerEndIf EnableExplicit InitNetwork() UsePNGImageDecoder() UsePNGImageEncoder() DeclareModule PBMap #Red = 255 ;-Show debug infos Global Verbose = 1 Global MyDebugLevel = 0; 3 ;-Proxy ON/OFF Global Proxy = #False #SCALE_NAUTICAL = 1 #SCALE_KM = 0 Declare InitPBMap(window) Declare SetMapServer(ServerURL.s = "http://tile.openstreetmap.org/", TileSize = 256, ZoomMin = 0, ZoomMax = 18) Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) Declare SetLocation(latitude.d, longitude.d, zoom = 15, mode.i = #PB_Absolute) Declare Drawing() Declare SetZoom(Zoom.i, mode.i = #PB_Relative) Declare ZoomToArea() Declare SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) Declare SetMapScaleUnit(ScaleUnit=PBMAP::#SCALE_KM) Declare LoadGpxFile(file.s); Declare AddMarker(Latitude.d,Longitude.d,color.l=-1, CallBackPointer.i = -1) Declare Quit() Declare Error(msg.s) Declare Refresh() Declare.d GetLatitude() Declare.d GetLongitude() Declare.i GetZoom() EndDeclareModule Module PBMap EnableExplicit Structure Location Longitude.d Latitude.d EndStructure Structure Position x.d y.d EndStructure Structure PixelPosition x.i y.i EndStructure ;- Tile Structure Structure Tile Position.Position PBMapTileX.i PBMapTileY.i PBMapZoom.i nImage.i key.s CacheFile.s GetImageThread.i RetryNb.i Layer.i EndStructure Structure TileBounds NorthWest.Position SouthEast.Position EndStructure Structure DrawingParameters Position.Position Bounds.TileBounds Canvas.i PBMapTileX.i PBMapTileY.i PBMapZoom.i TargetLocation.Location CenterX.i CenterY.i DeltaX.i DeltaY.i Dirty.i PassNB.i End.i EndStructure Structure TileThread *Tile.Tile GetImageThread.i EndStructure Structure ImgMemCach nImage.i *Tile.Tile ;Location.Location ;Mutex.i EndStructure Structure TileMemCach Map Images.ImgMemCach(4096) EndStructure Structure Marker Location.Location ; Marker latitude and longitude color.l ; Marker color CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) EndStructure Structure Option WheelMouseRelative.i ScaleUnit.i ; Scale unit to use for measurements EndStructure ;-PBMap Structure Structure PBMap Window.i ; Parent Window Gadget.i ; Canvas Gadget Id Font.i ; Font to uses when write on the map Timer.i TargetLocation.Location ; Latitude and Longitude from focus point Drawing.DrawingParameters ; Drawing parameters based on focus point ; CallBackLocation.i ; @Procedure(latitude.d,lontitude.d) CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) ; Position.PixelPosition ; Actual focus point coords in pixels (global) MoveStartingPoint.PixelPosition ; Start mouse position coords when dragging the map ; Array ServerURL.s(0) ; Web URL ex: http://tile.openstreetmap.org/ NumberOfMapLayers.i ; The number of map tile layers; ZoomMin.i ; Min Zoom supported by server ZoomMax.i ; Max Zoom supported by server Zoom.i ; Current zoom TileSize.i ; Tile size downloaded on the server ex : 256 ; HDDCachePath.S ; Path where to load and save tiles downloaded from server MemCache.TileMemCach ; Images in memory cache ; Redraw.i Moving.i Dirty.i ; To signal that drawing need a refresh ; MainDrawingThread.i TileThreadMutex.i; ;Mutex to protect resources List track.Location() ; To display a GPX track List Marker.Marker() ; To diplay marker EditMarkerIndex.l ImgLoading.i ;Image Loading Tile Options.option ; EndStructure #PB_MAP_REDRAW = #PB_EventType_FirstCustomValue + 1 #PB_MAP_RETRY = #PB_EventType_FirstCustomValue + 2 #PB_MAP_TILE_CLEANUP = #PB_EventType_FirstCustomValue + 3 ;-Global variables Global PBMap.PBMap, Null.i ;Shows an error msg and terminates the program Procedure Error(msg.s) MessageRequester("MapGadget", msg, #PB_MessageRequester_Ok) End EndProcedure ;Send debug infos to stdout (allowing mixed debug infos with curl or other libs) Procedure MyDebug(msg.s, DbgLevel = 0) If Verbose And MyDebugLevel >= DbgLevel PrintN(msg) ;Debug msg EndIf EndProcedure ;- *** CURL specific *** ; (program has To be compiled in console format for curl debug infos) IncludeFile "libcurl.pbi" ; https://github.com/deseven/pbsamples/tree/master/crossplatform/libcurl ;Curl write callback (needed for win32 dll) ProcedureC ReceiveHTTPWriteToFileFunction(*ptr, Size.i, NMemB.i, FileHandle.i) ProcedureReturn WriteData(FileHandle, *ptr, Size * NMemB) EndProcedure Procedure.i CurlReceiveHTTPToFile(URL$, DestFileName$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="") Protected *Buffer, curl.i, Timeout.i, res.i Protected FileHandle.i MyDebug("CurlReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + " " + ProxyPort$ + " " + ProxyUser$, 4) MyDebug(" to file : " + DestFileName$, 4) FileHandle = CreateFile(#PB_Any, DestFileName$) If FileHandle And Len(URL$) curl = curl_easy_init() If curl Timeout = 120 curl_easy_setopt(curl, #CURLOPT_URL, str2curl(URL$)) curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYPEER, 0) curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYHOST, 0) curl_easy_setopt(curl, #CURLOPT_HEADER, 0) curl_easy_setopt(curl, #CURLOPT_FOLLOWLOCATION, 1) curl_easy_setopt(curl, #CURLOPT_TIMEOUT, Timeout) curl_easy_setopt(curl, #CURLOPT_VERBOSE, 1) ;curl_easy_setopt(curl, #CURLOPT_CONNECTTIMEOUT, 60) If Len(ProxyURL$) ;curl_easy_setopt(curl, #CURLOPT_HTTPPROXYTUNNEL, #True) If Len(ProxyPort$) ProxyURL$ + ":" + ProxyPort$ EndIf MyDebug( ProxyURL$) curl_easy_setopt(curl, #CURLOPT_PROXY, str2curl(ProxyURL$)) If Len(ProxyUser$) If Len(ProxyPassword$) ProxyUser$ + ":" + ProxyPassword$ EndIf MyDebug( ProxyUser$) curl_easy_setopt(curl, #CURLOPT_PROXYUSERPWD, str2curl(ProxyUser$)) EndIf EndIf curl_easy_setopt(curl, #CURLOPT_WRITEDATA, FileHandle) curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToFileFunction()) res = curl_easy_perform(curl) If res <> #CURLE_OK MyDebug("CURL problem", 4) EndIf curl_easy_cleanup(curl) Else MyDebug("Can't init CURL", 4) EndIf CloseFile(FileHandle) ProcedureReturn FileSize(DestFileName$) EndIf ProcedureReturn #False EndProcedure ;- *** Procedure LoadingImageCreation() Protected Text$ = "Loading" PBmap\ImgLoading = CreateImage(#PB_Any, 256, 256) If PBmap\ImgLoading StartVectorDrawing(ImageVectorOutput(PBMap\Imgloading)) BeginVectorLayer() VectorSourceColor(RGBA(255, 255, 255, 128)) AddPathBox(0, 0, 256, 256) FillPath() MovePathCursor(0, 0) VectorFont(FontID(PBMap\Font), 256 / 20) VectorSourceColor(RGBA(150, 150, 150, 255)) MovePathCursor(0 + (256 - VectorTextWidth(Text$)) / 2, 0 + (256 - VectorTextHeight(Text$)) / 2) DrawVectorText(Text$) EndVectorLayer() StopVectorDrawing() EndIf EndProcedure Procedure InitPBMap(Window) Protected Result.i If Verbose OpenConsole() EndIf PBMap\HDDCachePath = GetTemporaryDirectory() PBMap\ZoomMin = 0 PBMap\ZoomMax = 18 PBMap\MoveStartingPoint\x = - 1 PBMap\TileSize = 256 PBMap\Dirty = #False PBMap\TileThreadMutex = CreateMutex() PBMap\EditMarkerIndex = -1 ;Initialised with "no marker selected" PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) PBMap\Window = Window PBMap\Timer = 1 PBMap\Options\WheelMouseRelative = #True SetMapServer("http://tile.openstreetmap.org/") ;-Preferences ;Use this to create and customize your preferences file for the first time ; CreatePreferences(GetHomeDirectory() + "PBMap.prefs") ; ;Or this to modify ; ;OpenPreferences(GetHomeDirectory() + "PBMap.prefs") ; ;Or this ; ;RunProgram("notepad.exe", GetHomeDirectory() + "PBMap.prefs", GetHomeDirectory()) ; PreferenceGroup("PROXY") ; WritePreferenceInteger("Proxy", #True) ; WritePreferenceString("ProxyURL", "myproxy.fr") ; WritePreferenceString("ProxyPort", "myproxyport") ; WritePreferenceString("ProxyUser", "myproxyname") ; WritePreferenceString("ProxyPass", "myproxypass") ;TODO !Warning! !not encoded! ; ClosePreferences() OpenPreferences(GetHomeDirectory() + "PBMap.prefs") PreferenceGroup("PROXY") Proxy = ReadPreferenceInteger("Proxy", #False) If Proxy Global ProxyURL$ = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "") Global ProxyPort$ = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "") Global ProxyUser$ = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "") Global ProxyPassword$ = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO EndIf ClosePreferences() curl_global_init(#CURL_GLOBAL_WIN32) LoadingImageCreation() EndProcedure Procedure SetMapServer(ServerURL.s = "http://tile.openstreetmap.org/", TileSize = 256, ZoomMin = 0, ZoomMax = 18) PBMAP\NumberOfMapLayers + 1 ReDim PBMap\ServerURL(PBMAP\NumberOfMapLayers) PBMap\ServerURL(PBMAP\NumberOfMapLayers-1) = ServerURL PBMap\ZoomMin = ZoomMin PBMap\ZoomMax = ZoomMax PBMap\TileSize = TileSize EndProcedure Procedure Quit() PBMap\Drawing\End = #True ;Wait for loading threads to finish nicely. Passed 2 seconds, kills them. Protected TimeCounter = ElapsedMilliseconds() Repeat ForEach PBMap\MemCache\Images() If PBMap\MemCache\Images()\Tile <> 0 If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) PBMap\MemCache\Images()\Tile\RetryNb = 0 If ElapsedMilliseconds() - TimeCounter > 2000 ;Should not occur KillThread(PBMap\MemCache\Images()\Tile\GetImageThread) EndIf Else FreeMemory(PBMap\MemCache\Images()\Tile) PBMap\MemCache\Images()\Tile = 0 EndIf Else DeleteMapElement(PBMap\MemCache\Images()) EndIf Next Delay(10) Until MapSize(PBMap\MemCache\Images()) = 0 curl_global_cleanup() EndProcedure 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.d Distance(x1.d, y1.d, x2.d, y2.d) Protected Result.d Result = Sqr( (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)) ProcedureReturn Result EndProcedure ;*** Converts coords to tile.decimal ;Warning, structures used in parameters are not tested Procedure LatLon2XY(*Location.Location, *Coords.Position) Protected n.d = Pow(2.0, PBMap\Zoom) Protected LatRad.d = Radian(*Location\Latitude) *Coords\x = n * ( (*Location\Longitude + 180.0) / 360.0) *Coords\y = n * ( 1.0 - Log(Tan(LatRad) + (1.0/Cos(LatRad))) / #PI ) / 2.0 MyDebug("Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)) MyDebug("Coords X : " + Str(*Coords\x) + " ; Y : " + Str(*Coords\y)) EndProcedure ;*** Converts tile.decimal to coords ;Warning, structures used in parameters are not tested Procedure XY2LatLon(*Coords.Position, *Location.Location) Protected n.d = Pow(2.0, PBMap\Zoom) Protected LatitudeRad.d *Location\Longitude = *Coords\x / n * 360.0 - 180.0 LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Coords\y / n))) *Location\Latitude = Degree(LatitudeRad) EndProcedure ; HaversineAlgorithm ; http://andrew.hedges.name/experiments/haversine/ Procedure.d HaversineInKM(*posA.Location, *posB.Location) Protected eQuatorialEarthRadius.d = 6378.1370;6372.795477598; Protected dlong.d = (*posB\Longitude - *posA\Longitude); Protected dlat.d = (*posB\Latitude - *posA\Latitude) ; Protected alpha.d=dlat/2 Protected beta.d=dlong/2 Protected a.d = Sin(Radian(alpha)) * Sin(Radian(alpha)) + Cos(Radian(*posA\Latitude)) * Cos(Radian(*posB\Latitude)) * Sin(Radian(beta)) * Sin(Radian(beta)) Protected c.d = ASin(Min(1,Sqr(a))); Protected distance.d = 2*eQuatorialEarthRadius * c ProcedureReturn distance ; EndProcedure Procedure.d HaversineInM(*posA.Location, *posB.Location) ProcedureReturn (1000 * HaversineInKM(@*posA,@*posB)); EndProcedure Procedure GetPixelCoordFromLocation(*Location.Location, *Pixel.PixelPosition) ; TODO to Optimize Protected mapWidth.l = Pow(2, PBMap\Zoom + 8) Protected mapHeight.l = Pow(2, PBMap\Zoom + 8) Protected x1.l,y1.l ; get x value x1 = (*Location\Longitude+180)*(mapWidth/360) ; convert from degrees To radians Protected latRad.d = *Location\Latitude*#PI/180; Protected mercN.d = Log(Tan((#PI/4)+(latRad/2))); y1 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)) ; Protected x2.l, y2.l ; get x value x2 = (PBMap\TargetLocation\Longitude+180)*(mapWidth/360) ; convert from degrees To radians latRad = PBMap\TargetLocation\Latitude*#PI/180; ; get y value mercN = Log(Tan((#PI/4)+(latRad/2))) y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); *Pixel\x=GadgetWidth(PBMap\Gadget)/2 - (x2-x1) *Pixel\y=GadgetHeight(PBMap\Gadget)/2 - (y2-y1) EndProcedure Procedure LoadGpxFile(file.s) If LoadXML(0, file.s) Protected Message.s If XMLStatus(0) <> #PB_XML_Success Message = "Error in the XML file:" + Chr(13) Message + "Message: " + XMLError(0) + Chr(13) Message + "Line: " + Str(XMLErrorLine(0)) + " Character: " + Str(XMLErrorPosition(0)) MessageRequester("Error", Message) EndIf Protected *MainNode,*subNode,*child,child.l *MainNode=MainXMLNode(0) *MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg") ClearList(PBMap\track()) For child = 1 To XMLChildCount(*MainNode) *child = ChildXMLNode(*MainNode, child) AddElement(PBMap\track()) If ExamineXMLAttributes(*child) While NextXMLAttribute(*child) Select XMLAttributeName(*child) Case "lat" PBMap\track()\Latitude=ValD(XMLAttributeValue(*child)) Case "lon" PBMap\track()\Longitude=ValD(XMLAttributeValue(*child)) EndSelect Wend EndIf Next EndIf EndProcedure ; Procedure LoadErrorHandler() ; MessageRequester("Error", "") ; EndProcedure Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i If FileSize(CacheFile) > 0 ; OnErrorCall(@LoadErrorHandler()) nImage = LoadImage(#PB_Any, CacheFile) ; OnErrorDefault() If IsImage(nImage) MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3) ProcedureReturn nImage Else MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3) MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3) EndIf Else MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3) EndIf ProcedureReturn -1 EndProcedure Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i, CacheFile.s, Layer.i) Protected *Buffer Protected nImage.i = -1 Protected FileSize.i, timg Protected TileURL.s = PBMap\ServerURL(Layer) + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png" If Proxy FileSize = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$) If FileSize > 0 MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) nImage = GetTileFromHDD(CacheFile) Else MyDebug("Problem loading from web " + TileURL, 3) EndIf Else *Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous If *Buffer nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer)) If IsImage(nImage) ; Debug "url: " + TileURL ; Debug "cache file: " + CacheFile ; timg = LoadImage(#PB_Any,CacheFile) ; If timg ; StartDrawing(ImageOutput(timg)) ; DrawImage(ImageID(nimage)) ; StopDrawing() ; SaveImage(timg, CacheFile, #PB_ImagePlugin_PNG) ; FreeImage(timg) ; Else If SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG, 0, 32) MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) Else MyDebug("Loaded from web " + TileURL + " but cannot save to CacheFile " + CacheFile, 3) EndIf FreeMemory(*Buffer) ; EndIf Else MyDebug("Can't catch image loaded from web " + TileURL, 3) nImage = -1 ;ShowMemoryViewer(*Buffer, MemorySize(*Buffer)) EndIf Else MyDebug(" Problem loading from web " + TileURL, 3) EndIf EndIf ProcedureReturn nImage EndProcedure Procedure GetImageThread(*Tile.Tile) Protected nImage.i = -1 Repeat nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, *Tile\CacheFile, *Tile\Layer) If nImage <> -1 MyDebug("Image key : " + *Tile\key + " web image loaded", 3) *Tile\RetryNb = 0 Else MyDebug("Image key : " + *Tile\key + " web image not correctly loaded", 3) Delay(1000) *Tile\RetryNb - 1 EndIf Until *Tile\RetryNb <= 0 *Tile\nImage = nImage *Tile\RetryNb = -2 ;End of the thread PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread EndProcedure Procedure.i GetTile(key.s, CacheFile.s, px.i, py.i, tilex.i, tiley.i, Layer.i) Protected timg = -1 If FindMapElement(PBMap\MemCache\Images(), key) MyDebug("Key : " + key + " found in memory cache!", 3) timg = PBMap\MemCache\Images()\nImage If timg <> -1 MyDebug("Image : " + timg + " found in memory cache!", 3) ProcedureReturn timg EndIf Else AddMapElement(PBMap\MemCache\Images(), key) MyDebug("Key : " + key + " added in memory cache!", 3) PBMap\MemCache\Images()\nImage = -1 EndIf If PBMap\MemCache\Images()\Tile = 0 ;Check if a loading thread is not running MyDebug("Trying to load from HDD " + CacheFile, 3) timg = GetTileFromHDD(CacheFile.s) If timg <> -1 MyDebug("Key : " + key + " found on HDD", 3) PBMap\MemCache\Images()\nImage = timg ProcedureReturn timg EndIf MyDebug("Key : " + key + " not found on HDD", 3) ;Launch a new thread Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) If *NewTile With *NewTile PBMap\MemCache\Images()\Tile = *NewTile ;New tile parameters \Position\x = px \Position\y = py \PBMapTileX = tilex \PBMapTileY = tiley \PBMapZoom = PBMap\Zoom \key = key \CacheFile = CacheFile \Layer = Layer \RetryNb = 5 \nImage = -1 MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 3) \GetImageThread = CreateThread(@GetImageThread(), *NewTile) EndWith Else MyDebug(" Error, can't create a new tile loading thread", 3) EndIf EndIf ProcedureReturn timg EndProcedure Procedure DrawTiles(*Drawing.DrawingParameters, Layer.i, alpha.i=255) ;DisableDebugger Protected x.i, y.i,kq.q Protected tx = Int(*Drawing\Position\x) ;Don't forget the Int() ! Protected ty = Int(*Drawing\Position\y) Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point Protected ny = *Drawing\CenterY / PBMap\TileSize Protected px, py, img, tilex,tiley, key.s, CacheFile.s MyDebug("Drawing tiles") For y = - ny - 1 To ny + 1 For x = - nx - 1 To nx + 1 ; If PBMap\Moving ;If drawing was threaded, this would exit the loop when the user is moving ; Break 2 ; EndIf px = *Drawing\CenterX + x * PBMap\TileSize - *Drawing\DeltaX py = *Drawing\CenterY + y * PBMap\TileSize - *Drawing\DeltaY tilex = ((tx+x) % (1< -1 MovePathCursor(px, py) DrawVectorImage(ImageID(img), alpha) Else MovePathCursor(px, py) DrawVectorImage(ImageID(PBMap\ImgLoading), alpha) EndIf Next Next EndProcedure ; ;-**** Clean Mem Cache ; ;TODO in development, by now there's many cache problem as the loading thread could be perturbed ; ;GadgetWidth(PBMap\Gadget)/PBMap\TileSize ; Protected MaxNbTile.l ; If GadgetWidth(PBMap\Gadget)>GadgetHeight(PBMap\Gadget) ; MaxNbTile=GadgetWidth(PBMap\Gadget)/PBMap\TileSize ; Else ; MaxNbTile=GadgetHeight(PBMap\Gadget)/PBMap\TileSize ; EndIf ; Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom) ; Protected Limit.d=Scale*(MaxNbTile)*1.5 ; Debug "Cache cleaning" ; ForEach PBMap\MemCache\Images() ; Protected Distance.d = HaversineInKM(@PBMap\MemCache\Images()\Location, @PBMap\TargetLocation) ; Debug "Limit:"+StrD(Limit)+" Distance:"+StrD(Distance) ; If Distance>Limit And IsImage(PBMap\MemCache\Images()\nImage) ; LockMutex(PBMap\MemCache\Images()\Mutex) ; Debug "delete" ; Debug PBMap\MemCache\Images() ; FreeImage(PBMap\MemCache\Images()\nImage) ; UnlockMutex(PBMap\MemCache\Images()\Mutex) ; FreeMutex(PBMap\MemCache\Images()\Mutex) ; DeleteMapElement(PBMap\MemCache\Images()) ; EndIf ; Next Procedure DrawPointer(*Drawing.DrawingParameters) If PBMap\CallBackMainPointer > 0 ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\CenterX, *Drawing\CenterY) Else VectorSourceColor(RGBA($FF, 0, 0, $FF)) MovePathCursor(*Drawing\CenterX, *Drawing\CenterY) AddPathLine(-8, -16, #PB_Path_Relative) AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) AddPathLine(-8, 16, #PB_Path_Relative) ;FillPath(#PB_Path_Preserve) ;ClipPath(#PB_Path_Preserve) AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) VectorSourceColor(RGBA($FF, 0, 0, $FF)) FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA($FF, 0, 0, $FF));RGBA(0, 0, 0, 255)) StrokePath(1) EndIf EndProcedure Procedure DrawScale(*Drawing.DrawingParameters,x,y,alpha=80) ;TODO Add Option and function to display Scale on Map Protected sunit.s Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom) / 2 Select PBMap\Options\ScaleUnit Case #SCALE_Nautical Scale * 0.539957 sunit = " Nm" Case #SCALE_KM; sunit = " Km" EndSelect VectorFont(FontID(PBMap\Font), 10) VectorSourceColor(RGBA(0, 0, 0,alpha)) MovePathCursor(x,y) DrawVectorText(StrD(Scale,3)+sunit) MovePathCursor(x,y+12) AddPathLine(x+128,y+10) StrokePath(1) EndProcedure Procedure DrawDegrees(*Drawing.DrawingParameters,alpha=192) Protected tx, ty, nx,ny,nx1,ny1,x,y,n,cx,dperpixel.d Protected pos1.PixelPosition,pos2.PixelPosition,Degrees1.Location,degrees2.Location tx = *Drawing\Position\x ty = *Drawing\Position\y nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point ny = *Drawing\CenterY / PBMap\TileSize *Drawing\Bounds\NorthWest\x = tx-nx-1 *Drawing\Bounds\NorthWest\y = ty-ny-1 *Drawing\Bounds\SouthEast\x = tx+nx+1 *Drawing\Bounds\SouthEast\y = ty+ny+1 VectorFont(FontID(PBMap\Font), 10) VectorSourceColor(RGBA(0, 0, 0,alpha)) XY2LatLon(*Drawing\Bounds\NorthWest, @Degrees1) XY2LatLon(*Drawing\Bounds\SouthEast, @Degrees2) nx = Round(Degrees1\Longitude, #PB_Round_Down)-1 ny = Round(Degrees1\Latitude, #PB_Round_Up) +1 nx1 = Round(Degrees2\Longitude, #PB_Round_Up) +1 ny1 = Round(Degrees2\Latitude, #PB_Round_Down)-1 GetPixelCoordFromLocation(@Degrees2, @pos2) x = nx For y = ny1 To ny Degrees1\Longitude = x Degrees1\Latitude = y GetPixelCoordFromLocation(@Degrees1, @pos1) MovePathCursor(pos1\x, pos1\y) AddPathLine( pos2\x, pos1\y) MovePathCursor(10,pos1\y) DrawVectorText(StrD(0-(90-Mod((y+90),180)),1)) Next y = ny For x = nx To nx1 Degrees1\Longitude = x Degrees1\Latitude = y GetPixelCoordFromLocation(@Degrees1, @pos1) MovePathCursor(pos1\x, pos1\y) AddPathLine( pos1\x, pos2\y) MovePathCursor(pos1\x,10) DrawVectorText(StrD(0-(180-Mod((x+180),360)),1)) Next StrokePath(1) EndProcedure Procedure TrackPointer(x.i, y.i,dist.l) Protected color.l color=RGBA(0, 0, 0, 255) MovePathCursor(x,y) AddPathLine(-8,-16,#PB_Path_Relative) AddPathLine(16,0,#PB_Path_Relative) AddPathLine(-8,16,#PB_Path_Relative) VectorSourceColor(color) AddPathCircle(x,y-20,14) FillPath() VectorSourceColor(RGBA(255, 255, 255, 255)) AddPathCircle(x,y-20,12) FillPath() VectorFont(FontID(PBMap\Font), 13) MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-20-VectorTextHeight(Str(dist))/2) VectorSourceColor(RGBA(0, 0, 0, 255)) DrawVectorText(Str(dist)) EndProcedure Procedure DrawTrack(*Drawing.DrawingParameters) Protected Pixel.PixelPosition Protected Location.Location Protected km.f, memKm.i If ListSize(PBMap\track())>0 ;Trace Track ForEach PBMap\track() If *Drawing\TargetLocation\Latitude<>0 And *Drawing\TargetLocation\Longitude<>0 GetPixelCoordFromLocation(@PBMap\track(),@Pixel) If ListIndex(PBMap\track())=0 MovePathCursor(Pixel\X, Pixel\Y) Else AddPathLine(Pixel\X, Pixel\Y) EndIf EndIf Next VectorSourceColor(RGBA(0, 255, 0, 150)) StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner) ;Draw Distance ForEach PBMap\track() ;-Test Distance If ListIndex(PBMap\track())=0 Location\Latitude=PBMap\track()\Latitude Location\Longitude=PBMap\track()\Longitude Else km=km+HaversineInKM(@Location,@PBMap\track()) ;<- display Distance Location\Latitude=PBMap\track()\Latitude Location\Longitude=PBMap\track()\Longitude EndIf GetPixelCoordFromLocation(@PBMap\track(),@Pixel) If Int(km)<>memKm memKm=Int(km) If PBMap\Zoom>10 BeginVectorLayer() TrackPointer(Pixel\X , Pixel\Y,Int(km)) EndVectorLayer() EndIf EndIf Next EndIf EndProcedure ; Add a Marker To the Map Procedure AddMarker(Latitude.d,Longitude.d,color.l=-1, CallBackPointer.i = -1) AddElement(PBMap\Marker()) PBMap\Marker()\Location\Latitude = Latitude PBMap\Marker()\Location\Longitude = Mod(Longitude+360,360) Debug PBMap\Marker()\Location\Longitude Debug PBMap\Marker()\Location\Latitude PBMap\Marker()\color=color PBMap\Marker()\CallBackPointer = CallBackPointer drawing() EndProcedure ; Draw all markers on the screen ! Procedure DrawMarkers(*Drawing.DrawingParameters) Protected Pixel.PixelPosition ForEach PBMap\Marker() If PBMap\Marker()\Location\Latitude <> 0 And PBMap\Marker()\Location\Longitude <> 0 GetPixelCoordFromLocation(PBMap\Marker()\Location, @Pixel) If Pixel\X >= 0 And Pixel\Y >= 0 And Pixel\X < GadgetWidth(PBMap\Gadget) And Pixel\Y < GadgetHeight(PBMap\Gadget) ; Only if visible ^_^ If PBMap\Marker()\CallBackPointer > 0 CallFunctionFast(PBMap\Marker()\CallBackPointer, Pixel\X, Pixel\Y) Else DrawPointer(*Drawing) EndIf EndIf EndIf Next EndProcedure ;-*** Main drawing Procedure Drawing() Protected *Drawing.DrawingParameters = @PBMap\Drawing Protected Px.d, Py.d,a PBMap\Dirty = #False PBMap\Redraw = #False ;Precalc some values *Drawing\CenterX = GadgetWidth(PBMap\Gadget) / 2 *Drawing\CenterY = GadgetHeight(PBMap\Gadget) / 2 ;Pixel shift, aka position in the tile Px = *Drawing\Position\x : Py = *Drawing\Position\y *Drawing\DeltaX = Px * PBMap\TileSize - (Int(Px) * PBMap\TileSize) ;Don't forget the Int() ! *Drawing\DeltaY = Py * PBMap\TileSize - (Int(Py) * PBMap\TileSize) *Drawing\TargetLocation\Latitude = PBMap\TargetLocation\Latitude *Drawing\TargetLocation\Longitude = PBMap\TargetLocation\Longitude ;Main drawing stuff StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) ;TODO add in layers of tiles ;this way we can cache them as 0 base 1.n layers ;such as for openseamap tiles which are overlaid. not that efficent from here though. For a = 0 To PBMap\NumberOfMapLayers - 1 DrawTiles(*Drawing, a) Next DrawTrack(*Drawing) DrawMarkers(*Drawing) DrawPointer(*Drawing) ;- Display how many images in cache VectorFont(FontID(PBMap\Font), 30) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(50,50) DrawVectorText(Str(MapSize(PBMap\MemCache\Images()))) MovePathCursor(50,80) Protected ThreadCounter = 0 ForEach PBMap\MemCache\Images() If PBMap\MemCache\Images()\Tile <> 0 If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) ThreadCounter + 1 EndIf EndIf Next DrawVectorText(Str(ThreadCounter)) DrawDegrees(*Drawing, 192) ;If PBMap\Options\ShowScale DrawScale(*Drawing,10,GadgetHeight(PBMAP\Gadget)-20,192) ;EndIf StopVectorDrawing() EndProcedure Procedure Refresh() Drawing() EndProcedure Procedure SetLocation(latitude.d, longitude.d, zoom = 15, Mode.i = #PB_Absolute) Select Mode Case #PB_Absolute PBMap\TargetLocation\Latitude = latitude PBMap\TargetLocation\Longitude = longitude PBMap\Zoom = zoom Case #PB_Relative PBMap\TargetLocation\Latitude + latitude PBMap\TargetLocation\Longitude + longitude PBMap\Zoom + zoom EndSelect If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing) ;Convert X, Y in tile.decimal into real pixels PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize PBMap\Drawing\PassNb = 1 Drawing() If PBMap\CallBackLocation > 0 CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) EndIf EndProcedure Procedure ZoomToArea() ;Source => http://gis.stackexchange.com/questions/19632/how-to-calculate-the-optimal-zoom-level-to-display-two-or-more-points-on-a-map ;bounding box in long/lat coords (x=long, y=lat) Protected MinY.d,MaxY.d,MinX.d,MaxX.d ForEach PBMap\track() If ListIndex(PBMap\track())=0 Or PBMap\track()\LongitudeMaxX MaxX=PBMap\track()\Longitude EndIf If ListIndex(PBMap\track())=0 Or PBMap\track()\LatitudeMaxY MaxY=PBMap\track()\Latitude EndIf Next Protected DeltaX.d=MaxX-MinX ;assumption ! In original code DeltaX have no source Protected centerX.d=MinX+DeltaX/2 ; assumption ! In original code CenterX have no source Protected paddingFactor.f= 1.2 ;paddingFactor: this can be used to get the "120%" effect ThomM refers to. Value of 1.2 would get you the 120%. Protected ry1.d = Log((Sin(Radian(MinY)) + 1) / Cos(Radian(MinY))) Protected ry2.d = Log((Sin(Radian(MaxY)) + 1) / Cos(Radian(MaxY))) Protected ryc.d = (ry1 + ry2) / 2 Protected centerY.d = Degree(ATan(SinH(ryc))) Protected resolutionHorizontal.d = DeltaX / GadgetWidth(PBMap\Gadget) Protected vy0.d = Log(Tan(#PI*(0.25 + centerY/360))); Protected vy1.d = Log(Tan(#PI*(0.25 + MaxY/360))) ; Protected viewHeightHalf.d = GadgetHeight(PBMap\Gadget)/2; Protected zoomFactorPowered.d = viewHeightHalf / (40.7436654315252*(vy1 - vy0)) Protected resolutionVertical.d = 360.0 / (zoomFactorPowered * PBMap\TileSize) If resolutionHorizontal<>0 And resolutionVertical<>0 Protected resolution.d = Max(resolutionHorizontal, resolutionVertical)* paddingFactor Protected zoom.d = Log(360 / (resolution * PBMap\TileSize))/Log(2) Protected lon.d = centerX; Protected lat.d = centerY; SetLocation(lat,lon, Round(zoom,#PB_Round_Down)) Else SetLocation(PBMap\TargetLocation\Latitude,PBMap\TargetLocation\Longitude, 15) EndIf EndProcedure Procedure SetZoom(Zoom.i, mode.i = #PB_Relative) Select mode Case #PB_Relative PBMap\Zoom = PBMap\Zoom + zoom Case #PB_Absolute PBMap\Zoom = zoom EndSelect If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing) ;Convert X, Y in tile.decimal into real pixels PBMap\Position\X = PBMap\Drawing\Position\x * PBMap\TileSize PBMap\Position\Y = PBMap\Drawing\Position\y * PBMap\TileSize ;First drawing Drawing() If PBMap\CallBackLocation > 0 CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) EndIf EndProcedure Procedure SetCallBackLocation(CallBackLocation.i) PBMap\CallBackLocation = CallBackLocation EndProcedure Procedure SetCallBackMainPointer(CallBackMainPointer.i) PBMap\CallBackMainPointer = CallBackMainPointer EndProcedure Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM) PBMap\Options\ScaleUnit = ScaleUnit Drawing() EndProcedure ;Zoom on x, y position relative to the canvas gadget Procedure SetZoomOnPosition(x, y, zoom) Protected MouseX.d, MouseY.d Protected OldPx.d, OldPy.d, OldMx.d, OldMy.d ;Fast and dirty code OldPx = PBMap\Position\x : OldPy = PBMap\Position\y OldMx = OldPx + GadgetWidth(PBMap\Gadget) / 2 - x OldMy = OldPy + GadgetHeight(PBMap\Gadget) / 2 - y PBMap\Zoom = PBMap\Zoom + zoom If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf ;Centered Zoom LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing) ;Convert X, Y in tile.decimal into real pixels PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize MouseX = PBMap\Position\x + GadgetWidth(PBMap\Gadget) / 2 - x MouseY = PBMap\Position\y + GadgetHeight(PBMap\Gadget) / 2 - y ;Cross-multiply to get the new center PBMap\Position\x = (OldPx * MouseX) / OldMx PBMap\Position\y = (OldPy * MouseY) / OldMy ;PBMap tile position in tile.decimal PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize PBMap\Drawing\PassNb = 1 XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) ;Start drawing Drawing() ;If CallBackLocation send Location to function If PBMap\CallBackLocation > 0 CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) EndIf EndProcedure Procedure.d GetLatitude() ProcedureReturn 0-(90-Mod((PBMap\TargetLocation\Latitude+90),180)) EndProcedure Procedure.d GetLongitude() ProcedureReturn 0-(180-Mod((PBMap\TargetLocation\Longitude+180),360)) EndProcedure Procedure.i GetZoom() Protected Value.d Value = PBMap\Zoom ProcedureReturn Value EndProcedure Procedure CanvasEvents() Protected MouseX.i, MouseY.i Protected Marker.Position, *Tile.Tile PBMap\Moving = #False Select EventType() Case #PB_EventType_MouseWheel If PBMap\Options\WheelMouseRelative ;Relative zoom (centered on the mouse) SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) Else ;Absolute zoom (centered on the center of the map) SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative) EndIf Case #PB_EventType_LeftButtonDown ;Check if we select a marker MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) MouseY = PBMap\Position\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) ForEach PBMap\Marker() LatLon2XY(@PBMap\Marker()\Location, @Marker) Marker\x * PBMap\TileSize Marker\y * PBMap\TileSize If Distance(Marker\x, Marker\y, MouseX, MouseY) < 8 PBMap\EditMarkerIndex = ListIndex(PBMap\Marker()) Break EndIf Next ;Mem cursor Coord PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) Case #PB_EventType_MouseMove PBMap\Moving = #True If PBMap\MoveStartingPoint\x <> - 1 MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y ;Move marker If PBMap\EditMarkerIndex > -1 SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex) LatLon2XY(@PBMap\Marker()\Location, @Marker) Marker\x + MouseX / PBMap\TileSize Marker\y + MouseY / PBMap\TileSize XY2LatLon(@Marker, @PBMap\Marker()\Location) Else ;New move values PBMap\Position\x - MouseX PBMap\Position\y - MouseY ;PBMap tile position in tile.decimal PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize PBMap\Drawing\PassNb = 1 XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) ;If CallBackLocation send Location to function If PBMap\CallBackLocation > 0 CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) EndIf EndIf PBMap\Redraw = #True PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) EndIf Case #PB_EventType_LeftButtonUp PBMap\MoveStartingPoint\x = - 1 If PBMap\EditMarkerIndex > -1 PBMap\EditMarkerIndex = -1 Else ;Move Map PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize MyDebug("PBMap\Drawing\Position\x " + Str(PBMap\Drawing\Position\x) + " ; PBMap\Drawing\Position\y " + Str(PBMap\Drawing\Position\y) ) XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) PBMap\Redraw = #True EndIf Case #PB_MAP_REDRAW Debug "Redraw" PBMap\Redraw = #True Case #PB_MAP_RETRY Debug "Reload" PBMap\Redraw = #True Case #PB_MAP_TILE_CLEANUP *Tile = EventData() ;After a Web tile loading thread, clean the tile structure memory and set the image nb in the cache ;avoid to have threads accessing vars (and avoid mutex), see GetImageThread() Protected timg = PBMap\MemCache\Images(*Tile\key)\Tile\nImage PBMap\MemCache\Images(*Tile\key)\nImage = timg FreeMemory(PBMap\MemCache\Images(*Tile\key)\Tile) PBMap\MemCache\Images(*Tile\key)\Tile = 0 PBMap\Redraw = #True EndSelect EndProcedure Procedure TimerEvents() ;Redraw at regular intervals If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) Drawing() EndIf EndProcedure Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) If Gadget = #PB_Any PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ;#PB_Canvas_Keyboard has to be set for mousewheel to work on windows Else PBMap\Gadget = Gadget CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) EndIf BindGadgetEvent(PBMap\Gadget, @CanvasEvents()) AddWindowTimer(PBMap\Window, PBMap\Timer, 20) BindEvent(#PB_Event_Timer, @TimerEvents()) EndProcedure EndModule ;-Exemple CompilerIf #PB_Compiler_IsMainFile InitNetwork() Enumeration #Window_0 #Map #Gdt_Left #Gdt_Right #Gdt_Up #Gdt_Down #Button_4 #Button_5 #Combo_0 #Text_0 #Text_1 #Text_2 #Text_3 #Text_4 #String_0 #String_1 #Gdt_LoadGpx #Gdt_AddMarker EndEnumeration Structure Location Longitude.d Latitude.d EndStructure Procedure UpdateLocation(*Location.Location) SetGadgetText(#String_0, StrD(0-(90-Mod((*Location\Latitude+90),180)))) SetGadgetText(#String_1, StrD(0-(180-Mod((*Location\Longitude+180),360)))) ProcedureReturn 0 EndProcedure Procedure MyPointer(x.i, y.i) Protected color.l color=RGBA(0, 255, 0, 255) VectorSourceColor(color) MovePathCursor(x, y) AddPathLine(-16,-32,#PB_Path_Relative) AddPathCircle(16,0,16,180,0,#PB_Path_Relative) AddPathLine(-16,32,#PB_Path_Relative) VectorSourceColor(color) FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA(0, 0, 0, 255)):StrokePath(1) EndProcedure Procedure MainPointer(x.i, y.i) VectorSourceColor(RGBA(255, 255,255, 255)) : AddPathCircle(x, y,32) : StrokePath(1) VectorSourceColor(RGBA(0, 0, 0, 255)) : AddPathCircle(x, y, 29):StrokePath(2) EndProcedure Procedure ResizeAll() ResizeGadget(#Map,10,10,WindowWidth(#Window_0)-198,WindowHeight(#Window_0)-59) ResizeGadget(#Text_1,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_Left, WindowWidth(#Window_0) - 150 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_Right,WindowWidth(#Window_0) - 90 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_Up, WindowWidth(#Window_0) - 120 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_Down, WindowWidth(#Window_0) - 120 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_2,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Button_4,WindowWidth(#Window_0)-150,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Button_5,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_3,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#String_0,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#String_1,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_4,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_AddMarker,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_LoadGpx,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) PBMap::Refresh() EndProcedure ;- MAIN TEST If OpenWindow(#Window_0, 260, 225, 700, 571, "PBMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_SizeGadget) LoadFont(0, "Arial", 12) LoadFont(1, "Arial", 12, #PB_Font_Bold) TextGadget(#Text_1, 530, 50, 60, 15, "Movements") ButtonGadget(#Gdt_Left, 550, 100, 30, 30, Chr($25C4)) : SetGadgetFont(#Gdt_Left, FontID(0)) ButtonGadget(#Gdt_Right, 610, 100, 30, 30, Chr($25BA)) : SetGadgetFont(#Gdt_Right, FontID(0)) ButtonGadget(#Gdt_Up, 580, 070, 30, 30, Chr($25B2)) : SetGadgetFont(#Gdt_Up, FontID(0)) ButtonGadget(#Gdt_Down, 580, 130, 30, 30, Chr($25BC)) : SetGadgetFont(#Gdt_Down, 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, "") ButtonGadget(#Gdt_AddMarker, 530, 280, 150, 30, "Add Marker") ButtonGadget(#Gdt_LoadGpx, 530, 310, 150, 30, "Load GPX") Define Event.i, Gadget.i, Quit.b = #False Define pfValue.d ;Our main gadget PBMap::InitPBMap(#Window_0) PBMap::MapGadget(#Map, 10, 10, 512, 512) PBMap::SetCallBackMainPointer(@MainPointer()) ;To change the Main Pointer PBMap::SetCallBackLocation(@UpdateLocation()) PBMap::SetLocation(-36.81148,175.08634,12) PBMap::SetMapServer("http://t1.openseamap.org/seamark/") ;add a special osm overlay map PBMAP::SetMapScaleUnit(PBMAP::#SCALE_NAUTICAL) PBMap::AddMarker(49.0446828398, 2.0349812508, -1, @MyPointer()) Repeat Event = WaitWindowEvent() Select Event Case #PB_Event_CloseWindow : Quit = 1 Case #PB_Event_Gadget ;{ Gadget = EventGadget() Select Gadget Case #Gdt_Up PBMap::SetLocation(10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative) Case #Gdt_Down PBMap::SetLocation(10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative) Case #Gdt_Left PBMap::SetLocation(0, 10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative) Case #Gdt_Right PBMap::SetLocation(0, 10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative) Case #Button_4 PBMap::SetZoom(1) Case #Button_5 PBMap::SetZoom( - 1) Case #Gdt_LoadGpx PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "*.gpx", 0)) PBMap::ZoomToArea() ; <-To center the view, and zoom on the tracks Case #Gdt_AddMarker PBMap:: AddMarker(ValD(GetGadgetText(#String_0)), ValD(GetGadgetText(#String_1)), RGBA(Random(255), Random(255), Random(255),255),@MyPointer()) EndSelect Case #PB_Event_SizeWindow ResizeAll() EndSelect Until Quit = #True PBMap::Quit() EndIf CompilerEndIf ; IDE Options = PureBasic 5.50 (Windows - x64) ; CursorPosition = 1299 ; FirstLine = 1256 ; Folding = --------- ; EnableThread ; EnableXP ; DisableDebugger ; EnableUnicode