lazarus-ccr/components/lazmapviewer/source/mvmapviewerpropedits.pas

{
  Property editors for LazMapViewer
  Copyright (C) 2019 user alpine at Lazarus forum https://forum.lazarus.freepascal.org

  License: modified LGPL with linking exception (like RTL, FCL and LCL)

  See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
  for details about the license.

  See also: https://wiki.lazarus.freepascal.org/FPC_modified_LGPL
}
unit
  mvMapViewerPropEdits;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, PropEdits, GraphPropEdits, ImgList, mvMapProvider;

type
  { TMapProviderPropertyEditor }

  TMapProviderPropertyEditor = class(TStringPropertyEditor)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    function GetValue: AnsiString; override;
    procedure SetValue(const NewValue: AnsiString); override;
  end;

  { TPointOfInterestImageIndexPropertyEditor }

  TPointOfInterestImageIndexPropertyEditor = class(TImageIndexPropertyEditor)
  protected
    function GetImageList: TCustomImageList; override;
  end;

  { TPointDateTimePropertyEditor }

  TPointDateTimePropertyEditor = class(TDateTimePropertyEditor)
  public
    function GetValue: string; override;
    procedure SetValue(const NewValue: AnsiString); override;
  end;

  { TPointElevationPropertyEditor }

  TPointElevationPropertyEditor = class(TFloatPropertyEditor)
  public
    function GetValue: string; override;
    procedure SetValue(const NewValue: AnsiString); override;
  end;

procedure Register;

implementation

uses
  mvMapViewer, mvGpsObj;

const
  NONE = '(none)';

{ TPointElevationPropertyEditor }

function TPointElevationPropertyEditor.GetValue: string;
begin
  Result := inherited GetValue;
  if GetFloatValue = NO_ELE then
    Result := NONE;
end;

procedure TPointElevationPropertyEditor.SetValue(const NewValue: AnsiString);
begin
  if (NewValue = NONE) or (NewValue = '')
    then inherited SetFloatValue(NO_ELE)
    else inherited SetValue(NewValue);
end;

{ TPointDateTimePropertyEditor }

function TPointDateTimePropertyEditor.GetValue: string;
begin
  Result := inherited GetValue;
  if GetFloatValue = NO_DATE then
    Result := NONE;
end;

procedure TPointDateTimePropertyEditor.SetValue(const NewValue: AnsiString);
begin
  if (NewValue = NONE) or (NewValue = '')
    then inherited SetFloatValue(NO_DATE)
    else inherited SetValue(NewValue);
end;

{ TPointOfInterestImageIndexPropertyEditor }

function TPointOfInterestImageIndexPropertyEditor.GetImageList: TCustomImageList;
var
  P: TPersistent;
begin
  Result := Nil;
  P := GetComponent(0);
  if (P is TPointOfInterest) then
  begin
    Result := TPointOfInterest(P).MapView.POIImages;
  end;
end;

{ TMapProviderPropertyEditor }

function TMapProviderPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paPickList, paRevertable];
end;

procedure TMapProviderPropertyEditor.GetValues(Proc: TGetStrProc);
var
  Providers: TStringList;
  S: String;
  Inst: TPersistent;
  MV: TMapView;
  Filter: Boolean = False;
  PT: TProjectionType;
begin
  Inst := GetComponent(0);
  Providers := TStringList.Create;
  try
    if Inst is TMapView then
      MV := TMapView(Inst)
    else if Inst is TMapLayer then
    begin
      MV := TMapLayer(Inst).MapView;
      Filter := True;
      PT := MV.Engine.MapProjectionType;
    end
    else
      Exit;
    MV.Engine.GetMapProviders(Providers);
    //if not (Inst is TMapView) then
      Proc(NONE);
    Providers.Sort;
    for S in Providers do
      // TODO: When filtered it is not clear what is the full list.
      //if not Filter or (PT = MV.Engine.MapProviderByName(S).ProjectionType) then
        Proc(S);
  finally
    Providers.Free;
  end;
end;

function TMapProviderPropertyEditor.GetValue: AnsiString;
begin
  Result := inherited GetValue;
  if Result = '' then
    Result := NONE;
end;

procedure TMapProviderPropertyEditor.SetValue(const NewValue: AnsiString);
begin
  if NewValue = NONE
    then inherited SetValue('')
    else inherited SetValue(NewValue);
end;

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(String),
    TMapView,'MapProvider',TMapProviderPropertyEditor);
  RegisterPropertyEditor(TypeInfo(String),
    TMapLayer,'MapProvider',TMapProviderPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TImageIndex),
    TPointOfInterest, 'ImageIndex', TPointOfInterestImageIndexPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TDateTime),
    TPointOfInterest, 'DateTime', TPointDateTimePropertyEditor);
  RegisterPropertyEditor(TypeInfo(Double),
    TPointOfInterest, 'Elevation', TPointElevationPropertyEditor);
end;


end.