Composants

// add a checkbox at bottom left
map.components.Add('CheckBoxAlign',CheckBox2,ecLeftBottom);

unit uecZoomBarComponent;

interface
uses
Windows, messages,forms,sysutils,Classes, Graphics, Controls, StdCtrls, ExtCtrls,
uecNativeMapControl,uecMapUtil;

type

TZoomBarComponent = class(TECCustomTool)
private

tmZoom : TTimer;

FPanelBar : TPanel;
FNextZoom ,
FPrevZoom : Tbutton;

FButtonSize : integer;
FVerticalBar: boolean;

FInProgressiveZoom,
FProgressiveZoom : boolean;

procedure setProgressiveZoom(const value:boolean);

procedure setButtonSize(const value:integer);

procedure doNextZoom(Sender:TObject);
procedure doPrevZoom(Sender:TObject);

procedure doNextMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: integer);
procedure doNextMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: integer);

procedure tmZoomTimer(Sender: TObject);

procedure ChangeZoom;

protected
procedure setLayout(const value:TECCustomToolLayout); override;

public
constructor Create(Map : TNativeMapControl); override;
destructor Destroy; override;


property ButtonSize : integer read FButtonSize write setButtonSize;

property ProgressiveZoom : boolean read FProgressiveZoom write setProgressiveZoom;

end;

implementation

constructor TZoomBarComponent.Create(Map : TNativeMapControl);
begin

inherited;


// create zoom bar

// FPanelBar will be the support that determines the total occupancy of our component
// It will be connected to TECNativeMap

FPanelBar := TPanel.Create(nil);
FPanelBar.BevelOuter := bvNone;
FPanelBar.ParentBackground := false;
FPanelBar.Color := clBtnFace;
FPanelBar.showHint := true;


// place buttons on the panel

FNextZoom := TButton.Create(FPanelBar);
FNextZoom.Parent := FPanelBar;
FNextZoom.Caption:= '+';
FNextZoom.Hint := doubleToStrDigit(map.NumericalZoom,1);
FNextZoom.font.size := 11;
FNextZoom.onClick := doNextZoom;

FPrevZoom := TButton.Create(FPanelBar);
FPrevZoom.Parent := FPanelBar;
FPrevZoom.Caption:= '-';
FPrevZoom.Hint := doubleToStrDigit(map.NumericalZoom,1);
FPrevZoom.font.size := 11;
FPrevZoom.onClick:= doPrevZoom;


// Anchoring the panel on the map

add('ZoomBar',FPanelBar,ecTopRight);

ButtonSize := 32;

// A timer is used to manage the progressive zoom
// triggered when a zoom button is pressed.

tmZoom := TTimer.Create(nil);
tmZoom.Enabled := false;
tmZoom.Interval := 80;
tmZoom.OnTimer := tmZoomTimer;

ProgressiveZoom := true;

end;

procedure TZoomBarComponent.setProgressiveZoom(const value:boolean);
begin

FProgressiveZoom := value;

if value then
begin
FNextZoom.OnMouseDown := doNextMouseDown;
FNextZoom.OnMouseUp := doNextMouseUp;
FPrevZoom.OnMouseDown := doNextMouseDown;
FPrevZoom.OnMouseUp := doNextMouseUp;
end
else
begin
FNextZoom.OnMouseDown := nil;
FNextZoom.OnMouseUp := nil;
FPrevZoom.OnMouseDown := nil;
FPrevZoom.OnMouseUp := nil;
end;
end;

procedure TZoomBarComponent.setButtonSize(const value:integer);
begin
FButtonSize := value;

FNextZoom.width := FButtonSize;
FNextZoom.Height := FButtonSize;

FPrevZoom.width := FButtonSize;
FPrevZoom.Height := FButtonSize;

// recalculate button layout
Layout:=Layout;

end;

procedure TZoomBarComponent.setLayout(const value:TECCustomToolLayout);
begin
inherited;

FNextZoom.Top := 0;
FNextZoom.Left := 0;

