pagemngr.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1996 AO ROSNO                   }
{         Copyright (c) 1998 Master-Bank                }
{                                                       }
{*******************************************************}

unit PageMngr;

{$I RX.INC}

interface

uses Classes, Controls, ExtCtrls;

type
  TPageNotifyEvent = procedure(Next: Boolean) of object;
  TPageRequestEvent = procedure(CurrentPage: Integer;
    var NewPage: Integer) of object;

  TPageOwner = TNotebook;
  TPageItem = TPage;
  TPageProxy = class;
  TPageHistory = class;
  TPageHistoryItem = class;
  TPageHistoryCommand = (hcNone, hcAdd, hcBack, hcForward, hcGoto);

  TPageManager = class(TComponent)
  private
    FPageOwner: TPageOwner;
    FPageProxies: TList;
    FSetStartPage: Boolean;
    FDestroyHandles: Boolean;
    FButtons: array [Boolean] of TControl;
    FSaveBtnClick: array [Boolean] of TNotifyEvent;
    FChangeHelpContext: Boolean;
    FPageHistory: TPageHistory;
    FUseHistory: Boolean;
    FHistoryCommand: TPageHistoryCommand;
    FOnGetPriorPage: TPageRequestEvent;
    FOnGetNextPage: TPageRequestEvent;
    FOnCheckButtons: TNotifyEvent;
    FOnCheckProxy: TNotifyEvent;
    FOnPageChanged: TNotifyEvent;
    procedure SetPageOwner(Value: TPageOwner);
    function GetProxyIndex(const PageName: string): Integer;
    procedure AddProxy(Proxy: TPageProxy);
    procedure RemoveProxy(Proxy: TPageProxy);
    procedure DestroyProxies;
    procedure PageEnter(Page: Integer; Next: Boolean);
    procedure PageLeave(Page: Integer; Next: Boolean);
    procedure PageShow(Page: Integer; Next: Boolean);
    procedure PageHide(Page: Integer; Next: Boolean);
    procedure PageChanged;
    function GetNextEnabled: Boolean;
    function GetPriorEnabled: Boolean;
    function GetPageIndex: Integer;
    procedure SetPageIndex(Value: Integer);
    function GetPageCount: Integer;
    function GetPageName(Index: Integer): string;
    function FindFreePage: string;
    procedure SetPageProxies(Value: TList);
    function GetButton(Index: Integer): TControl;
    procedure SetButton(Index: Integer; Value: TControl);
    procedure SetDestroyHandles(Value: Boolean);
    procedure SyncBtnClick(Index: Integer; Sync: Boolean);
    procedure BtnClick(Sender: TObject);
    procedure DormantPages;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      AOperation: TOperation); override;
{$IFDEF WIN32}
    procedure GetChildren(Proc: TGetChildProc {$IFDEF RX_D3};
      Root: TComponent {$ENDIF}); override;
{$ELSE}
    procedure WriteComponents(Writer: TWriter); override;
{$ENDIF WIN32}
    procedure ChangePage(Next: Boolean); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CheckBtnEnabled;
    procedure Resync;
    function GetPriorPageIndex(Page: Integer): Integer; virtual;
    function GetNextPageIndex(Page: Integer): Integer; virtual;
    procedure NextPage;
    procedure PriorPage;
    procedure GotoHistoryPage(HistoryIndex: Integer);
    procedure SetPage(NewPageIndex: Integer; Next: Boolean);
    property PageNames[Index: Integer]: string read GetPageName;
    property PageCount: Integer read GetPageCount;
    property PageIndex: Integer read GetPageIndex;
    property NextEnabled: Boolean read GetNextEnabled;
    property PriorEnabled: Boolean read GetPriorEnabled;
    property PageHistory: TPageHistory read FPageHistory;
    property HistoryCommand: TPageHistoryCommand read FHistoryCommand
      write FHistoryCommand;
    property OnCheckProxy: TNotifyEvent read FOnCheckProxy write FOnCheckProxy; { for internal use only }
  published
    property PageOwner: TPageOwner read FPageOwner write SetPageOwner;
    property PageProxies: TList read FPageProxies write SetPageProxies;
    property NextBtn: TControl index 1 read GetButton write SetButton;
    property PriorBtn: TControl index 0 read GetButton write SetButton;
    property SetStartPage: Boolean read FSetStartPage write FSetStartPage default True;
    property DestroyHandles: Boolean read FDestroyHandles write SetDestroyHandles default False;
    property UseHistory: Boolean read FUseHistory write FUseHistory default False;
    property OnGetPriorPage: TPageRequestEvent read FOnGetPriorPage
      write FOnGetPriorPage;
    property OnGetNextPage: TPageRequestEvent read FOnGetNextPage
      write FOnGetNextPage;
    property OnCheckButtons: TNotifyEvent read FOnCheckButtons
      write FOnCheckButtons;
    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
  end;

  TPageProxy = class(TComponent)
  private
    FPageManager: TPageManager;
    FPageName: String;
    FOnEnter: TPageNotifyEvent;
    FOnLeave: TPageNotifyEvent;
    FOnShow: TPageNotifyEvent;
    FOnHide: TPageNotifyEvent;
    function GetPageName: string;
    procedure SetPageName(const Value: string);
    procedure SetPageManager(Value: TPageManager);
    procedure PageEnter(Next: Boolean);
    procedure PageLeave(Next: Boolean);
    procedure PageShow(Next: Boolean);
    procedure PageHide(Next: Boolean);
  protected
{$IFDEF WIN32}
    procedure SetParentComponent(Value: TComponent); override;
{$ELSE}
    procedure ReadState(Reader: TReader); override;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function HasParent: Boolean; override;
{$IFDEF WIN32}
    function GetParentComponent: TComponent; override;
{$ENDIF}
    property PageManager: TPageManager read FPageManager write SetPageManager;
  published
    property PageName: string read GetPageName write SetPageName;
    property OnEnter: TPageNotifyEvent read FOnEnter write FOnEnter;
    property OnLeave: TPageNotifyEvent read FOnLeave write FOnLeave;
    property OnShow: TPageNotifyEvent read FOnShow write FOnShow;
    property OnHide: TPageNotifyEvent read FOnHide write FOnHide;
  end;

  TPageHistoryItem = class(TObject)
  public
    Index: Integer;
  end;

  TPageHistory = class(TList)
  private
    FCurrent: Integer;
    FHistoryCapacity: Integer;
    procedure SetCurrent(Value: Integer);
    procedure SetHistoryCapacity(Value: Integer);
    function GetPageIndex(Index: Integer): Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddPageIndex(PageIndex: Integer);
    procedure DeleteHistoryItem(Index: Integer);
    procedure ResetHistory;
    property Current: Integer read FCurrent write SetCurrent;
    property HistoryCapacity: Integer read FHistoryCapacity
      write SetHistoryCapacity;
    property PageIndexes[Index: Integer]: Integer read GetPageIndex;
  end;

