6

コンポーネントにアクション サポートを追加するにはどうすればよいですか。ボタンコンポーネントですが、どのコンポーネントタイプでも同じだと思います。どんな情報や方法でも役立ちます。

4

3 に答える 3

15

それは、アクション サポートをどのように定義するかによって異なります。次の 2 種類があります。

  • Action コンポーネントによって割り当て可能な、コンポーネントのおそらくカスタマイズされた Action プロパティ
  • Action コンポーネント自体。

アクション プロパティ

すべての TControl の子孫には、デフォルトで左マウス ボタンのクリックにリンクされた実行の Action プロパティがあります。このリンクは ActionLink によって管理されます。デフォルトの ActionLink は、アクションとコントロールの両方のキャプション、ヒント、有効状態などの同期を処理する TControlActionLink 型です。この基本機能だけが必要な場合は、コンポーネント タイプ宣言で Action プロパティを公開するだけで、 SergとLU RDがすでに回答したように、Delphi フレームワークがすべてを処理します。

独自の Action プロパティを他の条件またはイベント (つまり、Click 以外) にリンクする場合、またはコンポーネントの特定のサブ要素 (TControl の子孫ではない) に Action プロパティを実装する場合は、カスタム ActionLink クラスを定義して実装することにより、独自のカスタム Action プロパティを実装できます。

コンポーネントが列を持つある種のグリッドであり、ユーザーが列のタイトルをクリックしたときに呼び出されるアクション プロパティをすべての列に持たせたいとします。このような列は TCollectionItem 型である可能性が高いため、列型にはデフォルトでアクション プロパティがありません。したがって、自分で実装する必要があります。アクションのキャプションを列のタイトルにリンクし、アクションの有効状態を逆に列の readonly プロパティにリンクする次の例を考えてみましょう...:

unit Unit1;

interface

uses
  Classes, ActnList, SysUtils;

type
  TColumn = class;

  TColumnActionLink = class(TActionLink)
  protected
    FClient: TColumn;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsEnabledLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
    procedure SetCaption(const Value: String); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
    procedure SetVisible(Value: Boolean); override;
  end;

  TColumnActionLinkClass = class of TColumnActionLink;

  TColumn = class(TCollectionItem)
  private
    FActionLink: TColumnActionLink;
    FGrid: TComponent;
    FOnTitleClick: TNotifyEvent;
    FReadOnly: Boolean;
    FTitle: String;
    FVisible: Boolean;
    function DefaultTitleCaption: String;
    procedure DoActionChange(Sender: TObject);
    function GetAction: TBasicAction;
    function IsOnTitleClickStored: Boolean;
    function IsReadOnlyStored: Boolean;
    function IsVisibleStored: Boolean;
    procedure SetAction(Value: TBasicAction);
  protected
    procedure ActionChanged(Sender: TObject; CheckDefaults: Boolean); dynamic;
    procedure DoTitleClick; virtual;
    function GetActionLinkClass: TColumnActionLinkClass; virtual;
    property ActionLink: TColumnActionLink read FActionLink write FActionLink;
  public
    destructor Destroy; override;
    procedure InitiateAction; virtual;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property OnTitleClick: TNotifyEvent read FOnTitleClick write FOnTitleClick
      stored IsOnTitleClickStored;
    property ReadOnly: Boolean read FReadOnly write FReadOnly
      stored IsReadOnlyStored;
    property Title: String read FTitle write FTitle;
    property Visible: Boolean read FVisible write FVisible
      stored IsVisibleStored;
  end;

implementation

{ TColumnActionLink }

procedure TColumnActionLink.AssignClient(AClient: TObject);
begin
  FClient := TColumn(AClient);
end;

function TColumnActionLink.IsCaptionLinked: Boolean;
begin
  Result := inherited IsCaptionLinked and (Action is TCustomAction) and
    (FClient.Title = TCustomAction(Action).Caption);
end;

function TColumnActionLink.IsEnabledLinked: Boolean;
begin
  Result := inherited IsEnabledLinked and (Action is TCustomAction) and
    (FClient.ReadOnly <> TCustomAction(Action).Enabled);
end;

function TColumnActionLink.IsOnExecuteLinked: Boolean;
begin
  Result := inherited IsOnExecuteLinked and
    (@FClient.OnTitleClick = @Action.OnExecute);
end;

function TColumnActionLink.IsVisibleLinked: Boolean;
begin
  Result := inherited IsVisibleLinked and (Action is TCustomAction) and
    (FClient.Visible = TCustomAction(Action).Visible);
end;

procedure TColumnActionLink.SetCaption(const Value: string);
begin
  if IsCaptionLinked then
    FClient.Title := Value;
end;

