Nous allons réaliser une classe qui manipulera un composant TECMap dans le but de créer une route en cliquant sur la carte le point de départ et d'arrivée, une fois la route créé nous devrons pouvoir la modifier à la souris
Un évenement sera déclenché à chaque modification de la route et nous pourront alors consulter les diverses informations de celle-ci (distance, durée, points de passages )
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;
Lors de la connexion du composant TECMap nous sauvegardons les évenements sur lesquels nous nous branchons.
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;
Le principal évenement est OnMapClick qui nous permet de réagir lors que l'utilisateur clique sur la carte.
Si la route n'est pas créé on teste si l'on doit créer le marker de début ou de fin, pour chaqu'un d'eux nous ajustons ses coordonnées avec AlignLatLngToRoute pour se positionner sur la route la plus proche du point cliqué.
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;
On se branche sur l'événement OnMarkerMove des markers pour pouvoir modifier manuellement le début et la fin de notre route dans le cas des apis qui ne permettent pas de gérer les routes modifiables.
procedure
TInfoRoute.doOnMoveMarker(sender: Tobject; const Index: integer;
var dLatitude, dLongitude:
double);
begin
FECMap.AlignLatLngToRoute(dLatitude, dLongitude);
setRoute;
end;
Lors de la création du point d'arrivée on appelle setRoute pour créer notre route.
Seules les apis Google Maps et OpenMapQuest permettent de modifier la route à la souris, pour les autres nous allons émuler cette fonction en utilisant une Polyline et nos markers de début et de fin.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;
Avec Google Maps ou OpenMapQuest lorsque la route est modifiée l'événement OnRouteChange est déclenché, si la route vient d'être créé nous la rendons modifiable et nous ajustons sa couleur.
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;
Lorsque la route est créé/modifiée l'événement OnRoute de notre classe est déclenché, en vous y branchant vous pourrez récupérer les informations sur celle-ci au travers de la propriété RoutePath de type TECMapRoutePath.
RoutePath.Distance; // distance in meters
RoutePath.Duration; // duration in
seconds
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.