Composant Delphi / Google Maps / OpenStreetMap / Leaflet  / Mappilary / Native Maps 100% Delphi 0% WebBrowser 0% Javascript

Interactive creating a route

  • Glossary
you are here :Programmation

Let's make a class that will handle a component TECMap with the aim of creating a route by clicking on the map the point of departure and arrival, Once the road created we need to be able to change the mouse

An event will be raised whenever the road change and we will then consult the various information of it (distance, duration, crossing points )

FInfoRoute := TInfoRoute.create;
// event fired when new route or route change
FInfoRoute.OnRoute := OnInfoRoute;
// route color
FInforoute.Color := clRed;
// Active InfoRoute
FInfoRoute.map := map;
// deactive InfoRoute
FInfoRoute.map := nil;

When connecting the TECMap component we safeguard the events on which we we connecting.

procedure TInfoRoute.setMap(const Map:TECMap);
begin

Clear;

RestoreEvents;

FECMap := Map;

AssignEvents;

end;


procedure TInfoRoute.AssignEvents;
begin

if not assigned(FECMap) then exit;

// save the events of Origins
FOldMapClick := FECMap.OnMapClick;
FOldAfterReload := FECMap.OnAfterReload ;
FOldBeforeReload := FECMap.OnBeforeReload ;
FOldRouteChange := FECMap.OnRouteChange;


// connect to the events that interest us
FECMap.OnMapClick := doOnMapClick;
FECMap.OnAfterReload := doOnAfterReload;
FECMap.OnBeforeReload := doOnBeforeReload;
FECMap.OnRouteChange := doOnRouteChange;

end;


// Reassign the events of origins
procedure TInfoRoute.RestoreEvents;
begin

if not assigned(FECMap) then exit;


FECMap.OnMapClick := FOldMapClick;

FECMap.OnAfterReload := FOldAfterReload;
FECMap.OnBeforeReload := FOldBeforeReload;

FECMap.OnRouteChange := FOldRouteChange;

end;








The main event is OnMapClick which allows us to respond when the user clicks on the map.

If the route is not created test if you need to create the marker beginning or end, for each one of them we adjust its coordinates with AlignLatLngToRoute to position themselves on the nearest road to the clicked point.

procedure TInfoRoute.doOnMapClick(sender: Tobject; const dLatitude, dLongitude: double);
var id:integer;
lat,lng : double;
begin
if not assigned(FECMap) or
assigned(FPolyline) or
assigned(FRoute) then exit;

lat := dLatitude;
lng := dLongitude;

// Start Marker
if not assigned(FStartMarker) then
begin
FECMap.AlignLatLngToRoute(lat, lng);

FStartLat := lat;
FStartLng := lng;

id := FECMap.AddMarker(lat, lng);

FStartMarker := FECMap.Markers[id];

FStartMarker.Draggable := true;

FStartMarker.OnMarkerMove := doOnMoveMarker;

end

else // End Marker

if not assigned(FEndMarker) then
begin
FECMap.AlignLatLngToRoute(lat, lng);

id := FECMap.AddMarker(lat, lng);

FEndLat := lat;
FEndLng := lng;

FEndMarker := FECMap.Markers[id];

FEndMarker.Draggable := true;

FEndMarker.OnMarkerMove := doOnMoveMarker;

SetRoute;
end;


end;

It is connected to the event OnMarkerMove of markers to be able to manually edit the beginning and the end of our route in the case of the apis that do not allow to manage editable routes.

procedure TInfoRoute.doOnMoveMarker(sender: Tobject; const Index: integer;
var dLatitude, dLongitude: double);
begin

FECMap.AlignLatLngToRoute(dLatitude, dLongitude);

setRoute;

end;


During the creation of the arrival point is called setRoute to create our route.

Only the apis Google Maps and OpenMapQuest to change the road with the mouse, for others we will emulate this function using a Polyline and our start and end markers.

procedure TInfoRoute.setRoute;
var id : integer;

begin

if assigned(FECMap) and
assigned(FStartMArker) and
assigned(FEndMarker) then

begin

if assigned(FPolyLine) then
begin
FECMap.Polylines.delete(FPolyLine.id);
FRoutePath.free;
FPolyline := nil;
end;

if assigned(FRoute) then
begin
FECMap.Routes.delete(FRoute.Id);
FRoute := nil;
end;

FRoutePath := nil;


// only Google and OpenMapQuest support dynamic route
if (FECMap.MapAPI=apiGoogle) or
(FECMap.MapAPI=apiOpenMapQuest) then
begin



id := FECMap.AddRoute('',FStartMarker.Latitude,FStartMarker.Longitude,FEndMarker.Latitude,FEndMarker.Longitude);


FRoute := FECMap.routes[id];


// the dynamic routes have their own markers
// so ours is deleted

if assigned(FStartMarker) then
begin
FECMap.Markers.delete(FStartMarker.id);
FStartMarker := nil;
end;

if assigned(FEndMarker) then
begin
FECMap.MArkers.delete(FEndMarker.id);
FEndMarker := nil;
end;



end

else
begin