if (Layout=ctlVertical) then
begin
Width := FButtonSize;
Height := 2*FButtonSize-1;
FPrevZoom.Top := FButtonSize-1;
FPrevZoom.Left := 0;
end
else
begin
Width := 2*FButtonSize-1;
Height:= FButtonSize;
FPrevZoom.Top := 0;
FPrevZoom.Left := FButtonSize-1;
end;

end;


procedure TZoomBarComponent.ChangeZoom;
begin
FNextZoom.Hint := doubleToStrDigit(map.NumericalZoom,1);
FPrevZoom.Hint := doubleToStrDigit(map.NumericalZoom,1);
end;


procedure TZoomBarComponent.doNextZoom(Sender:TObject);
begin
if not FInProgressiveZoom then
begin
Map.Zoom := Map.Zoom + 1;
ChangeZoom;
end;

FInProgressiveZoom := false;
end;

procedure TZoomBarComponent.doPrevZoom(Sender:TObject);
begin
if not FInProgressiveZoom then
begin
Map.Zoom := Map.Zoom - 1;
ChangeZoom;
end;

FInProgressiveZoom := false;
end;

// activate the timer when the button is pressed
// a progressive zoom will then be automatically performed
procedure TZoomBarComponent.doNextMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: integer);
begin
// save the button pressed to react on it.
tmZoom.Tag := integer(Sender);
tmZoom.Enabled := true;
end;
// cancel progressive zoom
procedure TZoomBarComponent.doNextMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: integer);
begin
tmZoom.Enabled := false;
ChangeZoom;
end;
// Progressive zoom in or out
// Allows to go beyond the maximum zoom managed by the tile server
procedure TZoomBarComponent.tmZoomTimer(Sender: TObject);
begin
FInProgressiveZoom := true;

if (TButton(tmZoom.Tag) = FNextZoom) then
begin
map.ZoomScaleFactor := map.ZoomScaleFactor + 10
end
else
map.ZoomScaleFactor := map.ZoomScaleFactor - 10;

end;

TLegendComponent = class(TECCustomTool)
public
property Legend : TPanelLegend ;
end;

procedure TFormLegend.FormCreate(Sender: TObject);
begin
FLegendCp := TLegendComponent.Create(map);

FLegendCp.Legend.color := clWhite;
FLegendCp.Legend.Height:= 270;

// add checkbox
FLegendCp.Legend.ItemCheckBox := true;
// The event is triggered OnItemCheckBoxChange when the checkbox changes state
FLegendCp.Legend.OnItemCheckBoxChange := doOnItemLegendCheckBoxChange;

// width of legend pictogram
FLegendCp.Legend.VisualWidth := 40;
// line thickness for styles <> vsFrame and vsFillRect
FLegendCp.Legend.VisualWeight := 3;

FLegendCp.Legend.add('Item 1',getRandomColor,vsFillRect);
FLegendCp.Legend.add('Item 2',getRandomColor,vsFrame);
FLegendCp.Legend.add('Item 3',getRandomColor,vsSolidLine);
FLegendCp.Legend.add('Item 4',getRandomColor,vsDashLine);
FLegendCp.Legend.add('Item 5',getRandomColor,vsDotLine);
FLegendCp.Legend.add('Item 6',getRandomColor,vsDashDotLine);

// add graphic
FLegendCp.Legend.add('Item 7',pins.picture.graphic);

FLegendCp.Legend.Title := 'Legend';
FLegendCp.Legend.Footer := 'Footer';

FLegendCp.Legend.OnItemClick := doOnItemLegendClick;

end;

procedure TFormLegend.FormDestroy(Sender: TObject);
begin
FLegendCp.Free;
end;

procedure TFormLegend.ckVisibleClick(Sender: TObject);
begin
FLegendCp.Visible := ckVisible.Checked;
end;

// event triggered by a click on an item
procedure TFormLegend.doOnItemLegendClick(sender : TObject);
begin
if Sender is TItemLegend then
begin
showMessage(TItemLegend(Sender).ItemCaption);
end;
end;

