abactnedit.pas

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

unit abActnEdit;

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, Buttons, Menus,
  ActnList, CheckLst, abActnLst;

type
  TabActionEditor = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    pmnuNode: TPopupMenu;
    mnuNewNode: TMenuItem;
    mnuDeleteNode: TMenuItem;
    mnuNewCheckableNode: TMenuItem;
    clbActions: TCheckListBox;
    procedure clbActionsClick(Sender: TObject);
  private
    fabActionInDesign: TabAction;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

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

  TabActionEdit = class(TDefaultEditor{v1.4 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(TabActionDesigner), TabAction, 'ActionDesigner', TabActionProperty);
  //RegisterComponentEditor(TabAction, TabActionEdit);
end;


function isActionAssignedToControl(Action: TabAction; sControlName: string; var indexFound: integer): boolean;
var
  i: integer;
  sLoopControlName: string;
begin
  i := 1;
  sLoopControlName := GetStringItem(Action.ControlNames, i, C_SEPARATOR_CONTROL_NAME);
  while length(sLoopControlName) > 0 do
  begin
    if 0 = CompareText(sControlName, sLoopControlName) then
    begin
       Result := true;
       indexFound := i;
       exit;
    end;
    inc(i);
    sLoopControlName := GetStringItem(Action.ControlNames, i, C_SEPARATOR_CONTROL_NAME);
  end;
  indexFound := -1;
  Result := false;
end;

function abActionDesign(abAction: TabAction): boolean;
var
  i, j: integer;
  //AB
  abActionComponent: TabActionComponent;
begin
  with TabActionEditor.Create(Application) do
  try
    fabActionInDesign := abAction;//AB
    for i:= Pred(abAction.Owner.ComponentCount) downto 0 do
    begin
      if TabActionComponent.IsActionComponent(abAction.Owner.Components[i]) then
      begin
        //AB
        abActionComponent := TabActionComponent(abAction.Owner.Components[i]);

        if (abActionComponent.Action = abAction) or
           isActionAssignedToControl(abAction, abActionComponent.Name, j) then
        begin
          clbActions.Items.AddObject(abActionComponent.Name,// +
                           //'/ ' + abActionComponent.Action.Name,
                           abActionComponent);
          clbActions.State[Pred(clbActions.Items.Count)] := cbChecked;
        end
        else if not Assigned(abActionComponent.Action) then
        begin
          clbActions.Items.AddObject(abActionComponent.Name,// +
                           //'/ ' + abActionComponent.Action.Name,
                           abActionComponent);
          clbActions.State[Pred(clbActions.Items.Count)] := cbUnChecked;
        end;
      end;
    end;

    if mrOK = ShowModal then
    begin
      for i := Pred(clbActions.Items.Count) downto 0 do
      begin
        //AB
        abActionComponent := TabActionComponent(clbActions.Items.Objects[i]);
        if clbActions.State[i] = cbChecked then
        begin
          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 not Assigned(GetPropInfo(PTypeInfo((abActionComponent.ClassType).ClassInfo), 'Action'{, []})) then
            if not isActionAssignedToControl(abAction, abActionComponent.Name, j) then
            begin
              if Length(abAction.ControlNames) = 0 then
                abAction.ControlNames := abActionComponent.Name
              else
                abAction.ControlNames := abAction.ControlNames + C_SEPARATOR_CONTROL_NAME + abActionComponent.Name;
            end;
        end
        else
        begin
          //clbActions.Items.Objects[i]
          if Assigned(GetPropInfo(PTypeInfo((abActionComponent.ClassType).ClassInfo), 'Action'{, []})) then
            abActionComponent.Action := nil
          else if isActionAssignedToControl(abAction, abActionComponent.Name, j) then
          begin
            abAction.ControlNames := DeleteStringItem(abAction.ControlNames, j, C_SEPARATOR_CONTROL_NAME);
            abActionComponent.Action := nil;
          end;
        end;
      end;
      Result := true;
    end
    else
      Result := false;
  finally
    Destroy;
  end;
end;

procedure TabActionProperty.Edit;
begin
  if abActionDesign(TabAction(GetComponent(0))) then
    Modified;
end;

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

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

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

procedure TabActionEdit.ExecuteVerb(Index: Integer);
begin
  if index = 0 then
    inherited ExecuteVerb(Index)
  else
    if abActionDesign(TabAction(Component)) then
      GetDesigner.Modified;
end;

function TabActionEdit.GetVerb(Index: Integer): string;
begin
  if Index = 0 then
    Result := inherited GetVerb(Index)
  else
    Result := 'Edit abAction Linked Controls';
end;

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

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

destructor TabActionEditor.Destroy;
begin
  inherited;
end;

procedure TabActionEditor.clbActionsClick(Sender: TObject);
var
  sMessageWarning: string;
{$IFDEF DELPHI4}
  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
    begin
      if clbActions.Checked[clbActions.ItemIndex] then
      begin
        sMessageWarning := '';
        if (nil <> @TabActionComponent(clbActions.Items.Objects[clbActions.ItemIndex]).OnClick) and
           (@fabActionInDesign.OnExecute <> @TabActionComponent(clbActions.Items.Objects[clbActions.ItemIndex]).OnClick) then
          sMessageWarning := 'The component has onClick method assigned and it differs from abAction.OnExecute handler.';
        if (length(TabActionComponent(clbActions.Items.Objects[clbActions.ItemIndex]).Text) > 0) and
           (fabActionInDesign.Caption <> TabActionComponent(clbActions.Items.Objects[clbActions.ItemIndex]).Text) then
          sMessageWarning := sMessageWarning + #13#10 + 'The component has Text/Caption property assigned and it differs from abAction.Caption property.';
        if (length(TabActionComponent(clbActions.Items.Objects[clbActions.ItemIndex]).Hint) > 0) and
           (fabActionInDesign.Hint <> TabActionComponent(clbActions.Items.Objects[clbActions.ItemIndex]).Hint) then
          sMessageWarning := sMessageWarning + #13#10 + 'The component has Hint property assigned and it differs from abAction.Hint property.';
        if length(sMessageWarning) > 0 then
        begin
          sMessageWarning := sMessageWarning + #13#10 + 'Assigning will override the component characteristics with the abAction''s ones. Continue?';
          if MessageDlg(sMessageWarning,  mtWarning, [mbYes, mbNo], 0) <> mrYes then
          begin
            clbActions.OnClick := nil;
            try
              clbActions.Checked[clbActions.ItemIndex] := false;
            finally
              clbActions.OnClick := clbActionsClick;
            end;
{$IFDEF DELPHI4}
            bChecked := false;
{$ENDIF}
            exit;            
          end;
        end;
      end;

      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;
    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.