abactnlistedit.pas

1. It is located in the root directory - SecurityBuilderDemo.exe. Leave password box blank and click

unit abActnListEdit;
//v 3.0

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{$IFDEF DELPHI5}
  dsgnintf,
{$ENDIF}
{$IFDEF CPPB5}
  dsgnintf,
{$ENDIF}
{$IFDEF DELPHI6}
  DesignIntf, DesignEditors,
{$ENDIF}
  ComCtrls, StdCtrls, ImgList, ExtCtrls, ToolWin, abSecurity, abMisc, abActnLst, Buttons, Menus,
  ActnList, Mask, CheckLst;

type
  TabActionListEditor = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    ilActions: TImageList;
    img1: TImage;
    img2: TImage;
    ActionList2: TActionList;
    actNewHierarchicalNode: TAction;
    actDeleteNode: TAction;
    pmnuNode: TPopupMenu;
    mnuNewNode: TMenuItem;
    mnuDeleteNode: TMenuItem;
    actNewCheckableNode: TAction;
    actChangeId: TAction;
    mnuNewCheckableNode: TMenuItem;
    clbActions: TCheckListBox;
    procedure clbActionsClick(Sender: TObject);
  private

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TabActionListProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  TabActionListEdit = class({TDefaultEditor} TComponentEditor)
  public
    //procedure EditProperty(PropertyEditor: TPropertyEditor; var Continue, FreeEditor: Boolean); override;
    procedure Edit; override;

    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  procedure Register;

implementation

{$R *.DFM}

uses TypInfo;

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TabActionListDesigner), TabActionList, 'ActionListDesigner', TabActionListProperty);
  //RegisterComponentEditor(TabActionList, TabActionListEdit);
end;


function abActionListDesign(ActionList: TabActionList): boolean;
var
  i, j, k: integer;
  bFound: boolean;
  iFoundIndex: integer;
  sControlNames, sControlName, sLoopControlName: String;
  abAction: TabAction;
  //AB
  abActionComponent: TabActionComponent;