// event triggered by a click on an item checkbox
procedure TFormLegend.doOnItemLegendCheckBoxChange(sender : TObject);
var s:string;
begin
if Sender is TItemLegend then
begin
if TItemLegend(Sender).ItemChecked then
s := ' is checked'
else
s := ' is not checked';
showMessage(TItemLegend(Sender).ItemCaption+s);
end;
end;

(*

ecTopRight , ecTopLeft stacks components vertically upwards to right and left
ecBottomRight, ecBottomLeft stack components vertically downwards on right and left
ecRightTop , ecLeftTop stack components horizontally upwards to right and left
ecRightBottom, ecLeftBottom stacks components horizontally downwards to right and left

*)

procedure TFormLegend.RadioButton4Click(Sender: TObject);
begin
case TRadioButton(Sender).tag of
0 : FLegendCp.Align := ecTopRight;
1 : FLegendCp.Align := ecTopLeft;
2 : FLegendCp.Align := ecBottomRight;
3 : FLegendCp.Align := ecBottomLeft;
end;
end;

// item text alignment
procedure TFormLegend.RadioButton8Click(Sender: TObject);
begin
case TRadioButton(Sender).tag of
0 : FLegendCp.Legend.ItemAlignment := taLeftJustify;
1 : FLegendCp.Legend.ItemAlignment := taCenter;
2 : FLegendCp.Legend.ItemAlignment := taRightJustify;
end;
end;

// item visual alignment
procedure TFormLegend.RadioButton9Click(Sender: TObject);
begin
case TRadioButton(Sender).tag of
0 : FLegendCp.Legend.VisualAlignment := valLeft;
1 : FLegendCp.Legend.VisualAlignment := valRight;
end;
end;

procedure TMapillaryForm.FormCreate(Sender: TObject);
begin
// Pass the map that will display the Mapillary component
FMapillaryComponent := TMapillaryComponent.Create(map);
// color component
FMapillaryComponent.Color := clWhite;
// Triggered when a Mapillary image is displayed
FMapillaryComponent.OnImage := doOnImage;
// Triggered when component state, visibility, position, size change
FMapillaryComponent.OnChange:= doOnChange;

// FPosition will indicate the position of the displayed Mapillary image
FPosition := map.AddMarker(map.Latitude, map.Longitude);
FPosition.Visible := false;
FPosition.filename := GOOGLE_RED_DOT_ICON; // unit uecMapUtil also BLUE,YELLOW and GREEN
FPosition.YAnchor := 32;

// Enter your access key, see https://www.mapillary.com/developer
FMapillaryComponent.AccessToken := 'ENTER-YOUR-ACCESS-TOKEN';
FMapillaryComponent.visible := true;

end;



// Triggered when component state, visibility, position, size change
procedure TMapillaryForm.doOnChange(Sender:TObject);
begin

ckVisible.Checked := FMapillaryComponent.visible;
FPosition.Visible := FMapillaryComponent.visible;


with Memo1.Lines do
begin
BeginUpdate;
Clear;
add('Visible : '+BoolToStr(FMapillaryComponent.visible));
EndUpdate;
end

end;

// Triggered when a Mapillary image is displayed
procedure TMapillaryForm.doOnImage(Sender:TObject);
begin

if assigned(FMapillaryComponent.Image) then
begin
FPosition.SetPosition(FMapillaryComponent.Image.lat,FMapillaryComponent.Image.lng);
FPosition.setFocus;
with Memo1.Lines do
begin
BeginUpdate;
Clear;
add('Lat : '+doubleToStrDigit(FMapillaryComponent.Image.lat, 4));
add('Lng : '+doubleToStrDigit(FMapillaryComponent.Image.lng, 4));
add('Angle : '+inttostr(FMapillaryComponent.Image.Compass_angle)+ '°');
add('Time : '+DateTimeToStr(FMapillaryComponent.Image.Captured_at));
EndUpdate;
end;
end
else
Memo1.Lines.Clear;

end;

procedure TMapillaryForm.FormDestroy(Sender: TObject);
begin
FMapillaryComponent.Free;
end;

procedure TMapillaryForm.ckVisibleClick(Sender: TObject);
begin
FMapillaryComponent.Visible := ckVisible.Checked;
end;

