unit Sparkle.Design.MiddlewareDesigner;

interface

uses
  Windows, SysUtils, Messages, Classes, Controls, Forms,
  StdCtrls, DesignIntf, DesignEditors, DesignWindows, Menus, ExtCtrls,
  ToolWin, ImgList, ComCtrls,
  Sparkle.Comp.Server;

type
  TMiddlewareEditor = class(TDesignWindow)
    LocalMenu: TPopupMenu;
    AddItem: TMenuItem;
    DeleteItem: TMenuItem;
    MiddlewareListBox: TListBox;
    ImageList1: TImageList;
    ToolBar2: TToolBar;
    btAdd: TToolButton;
    btDelete: TToolButton;
    ToolButton3: TToolButton;
    btMoveUp: TToolButton;
    btMoveDown: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure AddItemClick(Sender: TObject);
    procedure DeleteItemClick(Sender: TObject);
    procedure MiddlewareListBoxDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure MiddlewareListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure AListBoxKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SelectTable(Sender: TObject);
    procedure ListBoxClick(Sender: TObject);
    procedure AListBoxKeyPress(Sender: TObject; var Key: Char);
    procedure MiddlewareListBoxStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure LocalMenuPopup(Sender: TObject);
    procedure btMoveUpClick(Sender: TObject);
    procedure btMoveDownClick(Sender: TObject);
  private
    FDragObject: TDragObject;
    FServer: TSparkleServer;
    FFocusRectItem: Integer;
    FMinWidth, FMinHeight: Integer;
    FMiddlewareListUpdated: Boolean;
    FUpdateCount: Integer;
    procedure AddMiddleware;
    procedure BeginUpdate;
    function CreateMiddleware(const DisplayName: string): TSparkleMiddleware;
    procedure Endupdate;
    procedure MoveMiddlewareItems(MoveOffset: Integer);
    procedure RemoveMiddleware(Listbox: TListbox);
    procedure RestoreSelection(List: TListBox; ItemIndex, TopIndex: Integer);
    procedure SaveSelection(List: TListBox; var ItemIndex, TopIndex: Integer);
    procedure SetServer(Value: TSparkleServer);
    procedure UpdateDisplay;
    procedure UpdateCaption;
    procedure UpdateMiddlewareList;
    procedure UpdateSelection;
    procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
    function DoCreateMiddleware(const DisplayName: string): TSparkleMiddleware;
  protected
    procedure Activated; override;
    procedure CheckMiddlewareDelete;
    procedure CheckMiddlewareAdd;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    destructor Destroy; override;
    procedure ItemDeleted(const ADesigner: IDesigner; AItem: TPersistent); override;
    function GetEditState: TEditState; override;
    function EditAction(Action: TEditAction): Boolean; override;
    procedure ItemsModified(const Designer: IDesigner); override;
    procedure SelectionChanged(const ADesigner: IDesigner; const ASelection: IDesignerSelections); override;
    procedure DoAddMiddleware;
    property Server: TSparkleServer read FServer write SetServer;
  end;

procedure ShowMiddlewareEditor(Designer: IDesigner; AServer: TSparkleServer);
function CreateMiddlewareEditor(Designer: IDesigner; AServer: TSparkleServer): TMiddlewareEditor;

implementation

uses
  Dialogs, Math, DesignConst, Character,
  Bcl.Utils,
  Sparkle.Design.AddMiddleware;

function ServerOwner(AServer: TComponent): TComponent;
begin
  Result := AServer.Owner;
  if csSubComponent in AServer.ComponentStyle then
    Result := ServerOwner(Result);
end;

function ServerName(AServer: TComponent): string;
begin
  if csSubComponent in AServer.ComponentStyle then
    Result := ServerName(AServer.Owner)
  else
    Result := AServer.Name;
end;

function FindEditor(Server: TSparkleServer): TMiddlewareEditor;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Screen.FormCount - 1 do
  begin
    if Screen.Forms[i] is TMiddlewareEditor then
    begin
      if TMiddlewareEditor(Screen.Forms[i]).FServer = Server then
      begin
        Result := TMiddlewareEditor(Screen.Forms[i]);
        break;
      end;
    end;
  end;
end;

procedure ShowMiddlewareEditor(Designer: IDesigner; AServer: TSparkleServer);
var
  MiddlewareEditor: TMiddlewareEditor;
