pagemngr.pas

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

    if Proxy.Owner = Writer.Root then Writer.WriteComponent(Proxy);
  end;
end;
{$ENDIF WIN32}

procedure TPageManager.SetDestroyHandles(Value: Boolean);
begin
  if Value <> FDestroyHandles then begin
    FDestroyHandles := Value;
    if not (csLoading in ComponentState) and FDestroyHandles then
      DormantPages;
  end;
end;

procedure TPageManager.SetPageOwner(Value: TPageOwner);
begin
  if FPageOwner <> Value then begin
    FPageOwner := Value;
{$IFDEF WIN32}
    if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
    if not (csLoading in ComponentState) then begin
      Resync;
      if FDestroyHandles then DormantPages;
      if (FPageOwner <> nil) and (FPageHistory.Count = 0) then begin
        FPageHistory.AddPageIndex(FPageOwner.PageIndex);
      end;
    end;
  end;
end;

procedure TPageManager.SetPageProxies(Value: TList);
begin
end;

function TPageManager.GetProxyIndex(const PageName: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FPageProxies.Count - 1 do begin
    if TPageProxy(FPageProxies.Items[I]).PageName = PageName then begin
      Result := I;
      Exit;
    end;
  end;
end;

procedure TPageManager.Resync;
var
  I: Integer;
  Index: Integer;
  NewCount: Integer;
  NewProxy: TPageProxy;
begin
  if FPageOwner = nil then Exit;
  if PageCount > FPageProxies.Count then begin
    NewCount := PageCount - FPageProxies.Count;
    for I := 1 to NewCount do begin
      NewProxy := TPageProxy.Create(Owner);
      AddProxy(NewProxy);
      if Assigned(FOnCheckProxy) then FOnCheckProxy(NewProxy);
      {NewProxy.Name := GetUniqueName(NewProxy);}
      NewProxy.PageName := FindFreePage;
    end;
  end;
  for I := FPageProxies.Count - 1 downto 0 do begin
    if FPageProxies.Count > PageCount then begin
      if (TPageProxy(FPageProxies.Items[I]).PageName <> '') and
        (FPageOwner.Pages.IndexOf(TPageProxy(FPageProxies.Items[I]).PageName) = -1) then
        TPageProxy(FPageProxies.Items[I]).Free;
    end
    else Break;
  end;
  for I := 0 to FPageProxies.Count - 1 do
    if Assigned(FOnCheckProxy) then
      FOnCheckProxy(TObject(FPageProxies.Items[I]));
  for I := 0 to PageCount - 1 do begin
    Index := GetProxyIndex(PageNames[I]);
    if Index <> -1 then begin
      FPageProxies.Move(Index, I);
    end;
  end;
end;

procedure TPageManager.AddProxy(Proxy: TPageProxy);
begin
  FPageProxies.Add(Proxy);
  Proxy.FPageManager := Self;
end;

procedure TPageManager.RemoveProxy(Proxy: TPageProxy);
begin
  Proxy.FPageManager := nil;
  FPageProxies.Remove(Proxy);
end;

procedure TPageManager.DestroyProxies;
var
  Proxy: TPageProxy;
begin
  while FPageProxies.Count > 0 do begin
    Proxy := FPageProxies.Last;
    RemoveProxy(Proxy);
    Proxy.Free;
  end;
end;

function TPageManager.GetPageCount: Integer;
begin
  Result := 0;
  if FPageOwner <> nil then begin
    Result := FPageOwner.Pages.Count;
  end;
end;

function TPageManager.GetPageName(Index: Integer): string;
begin
  Result := '';
  if (FPageOwner <> nil) and (Index < PageCount) then begin
    Result := FPageOwner.Pages[Index];
  end;
end;

function TPageManager.FindFreePage: string;
var
  I: Integer;
begin
  Result := '';
  if PageOwner <> nil then
    for I := 0 to PageOwner.Pages.Count - 1 do
      if GetProxyIndex(PageOwner.Pages[I]) = -1 then begin
        Result := PageOwner.Pages[I];
        Exit;
      end;
end;

function TPageManager.GetPageIndex: Integer;
begin
  if PageOwner <> nil then Result := PageOwner.PageIndex
  else Result := pageNull;
end;

procedure TPageManager.SetPageIndex(Value: Integer);
var
  Page: TPageItem;
  OldPageIndex: Integer;
begin
  if PageOwner <> nil then begin
    OldPageIndex := PageOwner.PageIndex;
    PageOwner.PageIndex := Value;
    if DestroyHandles then DormantPages;
    if OldPageIndex <> PageOwner.PageIndex then begin
      if not FUseHistory then begin
        PageHistory.AddPageIndex(PageOwner.PageIndex);
      end
      else begin
        case HistoryCommand of
          hcNone: ;
          hcAdd: PageHistory.AddPageIndex(PageOwner.PageIndex);
          hcBack: PageHistory.Current := PageHistory.Current - 1;
          hcForward: PageHistory.Current := PageHistory.Current + 1;
          hcGoto: ;
        end;
      end;
    end;
    HistoryCommand := hcAdd;
    CheckBtnEnabled;
    { update owner form help context }
    if FChangeHelpContext and (Owner <> nil) and (Owner is TForm) and
      ((Owner as TForm).HelpContext = 0) then
    begin
      Page := TPageItem(PageOwner.Pages.Objects[PageIndex]);
      if Page <> nil then (Owner as TForm).HelpContext := Page.HelpContext;
    end;
  end;
end;

function TPageManager.GetNextEnabled: Boolean;
begin
  Result := GetNextPageIndex(PageIndex) >= 0;
end;

function TPageManager.GetPriorEnabled: Boolean;
begin
  Result := GetPriorPageIndex(PageIndex) >= 0;
end;

procedure TPageManager.NextPage;
begin
  ChangePage(True);
end;

procedure TPageManager.PriorPage;
begin
  ChangePage(False);
end;

procedure TPageManager.GotoHistoryPage(HistoryIndex: Integer);
var
  SaveCurrent: Integer;
begin
  SaveCurrent := PageHistory.Current;
  HistoryCommand := hcGoto;
  PageHistory.Current := HistoryIndex;
  try
    SetPage(PageHistory.PageIndexes[HistoryIndex], False);
  finally
    if PageOwner.PageIndex <> PageHistory.PageIndexes[HistoryIndex] then
      PageHistory.Current := SaveCurrent;
  end;
end;

procedure TPageManager.PageEnter(Page: Integer; Next: Boolean);
var
  ProxyIndex: Integer;
begin
  ProxyIndex := GetProxyIndex(PageOwner.Pages.Strings[Page]);
  if ProxyIndex <> pageNull then begin
    TPageProxy(FPageProxies.Items[ProxyIndex]).PageEnter(Next);
  end;
end;

procedure TPageManager.PageLeave(Page: Integer; Next: Boolean);
var
  ProxyIndex: Integer;
begin
  ProxyIndex := GetProxyIndex(PageOwner.Pages.Strings[Page]);
  if ProxyIndex <> pageNull then begin
    TPageProxy(FPageProxies.Items[ProxyIndex]).PageLeave(Next);
  end;
end;

procedure TPageManager.PageShow(Page: Integer; Next: Boolean);
var
  ProxyIndex: Integer;
begin
  ProxyIndex := GetProxyIndex(PageOwner.Pages.Strings[Page]);
  if ProxyIndex <> pageNull then begin
    TPageProxy(FPageProxies.Items[ProxyIndex]).PageShow(Next);
  end;
end;

procedure TPageManager.PageHide(Page: Integer; Next: Boolean);
var
  ProxyIndex: Integer;
begin
  ProxyIndex := GetProxyIndex(PageOwner.Pages.Strings[Page]);
  if ProxyIndex <> pageNull then begin
    TPageProxy(FPageProxies.Items[ProxyIndex]).PageHide(Next);
  end;
end;

procedure TPageManager.PageChanged;
begin
  if Assigned(FOnPageChanged) then FOnPageChanged(Self);
end;

function TPageManager.GetPriorPageIndex(Page: Integer): Integer;
begin
  if not FUseHistory then begin
    if Page < 1 then
      Result := pageNull
    else
      Result := Page - 1;
    end
  else begin
    if PageHistory.Current < 1 then
      Result := pageNull
    else
      Result := PageHistory.PageIndexes[PageHistory.Current - 1];
  end;
  if Assigned(FOnGetPriorPage) then FOnGetPriorPage(Page, Result);
end;

function TPageManager.GetNextPageIndex(Page: Integer): Integer;
begin
  if not FUseHistory then begin
    if Page >= PageCount - 1 then
      Result := pageNull
    else
      Result := Page + 1;
    end
  else begin
    if PageHistory.Current >= PageHistory.Count - 1 then
      Result := pageNull
    else
      Result := PageHistory.PageIndexes[PageHistory.Current + 1];
  end;
  if Assigned(FOnGetNextPage) then FOnGetNextPage(Page, Result);
end;

procedure TPageManager.SetPage(NewPageIndex: Integer; Next: Boolean);
var
  OldPageIndex: Integer;
begin
  if (NewPageIndex >=0) and (NewPageIndex < PageCount) then begin
    OldPageIndex := PageIndex;
    PageLeave(OldPageIndex, Next);
    PageEnter(NewPageIndex, Next);
    SetPageIndex(NewPageIndex);
    if NewPageIndex = PageIndex then begin
      PageHide(OldPageIndex, Next);
      PageShow(NewPageIndex, Next);
      PageChanged;
    end;
  end;
end;

procedure TPageManager.ChangePage(Next: Boolean);
var
  NewPageIndex: Integer;
begin
  if Next then begin
    NewPageIndex := GetNextPageIndex(PageIndex);
    HistoryCommand := hcForward;
  end
  else begin
    NewPageIndex := GetPriorPageIndex(PageIndex);
    HistoryCommand := hcBack;
  end;
  SetPage(NewPageIndex, Next);
end;

type
  THack = class(TWinControl);

procedure TPageManager.DormantPages;
var
  I: Integer;
begin
  if Assigned(FPageOwner) then
    with PageOwner do begin
      for I := 0 to Pages.Count - 1 do
        if PageIndex <> I then
          THack(Pages.Objects[I]).DestroyHandle;
    end;
end;

{ TPageHistory }

constructor TPageHistory.Create;
begin
  inherited Create;
  FCurrent := -1;
  FHistoryCapacity := 10;
end;

destructor TPageHistory.Destroy;
begin
  ResetHistory;
  inherited Destroy;
end;

procedure TPageHistory.SetCurrent(Value: Integer);
begin
  if Value < 0 then Value := -1;
  if Value > Count - 1 then Value := Count - 1;
  FCurrent := Value;
end;

procedure TPageHistory.SetHistoryCapacity(Value: Integer);
var
  I: Integer;
begin
  if Value < FHistoryCapacity then begin
    for I := 0 to Count - Value do begin
      DeleteHistoryItem(0);
    end;
  end;
  FHistoryCapacity := Value;
end;

function TPageHistory.GetPageIndex(Index: Integer): Integer;
begin
  Result := TPageHistoryItem(Items[Index]).Index;
end;

procedure TPageHistory.AddPageIndex(PageIndex: Integer);
var
  I: Integer;
  Item: TPageHistoryItem;
begin
  for I := Count - 1 downto Current + 1 do begin
    DeleteHistoryItem(I);
  end;
  for I := 0 to Count - HistoryCapacity do begin
    DeleteHistoryItem(0);
  end;
  if Count < HistoryCapacity then begin
    Item := TPageHistoryItem.Create;
    Item.Index := PageIndex;
    Add(Item);
  end;
  Current := Count - 1;
end;

procedure TPageHistory.DeleteHistoryItem(Index: Integer);
var
  Item: TPageHistoryItem;
begin
  if (Index >= 0) and (Index < Count) then begin
    Item := TPageHistoryItem(Items[Index]);
    Delete(Index);
    Item.Free;
    if Current > Count - 1 then Current := Count - 1;
  end;
end;

procedure TPageHistory.ResetHistory;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do begin
    DeleteHistoryItem(I);
  end;
end;

end.