procedure TMapillaryForm.RadioButton4Click(Sender: TObject);
begin
case TRadioButton(Sender).tag of
0 : FMapillaryComponent.Align := ecTopRight;
1 : FMapillaryComponent.Align := ecTopLeft;
2 : FMapillaryComponent.Align := ecBottomRight;
3 : FMapillaryComponent.Align := ecBottomLeft;
4 : FMapillaryComponent.Align := ecTopCenter;
5 : FMapillaryComponent.Align := ecBottomCenter;
6 : FMapillaryComponent.Align := ecLeftCenter;
7 : FMapillaryComponent.Align := ecRightCenter;
end;
end;

procedure TFormWeather.FormCreate(Sender: TObject);
begin
// get your key from http://openweathermap.org/appid
map.OpenWeather.Key := 'ENTER-YOUR-KEY';

// Air quality is optional, leave the key empty if you don't want to use it.
// get your free key from https://aqicn.org/data-platform/token/
map.AirQuality.key := 'ENTER-YOUR-KEY';

FOpenWeatherComponent := TOpenWeatherComponent.Create(Map);
FOpenWeatherComponent.Color := clWhite;

// The component is only displayed for zoom 13 and above.
FOpenWeatherComponent.MinZoom := 13;

/// Triggered by clicking on component or map marker
FOpenWeatherComponent.OnClick := doOnClick;
// Triggered by change of weather station
FOpenWeatherComponent.OnChange:= doOnChange;

// You can specify the language for the weather description
map.openWeather.Lang := 'fr';
// Translate the hint for "Air quality".
FOpenWeatherComponent.HintAirQuality := 'Qualité de l''air';
// You can also translate the table containing the air quality indicators
Map.AirQuality.Legend[aqlGood] := 'Bonne';
Map.AirQuality.Legend[aqlModerate] := 'Modérée';
Map.AirQuality.Legend[aqlUnhealthySensitive] := 'Insalubre pour les groupes sensibles';
Map.AirQuality.Legend[aqlUnhealthy] := 'Insalubre';
Map.AirQuality.Legend[aqlVeryUnhealthy] := 'Nocive';
Map.AirQuality.Legend[aqlHazardous] := 'Dangereuse';

FOpenWeatherComponent.visible := true;
end;

// Triggered by change of weather station
procedure TFormWeather.doOnChange(sender : TObject);
begin
with Memo1.Lines do
begin
BeginUpdate;
Clear;
Add(FOpenWeatherComponent.Station.Name);
Add('Temp : '+DoubleToStr(round(FOpenWeatherComponent.Station.temp))+ '°'+
' (min: '+doubletostr(round(FOpenWeatherComponent.Station.temp_min))+ '°'+
' max: '+doubletostr(round(FOpenWeatherComponent.Station.temp_max))+ '°)' );
Add(FOpenWeatherComponent.Station.weather.description) ;

if FOpenWeatherComponent.CityAirQuality.Ok then
Add(FOpenWeatherComponent.HintAirQuality+' '+Map.AirQuality.Legend[FOpenWeatherComponent.CityAirQuality.level]);


EndUpdate;
end;

end;

// Triggered by clicking on component or map marker
procedure TFormWeather.doOnClick(sender : TObject);
var Q:string;
begin

(*
OnClick reacts both to the click on the component and to the marker on the map
Sender makes it possible to distinguish between them
*)
if not (Sender is TECShape) then
// compact or full display
FOpenWeatherComponent.ShowDescription := not FOpenWeatherComponent.ShowDescription;

if FOpenWeatherComponent.CityAirQuality.Ok then
begin
Q := FOpenWeatherComponent.HintAirQuality;
if Q<>'' then Q := Q + ' : ';
Q := Q + Map.AirQuality.Legend[FOpenWeatherComponent.CityAirQuality.level];
end
else
Q := '';
Memo1.Lines.Clear;
Memo1.Lines.Add('Click component');
Memo1.Lines.Add(' '+FOpenWeatherComponent.Station.name);
if Q<>'' then
Memo1.Lines.Add(' '+Q);
end;