const
  pageNull = -1;

implementation

uses SysUtils, Forms, StdCtrls {$IFDEF RX_D4}, ActnList {$ENDIF};

const
  Registered: Boolean = False;

{ TPageProxy }

constructor TPageProxy.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPageName := EmptyStr;
end;

destructor TPageProxy.Destroy;
begin
  if FPageManager <> nil then FPageManager.RemoveProxy(Self);
  //if (FPageName <> nil) and (FPageName^ <> '') then Dispose(FPageName);
  inherited Destroy;
end;

function TPageProxy.GetPageName: string;
begin
  Result := FPageName;
end;

procedure TPageProxy.SetPageName(const Value: string);
begin
  if (FPageManager <> nil) and (FPageManager.PageOwner <> nil) then
  begin
    if (FPageManager.PageOwner.Pages.IndexOf(Value) >= 0) then FPageName := Value else FPageName := '';
  end
  else FPageName := Value;
end;

procedure TPageProxy.SetPageManager(Value: TPageManager);
begin
  if FPageManager <> nil then FPageManager.RemoveProxy(Self);
  if Value <> nil then Value.AddProxy(Self);
end;

function TPageProxy.HasParent: Boolean;
begin
  Result := True;
end;

{$IFDEF WIN32}

function TPageProxy.GetParentComponent: TComponent;
begin
  Result := FPageManager;
end;

procedure TPageProxy.SetParentComponent(Value: TComponent);
begin
  if FPageManager <> nil then FPageManager.RemoveProxy(Self);
  if (Value <> nil) and (Value is TPageManager) then
    PageManager := TPageManager(Value);
end;

{$ELSE}

procedure TPageProxy.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TPageManager then begin
    PageManager := TPageManager(Reader.Parent);
  end;
end;

{$ENDIF WIN32}

procedure TPageProxy.PageEnter(Next: Boolean);
begin
  if Assigned(FOnEnter) then FOnEnter(Next);
end;

procedure TPageProxy.PageLeave(Next: Boolean);
begin
  if Assigned(FOnLeave) then FOnLeave(Next);
end;

procedure TPageProxy.PageShow(Next: Boolean);
begin
  if Assigned(FOnShow) then FOnShow(Next);
end;

procedure TPageProxy.PageHide(Next: Boolean);
begin
  if Assigned(FOnHide) then FOnHide(Next);
end;

{ TPageManager }