procedure TColumnActionLink.SetEnabled(Value: Boolean);
begin
  if IsEnabledLinked then
    FClient.ReadOnly := not Value;
end;

procedure TColumnActionLink.SetOnExecute(Value: TNotifyEvent);
begin
  if IsOnExecuteLinked then
    FClient.OnTitleClick := Value;
end;

procedure TColumnActionLink.SetVisible(Value: Boolean);
begin
  if IsVisibleLinked then
    FClient.Visible := Value;
end;

{ TColumn }

procedure TColumn.ActionChanged(Sender: TObject; CheckDefaults: Boolean);
begin
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults or (Caption = DefaultTitleCaption) then
        FTitle := Caption;
      if not CheckDefaults or (not ReadOnly) then
        ReadOnly := not Enabled;
      if not CheckDefaults or not Assigned(FOnTitleClick) then
        FOnTitleClick := OnExecute;
      if not CheckDefaults or (Self.Visible = True) then
        Self.Visible := Visible;
      Changed(False);
    end;
end;

function TColumn.DefaultTitleCaption: String;
begin
  Result := 'Column' + IntToStr(Index);
end;

destructor TColumn.Destroy;
begin
  FreeAndNil(FActionLink);
  inherited Destroy;
end;

procedure TColumn.DoActionChange(Sender: TObject);
begin
  if Sender = Action then
    ActionChanged(Sender, False);
end;

procedure TColumn.DoTitleClick;
begin
  if Assigned(FOnTitleClick) then
    if (Action <> nil) and (@FOnTitleClick <> @Action.OnExecute) then
      FOnTitleClick(Self)
    else if FActionLink = nil then
      FOnTitleClick(Self)
    else if FActionLink <> nil then
      if (FGrid <> nil) and not (csDesigning in FGrid.ComponentState) then
      begin
        if not FActionLink.Execute(FGrid) then
          FOnTitleClick(Self);
      end
      else
        if not FActionLink.Execute(nil) then
          FOnTitleClick(Self);
end;

function TColumn.GetAction: TBasicAction;
begin
  if FActionLink <> nil then
    Result := FActionLink.Action
  else
    Result := nil;
end;

function TColumn.GetActionLinkClass: TColumnActionLinkClass;
begin
  Result := TColumnActionLink;
end;

procedure TColumn.InitiateAction;
begin
  if FActionLink <> nil then
    FActionLink.Update;
end;

function TColumn.IsOnTitleClickStored: Boolean;
begin
  Result := (FActionLink = nil) or not ActionLink.IsOnExecuteLinked;
end;

function TColumn.IsReadOnlyStored: Boolean;
begin
  Result := (FActionLink = nil) or not FActionLink.IsEnabledLinked;
  if Result then
    Result := FReadOnly;
end;

function TColumn.IsVisibleStored: Boolean;
begin
  Result := (FActionLink = nil) or not FActionLink.IsVisibleLinked;
  if Result then
    Result := not Visible;
end;

procedure TColumn.SetAction(Value: TBasicAction);
begin
  if Value = nil then
    FreeAndNil(FActionLink)
  else
  begin
    if FActionLink = nil then
      FActionLink := GetActionLinkClass.Create(Self);
    FActionLink.Action := Value;
    FActionLink.OnChange := DoActionChange;
    ActionChanged(Value, csLoading in Value.ComponentState);
    if FGrid <> nil then
      Value.FreeNotification(FGrid);
  end;
  Changed(False);
end;

end.

このコードは、適用可能なアクション部分のみに取り除かれていることに注意してください。

ソース: www.nldelphi.com .

アクション コンポーネント

アクションコンポーネントは、任意のコンポーネントのアクションプロパティに割り当てることができます。しかし、そのようなアクション コンポーネントの記述に関連するすべてのことを説明することは非常に包括的であるため、以下の例を提供することで自分自身を簡単にすることができます。

ズーム機能を提供するコントロールを作成し、対応する ZoomIn および ZoomOut アクションをツールバー ボタンに割り当てる必要があるとします。

unit Zoomer;

interface

uses
  Classes, Controls, ActnList, Forms, Menus, Windows;

type
  TZoomer = class;

  TZoomAction = class(TCustomAction)
  private
    FZoomer: TZoomer;
    procedure SetZoomer(Value: TZoomer);
  protected
    function GetZoomer(Target: TObject): TZoomer;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    destructor Destroy; override;
    function HandlesTarget(Target: TObject): Boolean; override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property OnExecute; { This property could be omitted. But if you want to be
                          able to override the default behavior of this action
                          (zooming in on a TZoomer component), then you need to
                          assign this event. From within the event handler
                          you could invoke the default behavior manually. }
    property OnHint;
    property OnUpdate;
    property Zoomer: TZoomer read FZoomer write SetZoomer;
  end;

  TZoomInAction = class(TZoomAction)
  public
    constructor Create(AOwner: TComponent); override;
    procedure ExecuteTarget(Target: TObject); override;
  end;

  TZoomer = class(TCustomControl)
  public
    procedure ZoomIn;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('RoyMKlever', [TZoomer]);
  RegisterActions('Zoomer', [TZoomInAction], nil);