procedure TFormWeather.ckVisibleClick(Sender: TObject);
begin
FOpenWeatherComponent.Visible := ckVisible.Checked;
end;

procedure TFormWeather.RadioButton4Click(Sender: TObject);
begin
case TRadioButton(Sender).tag of
0 : FOpenWeatherComponent.Align := ecTopRight;
1 : FOpenWeatherComponent.Align := ecTopLeft;
2 : FOpenWeatherComponent.Align := ecBottomRight;
3 : FOpenWeatherComponent.Align := ecBottomLeft;
4 : FOpenWeatherComponent.Align := ecTopCenter;
5 : FOpenWeatherComponent.Align := ecBottomCenter;
6 : FOpenWeatherComponent.Align := ecLeftCenter;
7 : FOpenWeatherComponent.Align := ecRightCenter;
end;
end;

procedure TFormSwitch.FormCreate(Sender: TObject);
begin
FSwitchServer := TSwitchServerComponent.create(map);
FSwitchServer.Visible := true;

// line useless because it is the default server, indicate for info
FSwitchServer.TileServer := tsArcGisWorldImagery;

// Triggered by switch click after server change
FSwitchServer.OnSwitch := doOnSwitch;
// Triggered especially when changing alignment and size
FSwitchServer.OnChange := doOnChange;



// Pass a name in addition (here '2') to be able to add another TSwitchServerComponent, otherwise the first one is reused.
FSwitchServer2 := TSwitchServerComponent.create(map,'2');
FSwitchServer2.Visible := true;

FSwitchServer2.OnSwitch := doOnSwitch;

FSwitchServer2.TileServer := tsIgn;
FSwitchServer2.MapStyle := 'SCAN';

// You can specify your own server like this
// FSwitchServer2.CustomTileServer := getTile;

pnColor.Color := FSwitchServer.Color;
pnSecondaryColor.Color := FSwitchServer.SecondaryColor;


end;

// build access to your own tiles here
procedure TFormSwitch.GetTile(var TileFilename: string; const x, y, z: Integer);
begin
TileFilename := Format('your_tile_url/%s%/%s/%s',[x,y,z]);
end;

procedure TFormSwitch.pnColorClick(Sender: TObject);
begin
if ColorDialog.Execute then
begin
TPanel(Sender).Color := ColorDialog.Color;

FSwitchServer.Color := pnColor.Color;
FSwitchServer.SecondaryColor := pnSecondaryColor.Color;

FSwitchServer2.Color := pnColor.Color;
FSwitchServer2.SecondaryColor := pnSecondaryColor.Color;
end;
end;

procedure TFormSwitch.cbSizeChange(Sender: TObject);
begin
case cbSize.ItemIndex of
0: FSwitchServer.size := 32;
1: FSwitchServer.size := 48;
2: FSwitchServer.size := 64;
end;

FSwitchServer2.size := FSwitchServer.size ;
end;

procedure TFormSwitch.doOnSwitch(Sender : TObject);
begin
memo1.Lines.Add(TSwitchServerComponent(Sender).Name + ' -> '+tsToString(map.TileServer)+' '+map.TileServerInfo.MapStyle) ;
end;

// button stacking direction
procedure TFormSwitch.ckVerticalClick(Sender: TObject);
begin
if ckVertical.Checked then
begin
// from bottom to top on left side
FSwitchServer.Align := ecBottomLeft;
FSwitchServer2.Align := ecBottomLeft;
end
else
begin
// from left to right at the bottom of the screen
FSwitchServer.Align := ecLeftBottom;
FSwitchServer2.Align := ecLeftBottom;
end;
end;

// Triggered especially when changing alignment and size
procedure TFormSwitch.doOnChange(Sender : TObject);
var sAlign : string;
begin
if TSwitchServerComponent(Sender).Align=ecLeftBottom then
sAlign := ' Align : LeftBottom'
else
sAlign := ' Align : BottomLeft';

memo1.Lines.Add('Size : '+inttostr(TSwitchServerComponent(Sender).size)+sAlign) ;
end;