FRoutePath := FECMap.getRoutePathFrom([FStartMarker.Latitude,FStartMarker.Longitude,FEndMarker.Latitude,FEndMarker.Longitude]);

if FRoutePath<>nil then
begin

id := map.polylines.addFromRoutePath(FRoutePath);


FPolyLine := FECMap.PolyLines[id];

FPolyLine.Color := FColor;
FPolyLine.Opacity := FOpacity;
FPolyLine.ReDraw;

if assigned(OnRoute) then
OnRoute(self);
end;

end;

end;

end;

With Google Maps or OpenMapQuest When the road is changed the event OnRouteChange is raised, if the road has just been created we make it editable and we adjust its color.

procedure TInfoRoute.doOnRouteChange(sender: Tobject; const idRoute: integer;const NewRoute: boolean);
begin
if assigned(FRoute) and
(FRoute.id=idRoute) and
assigned(OnRoute) then
begin

if NewRoute then
begin
FRoute.Draggable := true;
FRoute.Color := FColor;
FRoute.Opacity := FOpacity;
// updateOptions fire OnRouteChange
FRoute.updateOptions;
end

else

if assigned(OnRoute) then
OnRoute(self) ;
end

else

if Assigned(FOldRouteChange) then
FOldRouteChange(sender,idRoute,NewRoute);


end;

When the road is created/modified, the event OnRoute our class is raised, by you plugging you can retrieve this information through the property RoutePath type TECMapRoutePath.

RoutePath.Distance; // distance in meters
RoutePath.Duration; // duration in seconds

Below the entirety of unit, You may notice events management OnBeforeReLoad and OnAfterReLoad to take account of any map reloading for example when changing API.

unit UInfoRoute;

interface
uses Windows, SysUtils, Classes, Graphics, ECMaps;


type

TInfoRoute = class
private
FECMap : TECMap;
FStartLat,FStartLng,
FEndLat,FEndLng : double;

FStartMarker,
FEndMarker : TECMapMarker;
FPolyLine : TECMapPolyline;
FRoutePath : TECMapRoutePath;
FRoute : TECMapRoute;

FOldMapClick : TOnMapClick;
FOldRouteChange : TOnRouteChange;


FOldAfterReload,
FOldBeforeReload,
FOnRoute : TNotifyEvent;

FColor : TColor;
FOpacity : double;

procedure setMap(const Map:TECMap);

procedure AssignEvents;
procedure RestoreEvents;

procedure setRoute;
function getRoutePath:TECMapRoutePath;


procedure doOnMapClick(sender: Tobject; const dLatitude, dLongitude: double);

procedure doOnMoveMarker(sender: Tobject; const Index: integer;
var dLatitude, dLongitude: double) ;

procedure doOnRouteChange(sender: Tobject; const idRoute: integer;const NewRoute: boolean);



procedure doOnBeforeReload(sender: Tobject);
procedure doOnAfterReload(sender: Tobject);

public


constructor Create ;
destructor Destroy ; override;

procedure Clear;

property Map : TECMap read FECMap write setMap;
property RoutePath : TECMapRoutePath read getRoutePath;

property Color : TColor read FColor write FColor;
property Opacity: double read FOpacity write FOpacity;

property OnRoute : TNotifyEvent read FOnRoute write FOnRoute;
end;

implementation


constructor TInfoRoute.Create;
begin
FColor := clBlue;
FOpacity := 0.5;

inherited;
end;

destructor TInfoRoute.Destroy ;
begin
Map := nil;

inherited;

end;


procedure TInfoRoute.AssignEvents;
begin

if not assigned(FECMap) then exit;

// save the events of Origins
FOldMapClick := FECMap.OnMapClick;
FOldAfterReload := FECMap.OnAfterReload ;
FOldBeforeReload := FECMap.OnBeforeReload ;
FOldRouteChange := FECMap.OnRouteChange;


// connect to the events that interest us
FECMap.OnMapClick := doOnMapClick;
FECMap.OnAfterReload := doOnAfterReload;
FECMap.OnBeforeReload := doOnBeforeReload;
FECMap.OnRouteChange := doOnRouteChange;

end;


// Reassign the events of origins
procedure TInfoRoute.RestoreEvents;
begin

if not assigned(FECMap) then exit;


FECMap.OnMapClick := FOldMapClick;

FECMap.OnAfterReload := FOldAfterReload;
FECMap.OnBeforeReload := FOldBeforeReload;

FECMap.OnRouteChange := FOldRouteChange;

end;





procedure TInfoRoute.setMap(const Map:TECMap);
begin

Clear;


RestoreEvents;

FECMap := Map;

AssignEvents;


end;


procedure TInfoRoute.doOnBeforeReload(sender: Tobject);
begin

Clear;

if assigned(FOldBeforeReload) then
FOldBeforeReload(FECMap);

end;

procedure TInfoRoute.doOnAfterReload(sender: Tobject);
var id:integer;
begin

if (FStartLat <> 0) and
(FStartLng <> 0) and
(FStartMarker = nil) then
begin
id := FECMap.AddMarker(FStartLat, FStartLng);

FStartMarker := FECMap.Markers[id];

FStartMarker.Draggable := true;