begin
  MiddlewareEditor := FindEditor(AServer);
  if MiddlewareEditor = nil then
    MiddlewareEditor := CreateMiddlewareEditor(Designer, AServer);
  if MiddlewareEditor <> nil then
    MiddlewareEditor.Show;
end;

function CreateMiddlewareEditor(Designer: IDesigner; AServer: TSparkleServer): TMiddlewareEditor;
begin
  Result := TMiddlewareEditor.Create(Application);
  Result.Designer := Designer;
  Result.Server := AServer;
end;

function GenerateName(Server: TSparkleServer;
  MiddlewareClass: TSparkleMiddlewareClass; Number: Integer): string;

var
  MiddlewareName: string;

  function Alpha(C: Char): Boolean; inline;
  begin
    Result := TBclUtils.IsLetter(C) or (C = '_');
  end;

  procedure CrunchMiddlewareName;
  var
    I: Integer;
  begin
    I := 1;
    while I <= Length(MiddlewareName) do
    begin
      if Alpha(MiddlewareName[I]) then
        Inc(I)
      else
        Delete(MiddlewareName, I, 1);
    end;
  end;

begin
  MiddlewareName := MiddlewareClass.DisplayName;
  CrunchMiddlewareName;
  if (MiddlewareName = '') or not Alpha(MiddlewareName[1]) then
  begin
    MiddlewareName := MiddlewareClass.ClassName;
    if MiddlewareName[1] = 'T' then Delete(MiddlewareName, 1, 1);
  end;
  Result := ServerName(Server) + MiddlewareName;
  if Number > 1 then
    Result := Result + IntToStr(Number);
end;

function CreateUniqueName(Server: TSparkleServer; MiddlewareClass: TSparkleMiddlewareClass): string;
var
  I: Integer;

  function IsUnique(const AName: string): Boolean;
  var
    I: Integer;
    Owner: TComponent;
  begin
    Result := False;
    Owner := ServerOwner(Server);
    for I := 0 to Owner.ComponentCount - 1 do
      if CompareText(AName, Owner.Components[I].Name) = 0 then Exit;
    Result := True;
  end;

begin
  for I := 1 to MaxInt do
  begin
    Result := GenerateName(Server, MiddlewareClass, I);
    if IsUnique(Result) then Exit;
  end;
end;

{ TDragMiddleware }

type
  TDragMiddleware = class(TDragControlObject)
  private
    FEditor: TMiddlewareEditor;
  public
    constructor Create(AControl: TControl; AEditor: TMiddlewareEditor); reintroduce;
    property Editor: TMiddlewareEditor read FEditor;
  end;

constructor TDragMiddleware.Create(AControl: TControl; AEditor: TMiddlewareEditor);
begin
  inherited Create(AControl);
  FEditor := AEditor;
end;

{$R *.dfm}

{ TMiddlewareEditor }

destructor TMiddlewareEditor.Destroy;
begin
  FDragObject.Free;
  FDragObject := nil;
  if Server <> nil then
    Server := nil;
  inherited Destroy;
end;

procedure TMiddlewareEditor.UpdateDisplay;
begin
  UpdateMiddlewareList;
  UpdateCaption;
  UpdateSelection;
end;

procedure TMiddlewareEditor.SaveSelection(List: TListBox; var ItemIndex, TopIndex: Integer);
begin
  ItemIndex := List.ItemIndex;
  TopIndex := List.TopIndex;
  List.Items.BeginUpdate;
end;

procedure TMiddlewareEditor.RestoreSelection(List: TListBox; ItemIndex, TopIndex: Integer);
begin
  try
    if TopIndex <> -1 then List.TopIndex := TopIndex;
    if ItemIndex <> -1 then List.ItemIndex := ItemIndex;
  finally
    List.Items.EndUpdate;
    List.Invalidate;
    UpdateSelection;
  end;
end;

procedure TMiddlewareEditor.UpdateCaption;
var
  NewCaption: string;
begin
  if (Server = nil) or (csDestroying in Server.ComponentState) then
    Exit;
  if ServerOwner(Server) <> nil then
    NewCaption := Format('%s.%s', [ServerOwner(Server).Name, ServerName(Server)]);
  if Caption <> NewCaption then Caption := NewCaption;
end;

procedure TMiddlewareEditor.UpdateMiddlewareList;
var
  ItemIndex, TopIndex: Integer;
  EnableList: Boolean;
  I: Integer;
  Middleware: TSparkleMiddleware;
  MiddlewareName: string;
  ActiveListbox: TListbox;
