{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvPageList.PAS, released on 2003-04-25. The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net] . Portions created by Peter Thörnqvist are Copyright (C) 2004 Peter Thörnqvist. All Rights Reserved. Contributor(s): You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.delphi-jedi.org Known Issues: -----------------------------------------------------------------------------} // $Id$ unit JvPageList; {$mode objfpc}{$H+} interface uses LMessages, LCLIntf, LCLType, LCLVersion, SysUtils, Classes, Graphics, Controls, Types, JvComponent, JvThemes; type EPageListError = class(Exception); IPageList = interface ['{6BB90183-CFB1-4431-9CFD-E9A032E0C94C}'] function CanChange(AIndex: Integer): Boolean; procedure SetActivePageIndex(AIndex: Integer); function GetPageCount: Integer; function GetPageCaption(AIndex: Integer): string; procedure AddPage(const ACaption: string); procedure DeletePage(Index: Integer); procedure MovePage(CurIndex, NewIndex: Integer); procedure PageCaptionChanged(Index: Integer; const NewCaption: string); end; TJvCustomPageList = class; TJvPagePaintEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect) of object; TJvPageCanPaintEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; var DefaultDraw: Boolean) of object; { TJvCustomPage is the base class for pages in a TJvPageList and implements the basic behaviour of such a control. It has support for accepting components, propagating it's Enabled state, changing it's order in the page list and custom painting } TJvCustomPage = class(TJvCustomControl) private FPageList: TJvCustomPageList; FPageIndex: Integer; FOnBeforePaint: TJvPageCanPaintEvent; FOnPaint: TJvPagePaintEvent; FOnAfterPaint: TJvPagePaintEvent; FOnHide: TNotifyEvent; FOnShow: TNotifyEvent; FData: TObject; protected procedure CreateParams(var Params: TCreateParams); override; function DoEraseBackground(ACanvas: TCanvas; Param: Integer): Boolean; override; procedure SetPageIndex(Value: Integer);virtual; function GetPageIndex: Integer;virtual; procedure SetPageList(Value: TJvCustomPageList);virtual; procedure TextChanged; override; procedure ShowingChanged; override; procedure Paint; override; procedure ReadState(Reader: TReader); override; function DoBeforePaint(ACanvas: TCanvas; ARect: TRect): Boolean; dynamic; procedure DoAfterPaint(ACanvas: TCanvas; ARect: TRect); dynamic; procedure DoPaint(ACanvas: TCanvas; ARect: TRect); virtual; procedure DoShow; virtual; procedure DoHide; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property PageList: TJvCustomPageList read FPageList write SetPageList; protected property Left stored False; property Top stored False; property Width stored False; property Height stored False; property OnHide: TNotifyEvent read FOnHide write FOnHide; property OnShow: TNotifyEvent read FOnShow write FOnShow; property OnBeforePaint: TJvPageCanPaintEvent read FOnBeforePaint write FOnBeforePaint; property OnPaint: TJvPagePaintEvent read FOnPaint write FOnPaint; property OnAfterPaint: TJvPagePaintEvent read FOnAfterPaint write FOnAfterPaint; public property Data: TObject read FData write FData; property PageIndex: Integer read GetPageIndex write SetPageIndex stored False; end; TJvCustomPageClass = class of TJvCustomPage; TJvPageChangingEvent = procedure(Sender: TObject; PageIndex: Integer; var AllowChange: Boolean) of object; { TJvCustomPageList is a base class for components that implements the IPageList interface. It works like TPageControl but does not have any tabs } TJvShowDesignCaption = ( sdcNone, sdcTopLeft, sdcTopCenter, sdcTopRight, sdcLeftCenter, sdcCenter, sdcRightCenter, sdcBottomLeft, sdcBottomCenter, sdcBottomRight, sdcRunTime ); TJvCustomPageList = class(TJvCustomControl, IUnknown, IPageList) private FPages: TList; FActivePage: TJvCustomPage; FPropagateEnable: Boolean; FOnChange: TNotifyEvent; FOnChanging: TJvPageChangingEvent; FShowDesignCaption: TJvShowDesignCaption; FHiddenPages: TList; procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST; procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND; procedure UpdateEnabled; procedure SetPropagateEnable(const Value: Boolean); procedure SetShowDesignCaption(const Value: TJvShowDesignCaption); function GetPage(Index: Integer): TJvCustomPage; protected procedure EnabledChanged; override; { IPageList } procedure AddPage(const ACaption: string); procedure DeletePage(Index: Integer); procedure MovePage(CurIndex, NewIndex: Integer); function CanChange(AIndex: Integer): Boolean; virtual; function GetActivePageIndex: Integer; virtual; procedure SetActivePageIndex(AIndex: Integer); virtual; function GetPageFromIndex(AIndex: Integer): TJvCustomPage; virtual; function GetPageCount: Integer; virtual; function GetPageCaption(AIndex: Integer): string; virtual; procedure Paint; override; procedure PageCaptionChanged(Index: Integer; const NewCaption: string); virtual; procedure Change; dynamic; procedure Loaded; override; procedure ShowControl(AControl: TControl); override; function InternalGetPageClass: TJvCustomPageClass; virtual; procedure SetActivePage(Page: TJvCustomPage); virtual; procedure InsertPage(APage: TJvCustomPage); virtual; procedure RemovePage(APage: TJvCustomPage); virtual; property PageList: TList read FPages; property HiddenPageList: TList read FHiddenPages; property PropagateEnable: Boolean read FPropagateEnable write SetPropagateEnable; property ShowDesignCaption: TJvShowDesignCaption read FShowDesignCaption write SetShowDesignCaption default sdcCenter; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChanging: TJvPageChangingEvent read FOnChanging write FOnChanging; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; // public in D2009 function FindNextPage(CurPage: TJvCustomPage; GoForward: Boolean; IncludeDisabled: Boolean): TJvCustomPage; procedure PrevPage; procedure NextPage; function HidePage(Page: TJvCustomPage): TJvCustomPage; virtual; function ShowPage(Page: TJvCustomPage; PageIndex: Integer = -1): TJvCustomPage; virtual; function GetPageClass: TJvCustomPageClass; function GetVisiblePageCount: Integer; property Height default 200; property Width default 300; property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex; property ActivePage: TJvCustomPage read FActivePage write SetActivePage; property Pages[Index: Integer]: TJvCustomPage read GetPage; default; property PageCount: Integer read GetPageCount; end; TJvStandardPage = class(TJvCustomPage) published property BorderWidth; property Caption; property Color; property DragMode; property Enabled; property Font; property Constraints; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property PageIndex; property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnHide; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; property OnShow; property OnStartDrag; property OnBeforePaint; property OnPaint; property OnAfterPaint; property OnMouseEnter; property OnMouseLeave; property OnParentColorChange; {$IF LCL_FullVersion > 1080400} property ParentBackground default False; {$ENDIF} end; TJvPageList = class(TJvCustomPageList) protected function InternalGetPageClass: TJvCustomPageClass; override; public property PageCount; published property ActivePage; property PropagateEnable; property ShowDesignCaption; property Action; property Align; property Anchors; property BiDiMode; property BorderSpacing; property BorderWidth; property ChildSizing; property DragCursor; property DragKind; property OnStartDock; property OnUnDock; property OnEndDock; property OnDockDrop; property OnDockOver; property OnGetSiteInfo; property Constraints; property DragMode; property Enabled; property PopupMenu; property ShowHint; property Visible; property OnMouseEnter; property OnMouseLeave; property OnParentColorChange; property OnChange; property OnChanging; property OnConstrainedResize; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnResize; property OnStartDrag; {$IF LCL_FullVersion > 1080400} property ParentBackground default False; {$ENDIF} end; implementation uses Forms; function GetUniqueName(AOwner: TComponent; const AClassName: string): string; var I: Integer; begin I := 0; if AOwner = nil then begin repeat Inc(I); Result := AClassName + IntToStr(I); until FindGlobalComponent(Result) = nil; end else repeat Inc(I); Result := AClassName + IntToStr(I); until AOwner.FindComponent(Result) = nil; end; //=== { TJvCustomPage } ====================================================== constructor TJvCustomPage.Create(AOwner: TComponent); begin inherited Create(AOwner); FPageIndex := -1; Align := alClient; //ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds, csNoDesignVisible, csNoFocus]; ControlStyle := ControlStyle + [csOpaque, csAcceptsControls, csNoDesignVisible]; // IncludeThemeStyle(Self, [csParentBackground]); Visible := False; DoubleBuffered := True; end; destructor TJvCustomPage.Destroy; begin PageList := nil; inherited Destroy; end; procedure TJvCustomPage.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params.WindowClass do Style := Style and not (CS_HREDRAW or CS_VREDRAW); end; procedure TJvCustomPage.DoAfterPaint(ACanvas: TCanvas; ARect: TRect); begin if Assigned(FOnAfterPaint) then FOnAfterPaint(Self, ACanvas, ARect); end; function TJvCustomPage.DoBeforePaint(ACanvas: TCanvas; ARect: TRect): Boolean; begin Result := True; if Assigned(FOnBeforePaint) then FOnBeforePaint(Self, ACanvas, ARect, Result); end; function GetDesignCaptionFlags(Value: TJvShowDesignCaption): Cardinal; begin case Value of sdcTopLeft: Result := DT_TOP or DT_LEFT; sdcTopCenter: Result := DT_TOP or DT_CENTER; sdcTopRight: Result := DT_TOP or DT_RIGHT; sdcLeftCenter: Result := DT_VCENTER or DT_LEFT; sdcCenter: Result := DT_VCENTER or DT_CENTER; sdcRightCenter: Result := DT_VCENTER or DT_RIGHT; sdcBottomLeft: Result := DT_BOTTOM or DT_LEFT; sdcBottomCenter: Result := DT_BOTTOM or DT_CENTER; sdcBottomRight: Result := DT_BOTTOM or DT_RIGHT; else Result := 0; end; end; procedure TJvCustomPage.DoPaint(ACanvas: TCanvas; ARect: TRect); var S: string; margin: Integer; begin ACanvas.Font := Font; ACanvas.Brush.Style := bsSolid; ACanvas.Brush.Color := Color; DrawThemedBackground(Self, ACanvas, ARect); if csDesigning in ComponentState then begin ACanvas.Pen.Style := psDot; ACanvas.Pen.Color := clBlack; ACanvas.Brush.Style := bsClear; ACanvas.Rectangle(ARect); ACanvas.Brush.Style := bsSolid; ACanvas.Brush.Color := Color; if (PageList <> nil) and (PageList.ShowDesignCaption <> sdcNone) then begin S := Caption; if S = '' then S := Name; // make some space around the edges margin := Scale96ToFont(4); InflateRect(ARect, -margin, -margin); if not Enabled then begin SetBkMode(ACanvas.Handle, LCLType.TRANSPARENT); ACanvas.Font.Color := clHighlightText; DrawText(ACanvas.Handle, PChar(S), Length(S), ARect, GetDesignCaptionFlags(PageList.ShowDesignCaption) or DT_SINGLELINE); OffsetRect(ARect, -1, -1); ACanvas.Font.Color := clGrayText; end; DrawText(ACanvas.Handle, PChar(S), Length(S), ARect, GetDesignCaptionFlags(PageList.ShowDesignCaption) or DT_SINGLELINE); InflateRect(ARect, +margin, +margin); end; end; if Assigned(FOnPaint) then FOnPaint(Self, ACanvas, ARect); end; function TJvCustomPage.GetPageIndex: Integer; begin if Assigned(FPageList) then Result := FPageList.PageList.IndexOf(Self) else Result := FPageIndex; end; procedure TJvCustomPage.Paint; var R: TRect; begin R := ClientRect; if DoBeforePaint(Canvas, R) then DoPaint(Canvas, R); DoAfterPaint(Canvas, R); end; procedure TJvCustomPage.ReadState(Reader: TReader); begin if Reader.Parent is TJvCustomPageList then PageList := TJvCustomPageList(Reader.Parent); inherited ReadState(Reader); end; procedure TJvCustomPage.SetPageList(Value: TJvCustomPageList); begin if FPageList <> Value then begin if Assigned(FPageList) then FPageList.RemovePage(Self); FPageList := Value; Parent := FPageList; if FPageList <> nil then FPageList.InsertPage(Self); end; end; procedure TJvCustomPage.SetPageIndex(Value: Integer); var OldIndex: Integer; begin if (Value <> PageIndex) then begin OldIndex := PageIndex; if Assigned(FPageList) and (Value >= 0) and (Value < FPageList.PageCount) then FPageList.PageList.Move(OldIndex, Value); FPageIndex := Value; end; end; function TJvCustomPage.DoEraseBackground(ACanvas: TCanvas; Param: Integer): Boolean; {$IFDEF JVCLStylesEnabled} var BrushRecall: TBrushRecall; {$ENDIF JVCLStylesEnabled} begin if DoubleBuffered then begin {$IFDEF JVCLStylesEnabled} BrushRecall := nil; try if StyleServices.Enabled and not StyleServices.IsSystemStyle then begin BrushRecall := TBrushRecall.Create(Brush); Brush.Color := StyleServices.GetSystemColor(Brush.Color); end; {$ENDIF JVCLStylesEnabled} Result := inherited DoEraseBackground(ACanvas, Param); {$IFDEF JVCLStylesEnabled} finally BrushRecall.Free; end; {$ENDIF JVCLStylesEnabled} end else begin {$IFDEF JVCLStylesEnabled} if StyleServices.Enabled then DrawThemedBackground(Self, Canvas, ClientRect, Color, ParentBackground); {$ENDIF JVCLStylesEnabled} Result := True; end; end; procedure TJvCustomPage.TextChanged; begin inherited TextChanged; if csDesigning in ComponentState then Invalidate; end; procedure TJvCustomPage.DoHide; begin if Assigned(FOnHide) then FOnHide(Self); end; procedure TJvCustomPage.DoShow; begin if Assigned(FOnShow) then FOnShow(Self); end; procedure TJvCustomPage.ShowingChanged; begin inherited ShowingChanged; try if Showing then DoShow else DoHide; except Application.HandleException(Self); end; end; //=== { TJvCustomPageList } ================================================== constructor TJvCustomPageList.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csAcceptsControls]; // IncludeThemeStyle(Self, [csParentBackground]); FPages := TList.Create; FHiddenPages := TList.Create; Height := 200; Width := 300; FShowDesignCaption := sdcCenter; ActivePageIndex := -1; end; destructor TJvCustomPageList.Destroy; var I: Integer; begin for I := FPages.Count - 1 downto 0 do TJvCustomPage(FPages[I]).FPageList := nil; FPages.Free; FHiddenPages.Free; inherited Destroy; end; function TJvCustomPageList.CanChange(AIndex: Integer): Boolean; begin Result := (AIndex >= 0) and (AIndex < PageCount); if Result and Assigned(FOnChanging) then FOnChanging(Self, AIndex, Result); end; procedure TJvCustomPageList.Change; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TJvCustomPageList.CMDesignHitTest(var Msg: TCMDesignHitTest); //var // Pt: TPoint; begin inherited; //Pt := SmallPointToPoint(Msg.Pos); //if Assigned(ActivePage) and PtInRect(ActivePage.BoundsRect, Pt) then // Msg.Result := 1; end; procedure TJvCustomPageList.WMEraseBkgnd(var Message: TLMEraseBkgnd); {$IFDEF JVCLStylesEnabled} var BrushRecall: TBrushRecall; {$ENDIF JVCLStylesEnabled} begin {$IFDEF JVCLStylesEnabled} BrushRecall := nil; try if StyleServices.Enabled and not StyleServices.IsSystemStyle then begin BrushRecall := TBrushRecall.Create(Brush); Brush.Color := StyleServices.GetSystemColor(Brush.Color); end; {$ENDIF JVCLStylesEnabled} inherited; {$IFDEF JVCLStylesEnabled} finally BrushRecall.Free; end; {$ENDIF JVCLStylesEnabled} end; procedure TJvCustomPageList.GetChildren(Proc: TGetChildProc; Root: TComponent); var I: Integer; Control: TControl; begin for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I])); for I := 0 to ControlCount - 1 do begin Control := Controls[I]; if not (Control is TJvCustomPage) and (Control.Owner = Root) then Proc(Control); end; end; function TJvCustomPageList.GetPageCaption(AIndex: Integer): string; begin if (AIndex >= 0) and (AIndex < PageCount) then Result := TJvCustomPage(FPages[AIndex]).Caption else Result := ''; end; function TJvCustomPageList.InternalGetPageClass: TJvCustomPageClass; begin Result := TJvCustomPage; end; function TJvCustomPageList.GetPageCount: Integer; begin if FPages = nil then Result := 0 else Result := FPages.Count; end; procedure TJvCustomPageList.InsertPage(APage: TJvCustomPage); begin if (APage <> nil) and (FPages.IndexOf(APage) = -1) then FPages.Add(APage); end; procedure TJvCustomPageList.Loaded; begin inherited Loaded; if (PageCount > 0) and (ActivePage = nil) then ActivePage := Pages[0]; end; procedure TJvCustomPageList.Paint; begin if (csDesigning in ComponentState) and (PageCount = 0) then begin Canvas.Pen.Color := clBlack; Canvas.Pen.Style := psDot; Canvas.Brush.Style := bsClear; Canvas.Rectangle(ClientRect); end; end; procedure TJvCustomPageList.RemovePage(APage: TJvCustomPage); var I: Integer; FNextPage: TJvCustomPage; begin FNextPage := FindNextPage(APage, True, not (csDesigning in ComponentState)); if FNextPage = APage then FNextPage := nil; { If the last page is removed, go back to the prior page } if (FNextPage <> nil) and (FNextPage.PageIndex = 0) and (APage.PageIndex > 0) then FNextPage := Pages[APage.PageIndex - 1]; APage.Visible := False; APage.FPageList := nil; FPages.Remove(APage); SetActivePage(FNextPage); // (ahuser) In some cases SetActivePage does not change FActivePage // so we force FActivePage not to be "APage" if (FActivePage = APage) or (FActivePage = nil) then begin FActivePage := nil; for I := 0 to PageCount - 1 do if Pages[I] <> APage then begin FActivePage := Pages[I]; Break; end; end; end; function TJvCustomPageList.GetPageFromIndex(AIndex: Integer): TJvCustomPage; begin if (AIndex >= 0) and (AIndex < PageCount) then Result := TJvCustomPage(Pages[AIndex]) else Result := nil; end; function TJvCustomPageList.GetVisiblePageCount: Integer; var i: Integer; begin Result := 0; for i := 0 to PageCount - 1 do if Pages[i].Visible then Inc(Result); end; procedure TJvCustomPageList.SetActivePageIndex(AIndex: Integer); begin if (AIndex > -1) and (AIndex < PageCount) then ActivePage := Pages[AIndex] else ActivePage := nil; end; procedure TJvCustomPageList.ShowControl(AControl: TControl); begin if AControl is TJvCustomPage then if ActivePage <> AControl then ActivePage := TJvCustomPage(AControl); inherited ShowControl(AControl); end; function TJvCustomPageList.GetPageClass: TJvCustomPageClass; begin Result := InternalGetPageClass; end; function TJvCustomPageList.HidePage(Page: TJvCustomPage): TJvCustomPage; var I: Integer; begin if (Page <> nil) and (Page.PageList = Self) then begin if ActivePage = Page then NextPage; if ActivePage = Page then ActivePage := nil; I := Page.PageIndex; Page.PageList := nil; Page.PageIndex := I; Result := Page; FHiddenPages.Add(Result); end else Result := nil; end; function TJvCustomPageList.ShowPage(Page: TJvCustomPage; PageIndex: Integer): TJvCustomPage; var I: Integer; begin if (Page <> nil) and (Page.PageList = nil) then begin I := Page.PageIndex; Page.PageList := Self; Page.Parent := Self; if PageIndex > -1 then Page.PageIndex := PageIndex else if I > -1 then Page.PageIndex := I; Result := Page; FHiddenPages.Remove(Result); end else Result := nil; end; procedure TJvCustomPageList.SetActivePage(Page: TJvCustomPage); var ParentForm: TCustomForm; I: Integer; begin // Mantis 3227: Checking if the page can be changed has to be done at the // beginning or the page would change but not the index... if not (csLoading in ComponentState) and not CanChange(FPages.IndexOf(Page)) then Exit; if PageCount = 0 then FActivePage := nil; if (Page = nil) or (Page.PageList <> Self) then Exit else begin ParentForm := GetParentForm(Self); if (ParentForm <> nil) and (FActivePage <> nil) and FActivePage.ContainsControl(ParentForm.ActiveControl) and not (csDesigning in ComponentState) then begin ParentForm.ActiveControl := FActivePage; if ParentForm.ActiveControl <> FActivePage then begin ActivePage := GetPageFromIndex(FActivePage.PageIndex); Exit; end; end; Page.Visible := True; Page.ControlStyle := Page.ControlStyle - [csNoDesignVisible]; for I := 0 to PageCount - 1 do if Pages[i] <> Page then begin Pages[i].Visible := False; Pages[i].ControlStyle := Pages[i].ControlStyle + [csNoDesignVisible]; end; if csDesigning in ComponentState then // Visible:=False has no real effect when in design mode Page.BringToFront; if (ParentForm <> nil) and (FActivePage <> nil) and (ParentForm.ActiveControl = FActivePage) and not (csDesigning in ComponentState) then begin if Page.CanFocus then ParentForm.ActiveControl := Page else ParentForm.ActiveControl := Self; end; Page.Refresh; if (FActivePage <> nil) and (FActivePage <> Page) then FActivePage.Visible := False; if (FActivePage <> Page) then begin FActivePage := Page; if not (csLoading in ComponentState) then Change; end; if (ParentForm <> nil) and (FActivePage <> nil) and (ParentForm.ActiveControl = FActivePage) and not (csDesigning in ComponentState) then begin FActivePage.SelectFirst; end; end; end; function TJvCustomPageList.GetActivePageIndex: Integer; begin if ActivePage <> nil then Result := ActivePage.PageIndex else Result := -1; end; procedure TJvCustomPageList.NextPage; begin if (ActivePageIndex < PageCount - 1) and (PageCount > 1) then ActivePageIndex := ActivePageIndex + 1 else if PageCount > 0 then ActivePageIndex := 0 else ActivePageIndex := -1; end; procedure TJvCustomPageList.PrevPage; begin if ActivePageIndex > 0 then ActivePageIndex := ActivePageIndex - 1 else ActivePageIndex := PageCount - 1; end; procedure TJvCustomPageList.SetPropagateEnable(const Value: Boolean); begin if FPropagateEnable <> Value then begin FPropagateEnable := Value; UpdateEnabled; end; end; procedure TJvCustomPageList.EnabledChanged; begin inherited EnabledChanged; UpdateEnabled; end; function TJvCustomPageList.FindNextPage(CurPage: TJvCustomPage; GoForward, IncludeDisabled: Boolean): TJvCustomPage; var I, StartIndex: Integer; begin if PageCount <> 0 then begin StartIndex := FPages.IndexOf(CurPage); if StartIndex < 0 then if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0; I := StartIndex; repeat if GoForward then begin Inc(I); if I >= FPages.Count then I := 0; end else begin if I <= 0 then I := FPages.Count - 1; Dec(I); end; Result := Pages[I]; if IncludeDisabled or Result.Enabled then Exit; until I = StartIndex; end; Result := nil; end; procedure TJvCustomPageList.SetShowDesignCaption(const Value: TJvShowDesignCaption); begin if FShowDesignCaption <> Value then begin FShowDesignCaption := Value; if HandleAllocated and (csDesigning in ComponentState) then RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or RDW_INVALIDATE or RDW_ALLCHILDREN); end; end; procedure TJvCustomPageList.UpdateEnabled; procedure InternalSetEnabled(AControl: TWinControl); var I: Integer; begin for I := 0 to AControl.ControlCount - 1 do begin AControl.Controls[I].Enabled := Self.Enabled; if AControl.Controls[I] is TWinControl then InternalSetEnabled(TWinControl(AControl.Controls[I])); end; end; begin if PropagateEnable then InternalSetEnabled(Self); end; function TJvCustomPageList.GetPage(Index: Integer): TJvCustomPage; begin if (Index >= 0) and (Index < FPages.Count) then Result := TJvCustomPage(FPages[Index]) else Result := nil; end; //===TJvPageList ============================================================= function TJvPageList.InternalGetPageClass: TJvCustomPageClass; begin Result := TJvStandardPage; end; procedure TJvCustomPageList.DeletePage(Index: Integer); begin if (Index >= 0) and (Index < PageCount) then Pages[Index].Free; end; procedure TJvCustomPageList.AddPage(const ACaption: string); var Page: TJvCustomPage; begin Page := GetPageClass.Create(Owner); Page.Caption := ACaption; Page.Name := GetUniqueName(Owner, Copy(Page.ClassName, 2, MaxInt)); Page.PageList := Self; if (csDesigning in ComponentState) and (ActivePage = nil) then ActivePage := Page; end; procedure TJvCustomPageList.MovePage(CurIndex, NewIndex: Integer); begin FPages.Move(CurIndex, NewIndex); end; procedure TJvCustomPageList.PageCaptionChanged(Index: Integer; const NewCaption: string); begin if (Index >= 0) and (Index < PageCount) then Pages[Index].Caption := NewCaption; end; end.