Componentes.Terceros.jvcl/official/3.36/archive/QNotebook.pas
2009-02-27 12:23:32 +00:00

364 lines
8.9 KiB
ObjectPascal

{-----------------------------------------------------------------------------
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: QNotebook.pas, released on 2004-05-16
The Initial Developer of the Original Code is Andreas Hausladen
[Andreas dott Hausladen att gmx dott de]
Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.
Contributor(s):
Known Issues:
----------------------------------------------------------------------------}
// $Id: QNotebook.pas 11641 2007-12-24 16:34:00Z outchy $
unit QNotebook;
interface
uses
SysUtils, Classes, Contnrs, Types, Qt, QGraphics, QControls, QForms;
type
TPage = class(TCustomControl)
protected
procedure ReadState(Reader: TReader); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption;
property Height stored False;
property TabOrder stored False;
property Visible stored False;
property Width stored False;
end;
TNotebook = class(TCustomControl)
private
FPages: TStrings;
FPageIndex: Integer;
FOnPageChanged: TNotifyEvent;
procedure SetPages(Value: TStrings);
procedure SetActivePage(const Value: string);
function GetActivePage: string;
procedure SetPageIndex(Value: Integer);
procedure ShowPage(Index: Integer);
function GetPageControls(Index: Integer): TPage;
function GetPageCount: Integer;
protected
function GetChildOwner: TComponent; override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
procedure ReadState(Reader: TReader); override;
procedure ShowControl(AControl: TControl); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property PageCount: Integer read GetPageCount;
property PageControls[Index: Integer]: TPage read GetPageControls;
published
property ActivePage: string read GetActivePage write SetActivePage stored False;
property Align;
property Anchors;
property Color;
property DragMode;
property Font;
property Enabled;
property Constraints;
property PageIndex: Integer read FPageIndex write SetPageIndex default 0;
property Pages: TStrings read FPages write SetPages stored False;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
property OnStartDrag;
end;
implementation
uses
QConsts;
type
TPages = class(TStringList)
private
FPageList: TObjectList;
FNotebook: TNotebook;
FLoadingAdd: TPage;
protected
procedure Put(Index: Integer; const S: string); override;
procedure InsertItem(Index: Integer; const S: string; AObject: TObject); override;
public
constructor Create(ANotebook: TNotebook);
destructor Destroy; override;
procedure Clear; override;
procedure Add(Page: TPage); reintroduce;
procedure Delete(Index: Integer); override;
procedure Move(CurIndex, NewIndex: Integer); override;
end;
{ TPage }
constructor TPage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Visible := False;
ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible, csNoFocus];
Align := alClient;
end;
procedure TPage.Paint;
begin
if csDesigning in ComponentState then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := psDash;
Canvas.Rectangle(0, 0, Width, Height);
end;
end;
procedure TPage.ReadState(Reader: TReader);
begin
if Reader.Parent is TNotebook then
begin
with TPages(TNotebook(Reader.Parent).FPages) do
begin
FLoadingAdd := Self;
Add(Self);
end;
end;
inherited ReadState(Reader);
end;
{ TPages }
constructor TPages.Create(ANotebook: TNotebook);
begin
inherited Create;
FPageList := TObjectList.Create;
FNotebook := ANotebook;
end;
destructor TPages.Destroy;
begin
Clear;
FPageList.Free;
inherited Destroy;
end;
procedure TPages.Clear;
begin
while FPageList.Count > 0 do
Delete(0);
end;
procedure TPages.Delete(Index: Integer);
begin
inherited Delete(Index);
FPageList.Delete(Index);
if Index >= Count then
Dec(Index);
FNotebook.PageIndex := Index;
end;
procedure TPages.InsertItem(Index: Integer; const S: string;
AObject: TObject);
begin
inherited InsertItem(Index, S, AObject);
if FLoadingAdd = nil then
FLoadingAdd := TPage.Create(FNotebook);
FLoadingAdd.Parent := FNotebook;
FPageList.Insert(Index, FLoadingAdd);
FLoadingAdd := nil;
FNotebook.PageIndex := Index;
end;
procedure TPages.Move(CurIndex, NewIndex: Integer);
begin
inherited Move(CurIndex, NewIndex);
FPageList.Move(CurIndex, NewIndex);
end;
procedure TPages.Put(Index: Integer; const S: string);
begin
inherited Put(Index, S);
TPage(FPageList[Index]).Caption := S;
end;
procedure TPages.Add(Page: TPage);
begin
FLoadingAdd := Page;
inherited Add(Page.Caption);
end;
{ TNotebook }
var
NotebookRegistered: Boolean = False;
constructor TNotebook.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Exclude(FComponentStyle, csInheritable);
Width := 150;
Height := 150;
FPages := TPages.Create(Self);
FPageIndex := -1;
FPages.Add(SDefault);
PageIndex := 0;
if not NotebookRegistered then
begin
RegisterClasses([TPage]);
NotebookRegistered := True;
end;
end;
destructor TNotebook.Destroy;
begin
FPages.Free;
inherited Destroy;
end;
function TNotebook.GetActivePage: string;
begin
if PageIndex <> -1 then
Result := Pages[PageIndex]
else
Result := '';
end;
function TNotebook.GetChildOwner: TComponent;
begin
Result := Self;
end;
procedure TNotebook.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
i: Integer;
begin
for i := 0 to PageCount - 1 do
Proc(PageControls[i]);
end;
function TNotebook.GetPageControls(Index: Integer): TPage;
begin
Result := TPage(TPages(Pages).FPageList[Index]);
end;
function TNotebook.GetPageCount: Integer;
begin
Result := FPages.Count;
end;
procedure TNotebook.Paint;
begin
if (PageCount = 0) and (csDesigning in ComponentState) then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := psDot;
Canvas.Rectangle(0, 0, Width, Height);
end;
end;
procedure TNotebook.ReadState(Reader: TReader);
begin
Pages.Clear;
inherited ReadState(Reader);
if (PageIndex <> -1) and (Cardinal(PageIndex) < Cardinal(PageCount)) then
ShowPage(PageIndex)
else
FPageIndex := -1;
end;
procedure TNotebook.SetActivePage(const Value: string);
begin
PageIndex := FPages.IndexOf(Value);
end;
procedure TNotebook.SetPageIndex(Value: Integer);
var
ParentForm: TCustomForm;
begin
if csLoading in ComponentState then
begin
FPageIndex := Value;
Exit;
end;
if (Value <> FPageIndex) and (Cardinal(Value) < Cardinal(PageCount)) then
begin
ParentForm := GetParentForm(Self);
if ParentForm <> nil then
if ContainsControl(ParentForm.ActiveControl) then
ParentForm.ActiveControl := Self;
ShowPage(Value);
if (Cardinal(FPageIndex) < Cardinal(PageCount)) then
PageControls[FPageIndex].Visible := False;
FPageIndex := Value;
if ParentForm <> nil then
if ParentForm.ActiveControl = Self then
SelectFirst;
if Assigned(FOnPageChanged) then
FOnPageChanged(Self);
end;
end;
procedure TNotebook.SetPages(Value: TStrings);
begin
FPages.Assign(Value);
end;
procedure TNotebook.ShowControl(AControl: TControl);
var
i: Integer;
begin
for i := 0 to PageCount - 1 do
if PageControls[i] = AControl then
begin
PageIndex := i;
Exit;
end;
inherited ShowControl(AControl);
end;
procedure TNotebook.ShowPage(Index: Integer);
begin
with PageControls[Index] do
begin
Align := alClient;
BringToFront;
Visible := True;
end
end;
end.