begin
  if FUpdateCount = 0 then
  begin
    FMiddlewareListUpdated := False;
    ActiveListbox := MiddlewareListBox;
    SaveSelection(ActiveListBox, ItemIndex, TopIndex);
    try
      MiddlewareListBox.Clear;
      EnableList := False;
      try
        if Server = nil then Exit;
        for I := 0 to Server.MiddlewareList.Count - 1 do
        begin
          Middleware := Server.MiddlewareList[I];
          if not (csDestroying in Middleware.ComponentState) and
             (Middleware.Owner = ServerOwner(Server)) then
          begin
            MiddlewareName := Middleware.DisplayName;
            if MiddlewareName = '' then
              MiddlewareName := Format('<%s>', [Middleware.Name]);
            MiddlewareListbox.Items.AddObject(MiddlewareName, Middleware);
          end;
        end;
        EnableList := True;
      finally
        MiddlewareListBox.Enabled := EnableList;
      end;
    finally
      if ActiveListBox.Visible then
        RestoreSelection(ActiveListBox, ItemIndex, TopIndex);
    end;
  end else
    FMiddlewareListUpdated := True;
end;

procedure TMiddlewareEditor.UpdateSelection;
begin
  if Active then
  begin
    if MiddlewareListBox.ItemIndex >= 0 then
      Designer.SelectComponent(TSparkleMiddleware(MiddlewareListBox.Items.Objects[MiddlewareListBox.ItemIndex]))
    else
      Designer.SelectComponent(Server);
  end;
  btDelete.Enabled := MiddlewareListBox.ItemIndex >= 0;
  btMoveUp.Enabled := btDelete.Enabled;
  btMoveDown.Enabled := btDelete.Enabled;
end;

function TMiddlewareEditor.CreateMiddleware(const DisplayName: string): TSparkleMiddleware;
begin
  Result := nil;
  if DisplayName = '' then Exit;
  try
    BeginUpdate;
    try
      Result := DoCreateMiddleware(DisplayName);
    finally
      EndUpdate;
      Designer.Modified;
    end;
  finally
    UpdateDisplay;
  end;
end;

procedure TMiddlewareEditor.RemoveMiddleware(Listbox: TListbox);
var
  I: Integer;
begin
  CheckMiddlewareDelete;
  try
    BeginUpdate;
    try
      I := ListBox.ItemIndex;
      if I >= 0 then
      begin
        TSparkleMiddleware(ListBox.Items.Objects[I]).Free;
        Designer.Modified;
      end;
    finally
      EndUpdate;
    end;
  finally
    UpdateDisplay;
  end;
  if I <> -1 then
  begin
    I := Min(I, ListBox.Items.Count - 1);
    ListBox.ItemIndex := I;
    UpdateSelection;
  end;
  ListBox.SetFocus;
end;

procedure TMiddlewareEditor.MoveMiddlewareItems(MoveOffset: Integer);
var
  I: Integer;
  Middleware: TSparkleMiddleware;
begin
  try
    I := MiddlewareListBox.ItemIndex;
    if I = -1 then Exit;
    Middleware := TSparkleMiddleware(MiddlewareListBox.Items.Objects[I]);
    Server.MiddlewareList.SetMiddlewareIndex(Middleware, I + MoveOffset);
    MiddlewareListBox.ItemIndex := Server.MiddlewareList.IndexOf(Middleware);
  finally
    UpdateDisplay;
    Designer.Modified;
  end;
end;

procedure TMiddlewareEditor.SetServer(Value: TSparkleServer);
begin
  if FServer <> Value then
  begin
    if FServer <> nil then
      FServer.RemoveFreeNotification(Self);
    FServer := Value;
    if FServer <> nil then
    begin
      FServer.FreeNotification(self);
      UpdateDisplay;
    end
    else
      Release;
  end;
end;

procedure TMiddlewareEditor.FormCreate(Sender: TObject);
begin
  FMinWidth := Width;
  FMinHeight := Height;
end;

procedure TMiddlewareEditor.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (AComponent = Server) and (Operation = opRemove) then
    Server := nil;
end;

procedure TMiddlewareEditor.AddMiddleware;
begin
  DoAddMiddleware;
  MiddlewareListBox.SetFocus;
end;