FStartMarker.OnMarkerMove := doOnMoveMarker;

if (FEndLat <> 0) and
(FEndLng <> 0) then
begin

id := FECMap.AddMarker(FEndLat, FEndLng);

FEndMarker := FECMap.Markers[id];

FEndMarker.Draggable := true;

FEndMarker.OnMarkerMove := doOnMoveMarker;

SetRoute;

end;

end;


if assigned(FOldAfterReload) then
FOldAfterReload(FECMap);
end;


procedure TInfoRoute.doOnMapClick(sender: Tobject; const dLatitude, dLongitude: double);
var id:integer;
lat,lng : double;
begin
if not assigned(FECMap) or
assigned(FPolyline) or
assigned(FRoute) then exit;

lat := dLatitude;
lng := dLongitude;

if not assigned(FStartMarker) then
begin
FECMap.AlignLatLngToRoute(lat, lng);

FStartLat := lat;
FStartLng := lng;

id := FECMap.AddMarker(lat, lng);

FStartMarker := FECMap.Markers[id];

FStartMarker.Draggable := true;

FStartMarker.OnMarkerMove := doOnMoveMarker;

end

else

if not assigned(FEndMarker) then
begin
FECMap.AlignLatLngToRoute(lat, lng);

id := FECMap.AddMarker(lat, lng);

FEndLat := lat;
FEndLng := lng;

FEndMarker := FECMap.Markers[id];

FEndMarker.Draggable := true;

FEndMarker.OnMarkerMove := doOnMoveMarker;

SetRoute;
end;


end;


procedure TInfoRoute.doOnMoveMarker(sender: Tobject; const Index: integer;
var dLatitude, dLongitude: double);
begin

FECMap.AlignLatLngToRoute(dLatitude, dLongitude);

setRoute;

end;



procedure TInfoRoute.setRoute;
var id : integer;

begin

if assigned(FECMap) and
assigned(FStartMArker) and
assigned(FEndMarker) then

begin

if assigned(FPolyLine) then
begin
FECMap.Polylines.delete(FPolyLine.id);
FRoutePath.free;
FPolyline := nil;
end;

if assigned(FRoute) then
begin
FECMap.Routes.delete(FRoute.Id);
FRoute := nil;
end;

FRoutePath := nil;


// only Google and OpenMapQuest support dynamic route
if (FECMap.MapAPI=apiGoogle) or
(FECMap.MapAPI=apiOpenMapQuest) then
begin



id := FECMap.AddRoute('',FStartMarker.Latitude,FStartMarker.Longitude,FEndMarker.Latitude,FEndMarker.Longitude);


FRoute := FECMap.routes[id];


// the dynamic routes have their own markers
// so ours is deleted

if assigned(FStartMarker) then
begin
FECMap.Markers.delete(FStartMarker.id);
FStartMarker := nil;
end;

if assigned(FEndMarker) then
begin
FECMap.MArkers.delete(FEndMarker.id);
FEndMarker := nil;
end;



end

else
begin

FRoutePath := FECMap.getRoutePathFrom([FStartMarker.Latitude,FStartMarker.Longitude,FEndMarker.Latitude,FEndMarker.Longitude]);

if FRoutePath<>nil then
begin

id := map.polylines.addFromRoutePath(FRoutePath);


FPolyLine := FECMap.PolyLines[id];

FPolyLine.Color := FColor;
FPolyLine.Opacity := FOpacity;
FPolyLine.ReDraw;

if assigned(OnRoute) then
OnRoute(self);
end;

end;

end;

end;


procedure TInfoRoute.doOnRouteChange(sender: Tobject; const idRoute: integer;const NewRoute: boolean);
begin
if assigned(FRoute) and
(FRoute.id=idRoute) and
assigned(OnRoute) then
begin

if NewRoute then
begin
FRoute.Draggable := true;
FRoute.Color := FColor;
FRoute.Opacity := FOpacity;
// updateOptions fire OnRouteChange
FRoute.updateOptions;
end

else if assigned(OnRoute) then
OnRoute(self) ;
end

else

if Assigned(FOldRouteChange) then
FOldRouteChange(sender,idRoute,NewRoute);


end;



function TInfoRoute.getRoutePath:TECMapRoutePath;
begin
if ASsigned(FRoute) then
result := FRoute.Path
else
if Assigned(FRoutePath) then
result := FRoutePath
else
result := nil;
end;


procedure TInfoRoute.Clear;
begin
if not assigned(FECMap) then exit;

if assigned(FStartMarker) then
begin
FECMap.MArkers.delete(FStartMarker.id);
FStartMarker := nil;
end;

if assigned(FEndMarker) then
begin
FECMap.MArkers.delete(FEndMarker.id);
FEndMarker := nil;
end;

if assigned(FPolyLine) then
begin
FECMap.Polylines.delete(FPolyLine.id);
FPolyLine := nil;
FRoutePath.free;
FRoutePath := nil;
end;

if assigned(FRoute) then
begin
FECMap.Routes.delete(FRoute.Id);
FRoute := nil;
end;


end;



end.

go to page
© 2016 ESCOT-SEP Christophe - Made width Help&Web - RSS - Google+