end;

{ TZoomAction }

destructor TZoomAction.Destroy;
begin
  if FZoomer <> nil then
    FZoomer.RemoveFreeNotification(Self);
  inherited Destroy;
end;

function TZoomAction.GetZoomer(Target: TObject): TZoomer;
begin
  if FZoomer <> nil then
    Result := FZoomer
  else if (Target is TZoomer) and TZoomer(Target).Focused then
    Result := TZoomer(Target)
  else if Screen.ActiveControl is TZoomer then
    Result := TZoomer(Screen.ActiveControl)
  else
    { This should not happen! HandlesTarget is called before ExecuteTarget,
      or the action is disabled }
    Result := nil;
end;

function TZoomAction.HandlesTarget(Target: TObject): Boolean;
begin
  Result := ((FZoomer <> nil) and FZoomer.Enabled) or
    ((FZoomer = nil) and (Target is TZoomer) and TZoomer(Target).Focused) or
    ((Screen.ActiveControl is TZoomer) and Screen.ActiveControl.Enabled);
end;

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

procedure TZoomAction.SetZoomer(Value: TZoomer);
begin
  if FZoomer <> Value then
  begin
    if FZoomer <> nil then
      FZoomer.RemoveFreeNotification(Self);
    FZoomer := Value;
    if FZoomer <> nil then
      FZoomer.FreeNotification(Self);
  end;
end;

procedure TZoomAction.UpdateTarget(Target: TObject);
begin
  Enabled := HandlesTarget(Target);
end;

{ TZoomInAction }

constructor TZoomInAction.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := 'Zoom in';
  Hint := 'Zoom in|Zooms in on the selected zoomer control';
  ShortCut := Menus.ShortCut(VK_ADD, [ssCtrl]);
end;

procedure TZoomInAction.ExecuteTarget(Target: TObject);
begin
  GetZoomer(Target).ZoomIn;
  { For safety, you cóuld check if GetZoomer <> nil. See remark in GetZoomer. }
end;

{ TZoomer }

procedure TZoomer.ZoomIn;
begin
  { implementation of zooming in }
end;

end.

このアクションを (ツールバー ボタンをクリックするか、メニュー項目を選択して) アクティブにすると、次の優先順位で ZoomIn ルーチンが呼び出されます。

  1. アクションの関連プロパティに手動で設定した Zoomer コントロール。
  2. アプリケーションによってTargetが要求されますが、そのターゲットがフォーカスされた Zoomer コントロールである場合、またはそれ以外の場合のみ:
  3. アプリケーション全体でアクティブなコントロールですが、それが有効な Zoomer コントロールである場合に限ります。

その後、ZoomOut アクションが単純に追加されます。

type
  TZoomOutAction = class(TZoomAction)
  public
    constructor Create(AOwner: TComponent); override;
    procedure ExecuteTarget(Target: TObject); override;
  end;

{ TZoomOutAction }

constructor TZoomOutAction.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := 'Zoom out';
  Hint := 'Zoom out|Zooms out on the selected zoomer control';
  ShortCut := Menus.ShortCut(VK_SUBTRACT, [ssCtrl]);
end;

procedure TZoomOutAction.ExecuteTarget(Target: TObject);
begin
  GetZoomer(Target).ZoomOut;
end;

アクション コンポーネントを設計時に使用するには、IDE に登録する必要があることに注意してください。

Delphi ヘルプの該当する読み取り食品:

ソース: www.nldelphi.com .

于 2011-07-24T11:41:01.063 に答える
8

基本的なアクション サポートは TControl クラスに実装されているため、最も単純なケースでは、コンポーネントを TControl の子孫から継承し、Actionプロパティを公開済みとして宣言するだけです。例:

type
  TMyGraphicControl = class(TGraphicControl)
  published
    property Action;
  end;

コンポーネントに TAction プロパティにリンクする必要がある追加のプロパティがある場合は、ActionChangeメソッドもオーバーライドする必要があります。

于 2011-07-24T11:06:40.243 に答える
2

コンポーネントがすでにTButtonの子孫である場合、アクションサポートは継承されます。あなたがする必要があるのは、アクションプロパティを公開済みとして宣言することだけです。

于 2011-07-24T11:03:36.240 に答える