unit Sparkle.Design.Editors;

interface

uses
  System.Classes, System.SysUtils, DesignIntf, DesignEditors, StrUtils,
  Sparkle.Comp.Server,
  Sparkle.Design.MiddlewareDesigner;

type
  TSparkleServerEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TSparkleBaseUrlProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

implementation

uses
  Bcl.Utils;

{ TSparkleServerEditor }

procedure TSparkleServerEditor.ExecuteVerb(Index: Integer);
begin
  if Index = 0 then
    ShowMiddlewareEditor(Designer, TSparkleServer(Component));
end;

function TSparkleServerEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Manage middleware list...';
  else
    Result := '';
  end;
end;

function TSparkleServerEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TSparkleBaseUrlProperty }

function TSparkleBaseUrlProperty.GetAttributes: TPropertyAttributes;
begin
  Result := (inherited GetAttributes) + [paValueList, paSortList];
end;

procedure TSparkleBaseUrlProperty.GetValues(Proc: TGetStrProc);
var
  Id: string;
  Server: TSparkleServer;
begin
  Server := GetComponent(0) as TSparkleServer;
  Id := LowerCase(Server.Name);
  if StartsText('T', Id) then
    Delete(Id, 1, 1);
  Id := StringReplace(Id, 'sparkle', '', [rfIgnoreCase]);
  Id := StringReplace(Id, 'server', '', [rfIgnoreCase]);
  Id := StringReplace(Id, 'module', '', [rfIgnoreCase]);

  Proc(Format('http://+:2001/tms/%s', [Id]));
  Proc(Format('http://+:8000/tms/%s', [Id]));
  Proc(Format('http://+:2001/tms/%s', [Server.Name]));
  Proc(Format('http://+:8000/tms/%s', [Server.Name]));

  while (Length(Id) > 0) and TBclUtils.IsDigit(Id[Length(Id)]) do
    Delete(Id, Length(Id), 1);
  Proc(Format('http://+:2001/tms/%s', [Id]));
  Proc(Format('http://+:8000/tms/%s', [Id]));
end;

end.
