New marker with legend by yves86 + colour options wip

This commit is contained in:
djes
2016-09-25 18:49:36 +02:00
parent 90f3d8a6a5
commit a79c06299b

144
PBMap.pb
View File

@@ -143,6 +143,7 @@ Module PBMap
CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
EndStructure EndStructure
;-Options
Structure Option Structure Option
HDDCachePath.s ; Path where to load and save tiles downloaded from server HDDCachePath.s ; Path where to load and save tiles downloaded from server
DefaultOSMServer.s ; Base layer OSM server DefaultOSMServer.s ; Base layer OSM server
@@ -157,13 +158,15 @@ Module PBMap
ShowDebugInfos.i ShowDebugInfos.i
ShowScale.i ShowScale.i
ShowTrack.i ShowTrack.i
ShowTrackKms.i
ShowMarkers.i ShowMarkers.i
ShowPointer.i ShowPointer.i
TimerInterval.i TimerInterval.i
MaxMemCache.i ; in MiB MaxMemCache.i ; in MiB
TrackShowKms.i
ShowMarkersNb.i ShowMarkersNb.i
ShowMarkersLegend.i ShowMarkersLegend.i
;Colours
ColourFocus.i
EndStructure EndStructure
Structure Layer Structure Layer
@@ -348,6 +351,27 @@ Module PBMap
EndSelect EndSelect
EndMacro EndMacro
Procedure.i ColourString2Value(Value.s)
;TODO : better string check
Protected Col.s = RemoveString(Value, " ")
If Left(Col, 1) = "$"
Protected r.i, g.i, b.i, a.i = 255
Select Len(Col)
Case 4 ;RGB (eg : "$9BC"
r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1))
Case 5 ;RGBA (eg : "$9BC5")
r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1)) : a = Val("$"+Mid(Col, 5, 1))
Case 7 ;RRGGBB (eg : "$95B4C2")
r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2))
Case 9 ;RRGGBBAA (eg : "$95B4C249")
r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2)) : a = Val("$"+Mid(Col, 8, 2))
EndSelect
ProcedureReturn RGBA(r, g, b, a)
Else
ProcedureReturn Val(Value)
EndIf
EndProcedure
Procedure SetOption(Option.s, Value.s) Procedure SetOption(Option.s, Value.s)
Option = StringCheck(Option) Option = StringCheck(Option)
Select LCase(Option) Select LCase(Option)
@@ -381,8 +405,10 @@ Module PBMap
SelBool(ShowMarkersNb) SelBool(ShowMarkersNb)
Case "showmarkerslegend" Case "showmarkerslegend"
SelBool(ShowMarkersLegend) SelBool(ShowMarkersLegend)
Case "trackshowkms" Case "showtrackkms"
SelBool(TrackShowKms) SelBool(ShowTrackKms)
Case "colourfocus"
PBMap\Options\ColourFocus = ColourString2Value(Value)
EndSelect EndSelect
EndProcedure EndProcedure
@@ -393,28 +419,32 @@ Module PBMap
Else Else
CreatePreferences(PreferencesFile) CreatePreferences(PreferencesFile)
EndIf EndIf
With PBMap\Options
PreferenceGroup("PROXY") PreferenceGroup("PROXY")
WritePreferenceInteger("Proxy", PBMap\Options\Proxy) WritePreferenceInteger("Proxy", \Proxy)
WritePreferenceString("ProxyURL", PBMap\Options\ProxyURL) WritePreferenceString("ProxyURL", \ProxyURL)
WritePreferenceString("ProxyPort", PBMap\Options\ProxyPort) WritePreferenceString("ProxyPort", \ProxyPort)
WritePreferenceString("ProxyUser", PBMap\Options\ProxyUser) WritePreferenceString("ProxyUser", \ProxyUser)
PreferenceGroup("URL") PreferenceGroup("URL")
WritePreferenceString("DefaultOSMServer", PBMap\Options\DefaultOSMServer) WritePreferenceString("DefaultOSMServer", \DefaultOSMServer)
PreferenceGroup("PATHS") PreferenceGroup("PATHS")
WritePreferenceString("TilesCachePath", PBMap\Options\HDDCachePath) WritePreferenceString("TilesCachePath", \HDDCachePath)
PreferenceGroup("OPTIONS") PreferenceGroup("OPTIONS")
WritePreferenceInteger("WheelMouseRelative", PBMap\Options\WheelMouseRelative) WritePreferenceInteger("WheelMouseRelative", \WheelMouseRelative)
WritePreferenceInteger("MaxMemCache", PBMap\Options\MaxMemCache) WritePreferenceInteger("MaxMemCache", \MaxMemCache)
WritePreferenceInteger("ShowDegrees", PBMap\Options\ShowDegrees) WritePreferenceInteger("ShowDegrees", \ShowDegrees)
WritePreferenceInteger("ShowDebugInfos", PBMap\Options\ShowDebugInfos) WritePreferenceInteger("ShowDebugInfos", \ShowDebugInfos)
WritePreferenceInteger("ShowScale", PBMap\Options\ShowScale) WritePreferenceInteger("ShowScale", \ShowScale)
WritePreferenceInteger("ShowMarkers", PBMap\Options\ShowMarkers) WritePreferenceInteger("ShowMarkers", \ShowMarkers)
WritePreferenceInteger("ShowPointer", PBMap\Options\ShowPointer) WritePreferenceInteger("ShowPointer", \ShowPointer)
WritePreferenceInteger("ShowTrack", PBMap\Options\ShowTrack) WritePreferenceInteger("ShowTrack", \ShowTrack)
WritePreferenceInteger("ShowMarkersNb", PBMap\Options\ShowMarkersNb) WritePreferenceInteger("ShowTrackKms", \ShowTrackKms)
WritePreferenceInteger("ShowMarkersLegend", PBMap\Options\ShowMarkersLegend) WritePreferenceInteger("ShowMarkersNb", \ShowMarkersNb)
WritePreferenceInteger("TrackShowKms", PBMap\Options\TrackShowKms) WritePreferenceInteger("ShowMarkersLegend", \ShowMarkersLegend)
;Colours;
WritePreferenceInteger("ColourFocus", \ColourFocus)
ClosePreferences() ClosePreferences()
EndWith
EndProcedure EndProcedure
Procedure LoadOptions(PreferencesFile.s = "PBMap.prefs") Procedure LoadOptions(PreferencesFile.s = "PBMap.prefs")
@@ -436,33 +466,37 @@ Module PBMap
; WritePreferenceString("ProxyUser", "myproxyname") ; WritePreferenceString("ProxyUser", "myproxyname")
; WritePreferenceString("ProxyPass", "myproxypass") ;TODO !Warning! !not encoded! ; WritePreferenceString("ProxyPass", "myproxypass") ;TODO !Warning! !not encoded!
; ClosePreferences() ; ClosePreferences()
With PBMap\Options
PreferenceGroup("PROXY") PreferenceGroup("PROXY")
PBMap\Options\Proxy = ReadPreferenceInteger("Proxy", #False) \Proxy = ReadPreferenceInteger("Proxy", #False)
If PBMap\Options\Proxy If \Proxy
PBMap\Options\ProxyURL = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "") \ProxyURL = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
PBMap\Options\ProxyPort = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "") \ProxyPort = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
PBMap\Options\ProxyUser = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "") \ProxyUser = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
PBMap\Options\ProxyPassword = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO \ProxyPassword = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO
EndIf EndIf
PreferenceGroup("URL") PreferenceGroup("URL")
PBMap\Options\DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/") \DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/")
PreferenceGroup("PATHS") PreferenceGroup("PATHS")
PBMap\Options\HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory()) \HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory())
PreferenceGroup("OPTIONS") PreferenceGroup("OPTIONS")
PBMap\Options\WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True)
PBMap\Options\MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory
PBMap\Options\ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False) \ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False)
PBMap\Options\ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False) \ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False)
PBMap\Options\ShowScale = ReadPreferenceInteger("ShowScale", #False) \ShowScale = ReadPreferenceInteger("ShowScale", #False)
PBMap\Options\ShowMarkers = ReadPreferenceInteger("ShowMarkers", #True) \ShowMarkers = ReadPreferenceInteger("ShowMarkers", #True)
PBMap\Options\ShowPointer = ReadPreferenceInteger("ShowPointer", #True) \ShowPointer = ReadPreferenceInteger("ShowPointer", #True)
PBMap\Options\ShowTrack = ReadPreferenceInteger("ShowTrack", #True) \ShowTrack = ReadPreferenceInteger("ShowTrack", #True)
PBMap\Options\ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True) \ShowTrackKms = ReadPreferenceInteger("ShowTrackKms", #False)
PBMap\Options\ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False) \ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True)
PBMap\Options\TrackShowKms = ReadPreferenceInteger("TrackShowKms", #False) \ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False)
PBMap\Options\TimerInterval = 20 \TimerInterval = 20
PreferenceGroup("COLOURS")
\ColourFocus = ReadPreferenceInteger("ColourFocus", RGBA(255, 255, 0, 255))
ClosePreferences() ClosePreferences()
EndWith
EndProcedure EndProcedure
Procedure InitPBMap(Window) Procedure InitPBMap(Window)
@@ -1041,7 +1075,7 @@ Module PBMap
EndVectorLayer() EndVectorLayer()
EndIf EndIf
;Draw Distance ;Draw Distance
If PBMap\Options\TrackShowKms And ListSize(PBMap\TracksList()) > 0 If PBMap\Options\ShowTrackKms And ListSize(PBMap\TracksList()) > 0
BeginVectorLayer() BeginVectorLayer()
ForEach PBMap\TracksList() ForEach PBMap\TracksList()
km = 0 : memKm = -1 km = 0 : memKm = -1
@@ -1069,6 +1103,7 @@ Module PBMap
EndProcedure EndProcedure
Procedure DrawMarker(x.i, y.i, Nb, Color.l, Legend.s, Focus.i, Selected.i) Procedure DrawMarker(x.i, y.i, Nb, Color.l, Legend.s, Focus.i, Selected.i)
;Nice marker by yves86
VectorSourceColor(color) VectorSourceColor(color)
MovePathCursor(x, y) MovePathCursor(x, y)
AddPathLine(-8, -16, #PB_Path_Relative) AddPathLine(-8, -16, #PB_Path_Relative)
@@ -1080,10 +1115,10 @@ Module PBMap
VectorSourceColor(Color) VectorSourceColor(Color)
FillPath(#PB_Path_Preserve) FillPath(#PB_Path_Preserve)
If Focus If Focus
VectorSourceColor(RGBA(255, 255, 0, 255)) VectorSourceColor(PBMap\Options\ColourFocus)
StrokePath(3) StrokePath(3)
ElseIf Selected ElseIf Selected
VectorSourceColor(RGBA(255, 255, 0, 255)) VectorSourceColor(PBMap\Options\ColourFocus)
StrokePath(4) StrokePath(4)
Else Else
VectorSourceColor(Color) VectorSourceColor(Color)
@@ -1098,7 +1133,21 @@ Module PBMap
EndIf EndIf
If PBMap\Options\ShowMarkersLegend If PBMap\Options\ShowMarkersLegend
VectorFont(FontID(PBMap\Font), 13) VectorFont(FontID(PBMap\Font), 13)
Protected Height = VectorParagraphHeight(Legend, 100, 13) ; Protected Height = VectorParagraphHeight(Legend, 100, 13)
;dessin d'un cadre avec fond transparent
Protected Height = VectorParagraphHeight(Legend, 100, 100)
Protected Width.l
If Height < 20 ; une ligne
Width = VectorTextWidth(Legend)
Else
Width = 100
EndIf
AddPathBox(x - (Width / 2), y - 30 - Height, Width, Height)
VectorSourceColor(RGBA(168, 255, 255, 100))
FillPath()
AddPathBox(x - (Width / 2), y - 30 - Height, Width, Height)
VectorSourceColor(RGBA(36, 36, 255, 100))
StrokePath(2)
MovePathCursor(x - 50, y - 30 - Height) MovePathCursor(x - 50, y - 30 - Height)
VectorSourceColor(RGBA(0, 0, 0, 255)) VectorSourceColor(RGBA(0, 0, 0, 255))
DrawVectorParagraph(Legend, 100, Height, #PB_VectorParagraph_Center) DrawVectorParagraph(Legend, 100, Height, #PB_VectorParagraph_Center)
@@ -1746,7 +1795,8 @@ CompilerIf #PB_Compiler_IsMainFile
PBMap::SetOption("ShowDebugInfos", "0") PBMap::SetOption("ShowDebugInfos", "0")
PBMap::SetOption("ShowScale", "1") PBMap::SetOption("ShowScale", "1")
PBMap::SetOption("ShowMarkersLegend", "1") PBMap::SetOption("ShowMarkersLegend", "1")
PBMap::SetOption("TrackShowKms", "1") PBMap::SetOption("ShowTrackKms", "1")
PBMap::SetOption("ColourFocus", "$FFFF00AA")
PBMap::MapGadget(#Map, 10, 10, 512, 512) PBMap::MapGadget(#Map, 10, 10, 512, 512)
PBMap::SetCallBackMainPointer(@MainPointer()) ; To change the main pointer (center of the view) PBMap::SetCallBackMainPointer(@MainPointer()) ; To change the main pointer (center of the view)
PBMap::SetCallBackLocation(@UpdateLocation()) ; To obtain realtime coordinates PBMap::SetCallBackLocation(@UpdateLocation()) ; To obtain realtime coordinates
@@ -1806,8 +1856,8 @@ CompilerIf #PB_Compiler_IsMainFile
CompilerEndIf CompilerEndIf
; IDE Options = PureBasic 5.50 (Windows - x64) ; IDE Options = PureBasic 5.50 (Windows - x64)
; CursorPosition = 24 ; CursorPosition = 1104
; FirstLine = 159 ; FirstLine = 1107
; Folding = ------------- ; Folding = -------------
; EnableThread ; EnableThread
; EnableXP ; EnableXP