procedure TMiddlewareEditor.DoAddMiddleware;
var
  AddMiddlewareForm: TAddMiddlewareForm;
  MiddlewareClass: TSparkleMiddlewareClass;
begin
  CheckMiddlewareAdd;
  AddMiddlewareForm := TAddMiddlewareForm.Create(Application);
  try
    for MiddlewareClass in RegisteredMiddleware do
      AddMiddlewareForm.MiddlewareList.Items.Add(MiddlewareClass.DisplayName);

    if AddMiddlewareForm.MiddlewareList.Count > 0 then
      AddMiddlewareForm.MiddlewareList.ItemIndex := 0;
    if AddMiddlewareForm.ShowModal <> mrCancel then
      CreateMiddleware(AddMiddlewareForm.Selected);
  finally
    AddMiddlewareForm.Free;
  end;
end;

function TMiddlewareEditor.DoCreateMiddleware(
  const DisplayName: string): TSparkleMiddleware;
var
  MiddlewareClass: TSparkleMiddlewareClass;
begin
  MiddlewareClass := FindMiddleware(DisplayName);
  Assert(Assigned(MiddlewareClass), Format('Invalid middleware name "%s"', [DisplayName]));
  Result := MiddlewareClass.Create(ServerOwner(Server));
  try
    Result.Name := CreateUniqueName(Server, MiddlewareClass);
    Result.Server := Server;
  except
    Result.Free;
    raise;
  end;
end;

procedure TMiddlewareEditor.AddItemClick(Sender: TObject);
begin
  AddMiddleware;
end;

procedure TMiddlewareEditor.DeleteItemClick(Sender: TObject);
begin
  RemoveMiddleware(MiddlewareListBox);
end;

procedure TMiddlewareEditor.MiddlewareListBoxDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  Item: Integer;

  procedure DrawRect(Item: Integer);
  begin
    if Item <> -1 then
      MiddlewarelistBox.Canvas.DrawFocusRect(MiddlewarelistBox.ItemRect(Item));
    FFocusRectItem := Item;
  end;

begin
  Item := MiddlewareListBox.ItemAtPos(Point(X, Y), False);
  Accept := (Source is TDragMiddleware) and
    (TDragMiddleware(Source).Control = MiddlewareListBox) and
    (Item >= 0) and (Item < MiddlewareListBox.Items.Count) and
    (MiddlewareListBox.ItemIndex <> Item);
  if State = dsDragEnter then FFocusRectItem := -1;
  if (State = dsDragLeave) or not Accept then Item := -1;
  DrawRect(FFocusRectItem);
  DrawRect(Item);
end;

procedure TMiddlewareEditor.MiddlewareListBoxDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  Middleware: TSparkleMiddleware;
  OldIndex: Integer;
  I: Integer;
begin
  if (Source is TDragMiddleware) and (TDragMiddleware(Source).Control = MiddlewareListBox) then
  begin
    try
      Middleware := TSparkleMiddleware(MiddlewareListBox.Items.Objects[MiddlewareListBox.ItemAtPos(Point(X, Y), True)]);
      I := MiddlewareListBox.ItemIndex;
      if I >= 0 then
      begin
        OldIndex := Server.MiddlewareList.IndexOf(Middleware);
        Server.MiddlewareList.SetMiddlewareIndex(
          TSparkleMiddleware(MiddlewareListBox.Items.Objects[I]),
          OldIndex
        );
        MiddlewareListBox.ItemIndex := OldIndex;
      end;
    finally
      UpdateDisplay;
      Designer.Modified;
    end;
  end;
end;

procedure TMiddlewareEditor.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
  inherited;
  with Message.MinMaxInfo^.ptMinTrackSize do
  begin
    X := FMinWidth;
    Y := FMinHeight;
  end;
end;

procedure TMiddlewareEditor.AListBoxKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_INSERT: AddItemClick(Self);
    VK_DELETE: RemoveMiddleware(Sender as TListbox);
    VK_UP:
      if (ssCtrl in Shift) and (Sender = MiddlewareListBox) then MoveMiddlewareItems(-1) else Exit;
    VK_DOWN:
      if (ssCtrl in Shift) and (Sender = MiddlewareListBox) then MoveMiddlewareItems(1) else Exit;
  else
    Exit;
  end;
  Key := 0;
end;

procedure TMiddlewareEditor.Activated;
begin
  Designer.Activate;
  try
    UpdateSelection;
  except
    MiddlewareListBox.Items.Clear;
  end;