begin
  with TabActionListEditor.Create(Application) do
  try
    for i:= Pred(ActionList.Owner.ComponentCount) downto 0 do
    begin
      if TabActionComponent.IsActionComponent(ActionList.Owner.Components[i]) then
      begin
        //AB
        abActionComponent := TabActionComponent(ActionList.Owner.Components[i]);

        if Assigned({//AB TControl(ActionList.Owner.Components[i]}abActionComponent.Action) then
        begin
          bFound := false;
          for j := Pred(ActionList.ActionCount) downto 0 do
            if (ActionList.Actions[j] = abActionComponent.Action)   then
            begin
              clbActions.Items.AddObject(abActionComponent.Name +
                           '/ ' + abActionComponent.Action.Name,
                           abActionComponent);
              clbActions.State[Pred(clbActions.Items.Count)] := cbChecked;
              bFound := true;
              break;
            end;
          if not bFound then
          begin
            clbActions.Items.AddObject(abActionComponent.Name +
                           '/ ' + abActionComponent.Action.Name +
                           '/ Foreign Action (may be copied to an TabAction)',
                           abActionComponent);
            clbActions.State[Pred(clbActions.Items.Count)] := cbUnchecked;//Grayed;
          end;
        end
        else
        begin
          bFound := false;
          iFoundIndex := -1;
          //PTypeInfo((Instance.ClassType).ClassInfo)
          //PTypeInfo((ActionList.Owner.Components[i].ClassType).ClassInfo)
          //if not Assigned(GetPropInfo(ActionList.Owner.Components[i], 'Action', [])) then
          if not Assigned(GetPropInfo(PTypeInfo((abActionComponent.ClassType).ClassInfo), 'Action'{, []})) then
          begin
            for j := Pred(ActionList.ActionCount) downto 0 do
            begin
              if ActionList.Actions[j] is TabAction then
              begin
                sControlName := abActionComponent.Name;
                sControlNames := TabAction(ActionList.Actions[j]).ControlNames;
                k := 1;
                sLoopControlName := GetStringItem(sControlNames, k, C_SEPARATOR_CONTROL_NAME);
                while length(sLoopControlName) > 0 do
                begin
                  if 0 = CompareText(sControlName, sLoopControlName) then
                  begin
                     abActionComponent.Action := TabAction(ActionList.Actions[j]);
                     iFoundIndex := j;
                     bFound := true;
                     break;
                  end;
                  inc(k);
                  sLoopControlName := GetStringItem(sControlNames, k, C_SEPARATOR_CONTROL_NAME);
                end;
                if bFound then
                  break;
              end;
            end;
          end;
          if bFound then
          begin
            clbActions.Items.AddObject(abActionComponent.Name +
                           '/ ' + ActionList.Actions[iFoundIndex].Name +
                           '/ Foreign Action',
                           abActionComponent);
            clbActions.State[Pred(clbActions.Items.Count)] := cbChecked;
          end
          else
          begin
            clbActions.Items.AddObject(abActionComponent.Name,
                                       abActionComponent);
          end;
        end;
      end;
    end;

    if mrOK = ShowModal then
    begin
      for i := Pred(clbActions.Items.Count) downto 0 do
      begin
        bFound := false;
        iFoundIndex := -1;
        //AB
        abActionComponent := TabActionComponent(clbActions.Items.Objects[i]);

        if Assigned(abActionComponent.Action) then
          for j := Pred(ActionList.ActionCount) downto 0 do
            if ActionList.Actions[j] = abActionComponent.Action then
            begin
              iFoundIndex := j;
              bFound := true;
              break;
            end;

        if not clbActions.Checked[i] then
          abActionComponent.Action := nil;

        if (not bFound) and clbActions.Checked[i] then
        begin
          if Assigned(abActionComponent.Action) then
          begin
            abAction := ActionList.MakeAnabCopy(TAction(abActionComponent.Action));

            if (length(abAction.Caption) = 0) or (abAction.Caption = abAction.Name) then
              abAction.Caption := abActionComponent.Text;

            if not Assigned(abAction.OnExecute) then
              abAction.OnExecute := abActionComponent.OnClick;
            if Length(abAction.Hint) = 0 then
              abAction.Hint := abActionComponent.Hint;

            abActionComponent.Action := abAction;
          end
          else
          begin
            abAction := ActionList.MakeAnabCopy(nil);
            if (length(abAction.Caption) = 0) or (abAction.Caption = abAction.Name) then
              abAction.Caption := abActionComponent.Text;
            if not Assigned(abAction.OnExecute) then
              abAction.OnExecute := abActionComponent.OnClick;
            if Length(abAction.Hint) = 0 then
              abAction.Hint := abActionComponent.Hint;

            abActionComponent.Action := abAction;

            //clbActions.Items.Objects[i]
            if Assigned(GetPropInfo(PTypeInfo((abActionComponent.ClassType).ClassInfo), 'Action'{, []})) then
            begin
              //All done
            end
            else
            begin
              if length(TabAction(abActionComponent.Action).ControlNames) = 0 then
                abActionComponent.Action.ControlNames :=
                  abActionComponent.Name
              else
                abActionComponent.Action.ControlNames :=
                  abActionComponent.Action.ControlNames +
                  C_SEPARATOR_CONTROL_NAME + abActionComponent.Name;
            end;
          end;
        end;

        if bFound and (not clbActions.Checked[i]) then
        begin
          //clbActions.Items.Objects[i]
          if not Assigned(GetPropInfo(PTypeInfo((abActionComponent.ClassType).ClassInfo), 'Action'{, []})) then
            if ActionList.Actions[iFoundIndex] is TabAction then
            begin
              sControlNames := TabAction(ActionList.Actions[iFoundIndex]).ControlNames;
              sControlName := abActionComponent.Name;
              j := 1;
              sLoopControlName := GetStringItem(sControlNames, j, C_SEPARATOR_CONTROL_NAME);
              while length(sLoopControlName) > 0 do
              begin
                if 0 = CompareText(sControlName, sLoopControlName) then
                begin
                   TabAction(ActionList.Actions[iFoundIndex]).ControlNames := DeleteStringItem(sControlNames, j, C_SEPARATOR_CONTROL_NAME);
                   break;
                end;
                inc(j);
                sLoopControlName := GetStringItem(sControlNames, j, C_SEPARATOR_CONTROL_NAME);
              end;

            end
            else
            begin
              //Nothing to do
            end;
        end;
      end;
      Result := true;
    end
    else
      Result := false;
  finally
    Destroy;
  end;
end;

procedure TabActionListProperty.Edit;
begin
  if abActionListDesign(TabActionList(GetComponent(0))) then
    Modified;
end;

function TabActionListProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

{procedure TabActionListEdit.EditProperty(PropertyEditor: TPropertyEditor; var Continue, FreeEditor: Boolean);
begin
  PropertyEditor.Edit;
end;}

procedure TabActionListEdit.Edit;
begin
  ExecuteVerb(0);
end;

procedure TabActionListEdit.ExecuteVerb(Index: Integer);
begin
  if index = 0 then
    inherited ExecuteVerb(Index)
  else
    if abActionListDesign(TabActionList(Component)) then
      GetDesigner.Modified;
end;

function TabActionListEdit.GetVerb(Index: Integer): string;
begin
  if Index = 0 then
    Result := inherited GetVerb(Index)
  else
    Result := 'Edit abActionList Template';
end;

function TabActionListEdit.GetVerbCount: Integer;
begin
  Result := 2;
end;

constructor TabActionListEditor.Create(AOwner: TComponent);
begin
  inherited ;
end;

destructor TabActionListEditor.Destroy;
begin
  inherited;
end;

procedure TabActionListEditor.clbActionsClick(Sender: TObject);
{$IFDEF DELPHI4}
var
  bChecked: boolean;// need to restore it because when setting Item text the check state changes
{$ENDIF}
begin
{$IFDEF DELPHI4}
  bChecked := clbActions.Checked[clbActions.ItemIndex];
  try
{$ENDIF}
    if not Assigned(TabActionComponent(clbActions.Items.Objects[clbActions.ItemIndex]).Action) then
      if clbActions.Checked[clbActions.ItemIndex] then
      begin
        if pos(RCST_TEXT_NEW_ACTION, clbActions.Items[clbActions.ItemIndex]) <> 1 then
          clbActions.Items[clbActions.ItemIndex] := RCST_TEXT_NEW_ACTION + clbActions.Items[clbActions.ItemIndex];
      end
      else if Pos(RCST_TEXT_NEW_ACTION, clbActions.Items[clbActions.ItemIndex]) = 1 then
      begin
        clbActions.Items[clbActions.ItemIndex] := Copy(clbActions.Items[clbActions.ItemIndex], Succ(length(RCST_TEXT_NEW_ACTION)),
                                           length(clbActions.Items[clbActions.ItemIndex]) - Pred(length(RCST_TEXT_NEW_ACTION)));
      end;
{$IFDEF DELPHI4}
  finally
    if bChecked <> clbActions.Checked[clbActions.ItemIndex] then
    begin
      clbActions.OnClick := nil;
      try
        clbActions.Checked[clbActions.ItemIndex] := bChecked;
      finally
        clbActions.OnClick := clbActionsClick;
      end;
    end;
  end;
{$ENDIF}
end;

end.