constructor TPageManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPageProxies := TList.Create;
  FPageHistory := TPageHistory.Create;
  FHistoryCommand := hcAdd;
  FSetStartPage := True;
  FChangeHelpContext := True;
  FUseHistory := False;
  if not Registered then begin
    RegisterClasses([TPageProxy]);
    Registered := True;
  end;
end;

destructor TPageManager.Destroy;
begin
  DestroyProxies;
  FPageProxies.Free;
  FPageHistory.Free;
  inherited Destroy;
end;

procedure TPageManager.Loaded;
var
  Loading: Boolean;
begin
  Loading := csLoading in ComponentState;
  inherited Loaded;
  if not (csDesigning in ComponentState) and Loading then begin
    SyncBtnClick(0, True);
    SyncBtnClick(1, True);
  end;
  if FSetStartPage and not (csDesigning in ComponentState) and
    (FPageOwner <> nil) and (FPageProxies.Count > 0) then
  begin
    if (FPageProxies.Items[0] <> nil) and
      (TPageProxy(FPageProxies.Items[0]).PageName <> '') then
    begin
      FPageOwner.ActivePage := TPageProxy(FPageProxies.Items[0]).PageName;
    end;
  end;
  if DestroyHandles then DormantPages;
  if (FPageOwner <> nil) and (FPageHistory.Count = 0) then begin
    FPageHistory.AddPageIndex(FPageOwner.PageIndex);
  end;
  CheckBtnEnabled;
end;

procedure TPageManager.Notification(AComponent: TComponent; AOperation: TOperation);
begin
  inherited Notification(AComponent, AOperation);
  if AOperation = opRemove then begin
    if AComponent = PageOwner then PageOwner := nil
    else if AComponent = FButtons[False] then FButtons[False] := nil
    else if AComponent = FButtons[True] then FButtons[True] := nil;
  end;
end;

function TPageManager.GetButton(Index: Integer): TControl;
begin
  Result := FButtons[Boolean(Index)];
end;

procedure TPageManager.SetButton(Index: Integer; Value: TControl);
begin
  if GetButton(Index) <> Value then begin
    if not (csLoading in ComponentState) then  SyncBtnClick(Index, False);
    FButtons[Boolean(Index)] := Value;
{$IFDEF WIN32}
    if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
    if not (csLoading in ComponentState) then  SyncBtnClick(Index, True);
  end;
end;

procedure TPageManager.SyncBtnClick(Index: Integer; Sync: Boolean);
begin
  if (GetButton(Index) <> nil) and not (csDesigning in ComponentState) then
    if Sync then begin
      FSaveBtnClick[Boolean(Index)] := TButton(GetButton(Index)).OnClick;
      TButton(GetButton(Index)).OnClick := BtnClick;
    end
    else begin
      TButton(GetButton(Index)).OnClick := FSaveBtnClick[Boolean(Index)];
      FSaveBtnClick[Boolean(Index)] := nil;
    end;
end;

procedure TPageManager.BtnClick(Sender: TObject);
var
  Next: Boolean;
begin
  for Next := False to True do
    if Sender = FButtons[Next] then begin
      ChangePage(Next);
      if Assigned(FSaveBtnClick[Next]) then FSaveBtnClick[Next](Sender);
    end;
end;

procedure TPageManager.CheckBtnEnabled;
begin
  if not (csDesigning in ComponentState) then begin
{$IFDEF RX_D4}
    if GetButton(0) <> nil then begin
      if GetButton(0).Action <> nil then
        TAction(GetButton(0).Action).Enabled := PriorEnabled
      else
        GetButton(0).Enabled := PriorEnabled;
    end;
    if GetButton(1) <> nil then begin
      if GetButton(1).Action <> nil then
        TAction(GetButton(1).Action).Enabled := NextEnabled
      else
        GetButton(1).Enabled := NextEnabled;
    end;
{$ELSE}
    if GetButton(0) <> nil then GetButton(0).Enabled := PriorEnabled;
    if GetButton(1) <> nil then GetButton(1).Enabled := NextEnabled;
{$ENDIF}
    if Assigned(FOnCheckButtons) then FOnCheckButtons(Self);
  end;
end;

{$IFDEF WIN32}
procedure TPageManager.GetChildren(Proc: TGetChildProc {$IFDEF RX_D3};
  Root: TComponent {$ENDIF});
var
  I: Integer;
begin
  inherited GetChildren(Proc{$IFDEF RX_D3}, Root {$ENDIF});
  for I := 0 to FPageProxies.Count - 1 do begin
    Proc(TPageProxy(FPageProxies.Items[I]));
  end;
end;
{$ELSE}
procedure TPageManager.WriteComponents(Writer: TWriter);
var
  I: Integer;
  Proxy: TPageProxy;
begin
  inherited WriteComponents(Writer);
  for I := 0 to FPageProxies.Count - 1 do begin
    Proxy := FPageProxies.Items[I];