end;

function TMiddlewareEditor.GetEditState: TEditState;

  function MiddlewareItemsSelected(Listbox: TListbox): Boolean;
  var
    I: Integer;
  begin
    Result := True;
    with ListBox do
      for I := 0 to Items.Count - 1 do
        if Selected[I] then Exit;
    Result := False;
  end;

begin
  Result := [];
  if MiddlewareItemsSelected(MiddlewareListbox) then
    Result := Result + [esCanDelete];
end;

function TMiddlewareEditor.EditAction(Action: TEditAction): Boolean;
begin
  Result := True;
  case Action of
    eaDelete: RemoveMiddleware(MiddlewareListBox);
  else
    Result := False;
  end;
end;

procedure TMiddlewareEditor.Endupdate;
begin
  if FUpdateCount > 0 then
  begin
    Dec(FUpdateCount);
    if (FUpdateCount = 0) and FMiddlewareListUpdated then
      UpdateMiddlewareList;
  end;
end;

procedure TMiddlewareEditor.ItemsModified(const Designer: IDesigner);
begin
  UpdateCaption;
end;

procedure TMiddlewareEditor.SelectionChanged(const ADesigner: IDesigner; const ASelection: IDesignerSelections);
var
  I: Integer;
  S: Boolean;

  function InSelection(Component: TComponent): Boolean;
  var
    I: Integer;
  begin
    Result := True;
    if ASelection <> nil then
      for I := 0 to ASelection.Count - 1 do
        if Component = ASelection.Items[I] then Exit;
    Result := False;
  end;

begin
  for I := 0 to MiddlewareListBox.Items.Count - 1 do
  begin
    S := InSelection(TComponent(MiddlewareListBox.Items.Objects[I]));
    if MiddlewareListBox.Selected[I] <> S then
      MiddlewareListBox.Selected[I] := S;
  end;
end;

procedure TMiddlewareEditor.SelectTable(Sender: TObject);
begin
  MiddlewareListBox.ItemIndex := -1;
  UpdateSelection;
  MiddlewareListBox.SetFocus;
end;

procedure TMiddlewareEditor.ListBoxClick(Sender: TObject);
begin
  UpdateSelection;
end;

procedure TMiddlewareEditor.AListBoxKeyPress(Sender: TObject;
  var Key: Char);
begin
  case Key of
    #13, #33..#126:
      begin
        if Key = #13 then Key := #0;
        ActivateInspector(Key);
        Key := #0;
      end;
    #27:
      begin
        SelectTable(Self);
        Key := #0;
      end;
  end;
end;

procedure TMiddlewareEditor.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TMiddlewareEditor.btMoveDownClick(Sender: TObject);
begin
  MoveMiddlewareItems(1);
end;

procedure TMiddlewareEditor.btMoveUpClick(Sender: TObject);
begin
  MoveMiddlewareItems(-1);
end;

procedure TMiddlewareEditor.MiddlewareListBoxStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  if MiddlewareListBox.Items.Count > 0 then
  begin
    if FDragObject = nil then
      FDragObject := TDragMiddleware.Create(MiddlewareListBox, Self);
    DragObject := FDragObject;
  end;
end;

procedure TMiddlewareEditor.LocalMenuPopup(Sender: TObject);
var
  EditState: TEditState;
begin
  EditState := GetEditState;
  DeleteItem.Enabled := esCanDelete in EditState;
end;

procedure TMiddlewareEditor.CheckMiddlewareDelete;
begin
  if (MiddlewareListBox.ItemIndex >= 0) and
    (csAncestor in TSparkleMiddleware(MiddlewareListBox.Items.Objects[MiddlewareListBox.ItemIndex]).ComponentState) then
      raise Exception.CreateRes(@SCantDeleteAncestor);
end;

procedure TMiddlewareEditor.CheckMiddlewareAdd;
begin
  if (FServer <> nil) and (ServerOwner(FServer) <> nil) and
    (csInline in ServerOwner(FServer).ComponentState) then
    raise Exception.CreateRes(@SCantAddToFrame);
end;

procedure TMiddlewareEditor.ItemDeleted(const ADesigner: IDesigner; AItem: TPersistent);
begin
  if AItem = Server then
    Server := nil
  else
  if (AItem is TSparkleMiddleware) and (TSparkleMiddleware(AItem).Server = Server) then
    UpdateDisplay;
end;

end.

