sactions.pas

AlphaControls是一个Delphi标准控件的集合

unit sActions;
{$I sDefs.inc}

interface

uses SysUtils, Windows, Controls, Classes, ComCtrls, Graphics, ActnList, StdActns,
  StdCtrls, ShellAPI, Dialogs, ExtDlgs, Registry, ImgList, UrlMon, ActiveX, sPageControl;

{ TsPageAction }
type
  TsPageAction = class;
  TValidateTabEvent = procedure(Sender: TsPageAction; sPageControl: TsPageControl;
    var Enabled: Boolean) of object;

  TsPageAction = class(TCustomAction)
  private
    FAfterTabChange: TNotifyEvent;
    FBeforeTabChange: TNotifyEvent;
    FEnabled: Boolean;
    FOnValidateTab: TValidateTabEvent;
    FSkipHiddenTabs: Boolean;
    FsPageControl: TsPageControl;
    FWrap: Boolean;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SelectNextTab(GoForward: Boolean = True);
  public
    constructor Create(AOwner: TComponent); override;
    function HandlesTarget(Target: TObject): Boolean; override;
    procedure UpdateTarget(Target: TObject); override;
    property SkipHiddenTabs :Boolean read FSkipHiddenTabs write FSkipHiddenTabs default True;
    property sPageControl: TsPageControl read FsPageControl write FsPageControl;
    property Wrap: Boolean read FWrap write FWrap default False;
    property BeforeTabChange: TNotifyEvent read FBeforeTabChange write FBeforeTabChange;
    property AfterTabChange: TNotifyEvent read FAfterTabChange write FAfterTabChange;
    property OnValidateTab: TValidateTabEvent read FOnValidateTab write FOnValidateTab;
  end;

{ TsPreviousPage }

  TsPreviousPage = class(TsPageAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property sPageControl;
    property Caption;
    property Enabled;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SkipHiddenTabs;
    property Visible;
    property Wrap;
    property AfterTabChange;
    property BeforeTabChange;
    property OnHint;
    property OnValidateTab;
  end;

{ TsNextPage }

  TsNextPage = class(TsPageAction)
  private
    FOldCaption: String;
    FLastTabCaption: String;
    FOnFinish: TNotifyEvent;
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property LastTabCaption: String read FLastTabCaption write FLastTabCaption;
    property sPageControl;
    property Caption;
    property Enabled;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SkipHiddenTabs;    
    property Visible;
    property Wrap;
    property AfterTabChange;
    property BeforeTabChange;
    property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
    property OnHint;
    property OnValidateTab;
  end;

implementation

{ TsPageAction }

constructor TsPageAction.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DisableIfNoHandler := False;
  Enabled := csDesigning in ComponentState;
  FSkipHiddenTabs := True;
end;

function TsPageAction.HandlesTarget(Target: TObject): Boolean;
begin
  Result := Assigned(FsPageControl);
end;

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

type
  TsPageControlClass = class(TsPageControl);

procedure TsPageAction.UpdateTarget(Target: TObject);
begin
  if FsPageControl is TsPageControl then
    FEnabled := Assigned(FsPageControl) and FsPageControl.Enabled and
      (TsPageControl(FsPageControl).PageCount > 0)
  else
    FEnabled := Assigned(FsPageControl) and FsPageControl.Enabled and
      (TsPageControlClass(FsPageControl).Tabs.Count > 0);
  if FEnabled and Assigned(FOnValidateTab) then
    FOnValidateTab(Self, FsPageControl, FEnabled);
end;

procedure TsPageAction.SelectNextTab(GoForward: Boolean = True);
const
  Direction: array[Boolean] of Integer = (-1, 1);
begin
  if Assigned(FBeforeTabChange) then
    FBeforeTabChange(Self);
  if FsPageControl is TsPageControl then
  begin
    with FsPageControl as TsPageControl do
      if Wrap and GoForward and (ActivePageIndex = PageCount - 1) then
        ActivePageIndex := 0
      else if Wrap and not GoForward and (ActivePageIndex = 0) then
        ActivePageIndex := PageCount - 1
      else
        SelectNextPage(GoForward{, FSkipHiddenTabs});
  end
  else if FsPageControl is TsPageControl then
    with TsPageControlClass(FsPageControl) do
      if Wrap and GoForward and (TabIndex = Tabs.Count - 1) then
        TabIndex := 0
      else if Wrap and not GoForward and (TabIndex = 0) then
        TabIndex := Tabs.Count - 1
      else
        TabIndex := TabIndex + Direction[GoForward];
  if Assigned(FAfterTabChange) then
    FAfterTabChange(Self);
end;

{ TsPreviousPage }

procedure TsPreviousPage.ExecuteTarget(Target: TObject);
begin
  SelectNextTab(False)
end;

procedure TsPreviousPage.UpdateTarget(Target: TObject);
begin
  inherited UpdateTarget(Target);
  if FEnabled then
  begin
    if FWrap then
      Enabled := True
    else
      if FsPageControl is TsPageControl then
        Enabled := (TsPageControl(FsPageControl).ActivePageIndex > 0)
      else
        Enabled := (TsPageControlClass(FsPageControl).TabIndex > 0);
  end;
end;

{ TsNextPage }

procedure TsNextPage.ExecuteTarget(Target: TObject);

  function NextPage: Boolean;
  begin
    if FsPageControl is TsPageControl then
      with TsPageControl(FsPageControl) do
        Result := ActivePageIndex < PageCount - 1
    else
      with TsPageControlClass(FsPageControl) do
        Result := TabIndex < Tabs.Count - 1;
  end;

begin
  if NextPage or FWrap then
    SelectNextTab
  else
    if (Length(FLastTabCaption) > 0) and Assigned(FOnFinish) then
      FOnFinish(Self);
end;

procedure TsNextPage.UpdateTarget(Target: TObject);

  function OnLastTab: Boolean;
  begin
    if FsPageControl is TsPageControl then
      with TsPageControl(FsPageControl) do
        Result := ActivePageIndex = PageCount - 1
    else
      with TsPageControlClass(FsPageControl) do
        Result := TabIndex = Tabs.Count - 1;
  end;

begin
  inherited UpdateTarget(Target);
  if not FWrap and FEnabled and (Length(FLastTabCaption) = 0) and OnLastTab then
    Enabled := False
  else
    Enabled := FEnabled;
  if not Enabled then exit;
  if not FWrap and OnLastTab then
  begin
    if (Caption <> FLastTabCaption) then
    begin
      FOldCaption := Caption;
      Caption := FLastTabCaption;
    end;
  end
  else
    if (Length(FOldCaption) > 0) and (CompareText(Caption, FOldCaption) <> 0) then
    begin
      Caption := FOldCaption;
      FOldCaption := ''
    end;
end;

end.