TPageControl
lazarus / 5-Lazarus Extra Components

----------------------------------------------------------------------
erpix · 2005-08-12 11:47

Where the tabs are being painted? i want to build a custom component
but can't find out on wich class and method they are drawn.

----------------------------------------------------------------------
Anonymous · 2005-11-23 07:53

maybe the tabs are drawn by windows itself.

----------------------------------------------------------------------
Whiterawen · 2008-05-10 10:06

I'll override the standard PageControl component, and add a OwnerDraw
feature.
Code: [Select]unit ExPageControl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
ComCtrls,
  ExtCtrls, LMessages, LCLType, WSExtCtrls, LCLProc;

type
  { TExCustomPage }

  TDrawEvent = procedure(Sender: TObject; ACanvas:TCanvas) of object;
 
  TExCustomPage = class(TCustomPage)
  private
    FDraw:TDrawEvent;
    procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
  public
    property OnDraw: TDrawEvent read FDraw write FDraw;
  end;

  { TExCustomNotebook }
  TDrawTabEvent = procedure(Sender: TObject; ARect:TRect;
ACanvas:TCanvas) of object;

  TExCustomNotebook = class(TCustomNotebook)
  private
    FOwnerDraw: boolean;
    FDrawBorder: TDrawEvent;
    FDrawTab: TDrawTabEvent;
    FDrawPage: TDrawEvent;
    procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
    procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY;
    procedure InsertPage(APage: TExCustomPage; Index: Integer);
    procedure SetOwnerDraw(value:boolean);
    procedure SetDrawPage(value:TDrawEvent);
  published
    property OwnerDraw:boolean read FOwnerDraw write SetOwnerDraw
default false;
    property OnDrawBorder: TDrawEvent read FDrawBorder write
FDrawBorder;
    property OnDrawTab: TDrawTabEvent read FDrawTab write FDrawTab;
    property OnDrawPage: TDrawEvent read FDrawPage write SetDrawPage;
  end;

  { TPage }

  TExPage = class(TExCustomPage)
  published
    property Caption;
    property ChildSizing;
    property ClientWidth;
    property ClientHeight;
    property ImageIndex;
    property Left stored False;
    property Top stored False;
    property Width stored False;
    property Height stored False;
    property OnContextPopup;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property PageIndex stored False;
    property ParentShowHint;
    property PopupMenu;
    property TabOrder stored False;
    property Visible stored False;
  end;

  { TTabSheet }

  TExPageControl = class;

  { TTabSheet }

  TExTabSheet = class(TExCustomPage)
  private
    function GetPageControl: TExPageControl;
    function GetTabIndex: Integer;
    procedure SetPageControl(APageControl: TExPageControl);
    procedure SetTabIndex(const AValue: Integer);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property PageControl: TExPageControl read GetPageControl write
SetPageControl;
    property TabIndex: Integer read GetTabIndex write SetTabIndex;
  published
    property Caption;
    property ChildSizing;
    property ClientHeight;
    property ClientWidth;
    property Enabled;
    property Height stored False;
    property ImageIndex default 0;
    property Left stored False;
    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 PageIndex stored False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabVisible default True;
    property Top stored False;
    property Visible stored False;
    property Width stored False;
  end;


  { TPageControl }

  TExPageControl = class(TExCustomNotebook)
  private
    function GetActivePageIndex: Integer;
    function GetActiveTabSheet: TExTabSheet;
    function GetTabIndex: Integer;
    function GetTabSheet(Index: Integer): TExTabSheet;
    procedure SetActivePageIndex(const AValue: Integer);
    procedure SetActiveTabSheet(const AValue: TExTabSheet);
    procedure SetTabIndex(const AValue: Integer);
  public
    constructor Create(TheOwner: TComponent); override;
    function FindNextPage(CurPage: TExTabSheet;
                          GoForward, CheckTabVisible: Boolean):
TExTabSheet;
    procedure SelectNextPage(GoForward: Boolean);
    procedure SelectNextPage(GoForward: Boolean; CheckTabVisible:
Boolean);
    property ActivePageIndex: Integer read GetActivePageIndex
                                      write SetActivePageIndex;
    property Pages[Index: Integer]: TExTabSheet read GetTabSheet;
  published
    property ActivePage: TExTabSheet read GetActiveTabSheet write
SetActiveTabSheet;
    property Align;
    property Anchors;
    property BorderSpacing;
    //property BiDiMode;
    property Constraints;
    //property DockSite;
    property DragCursor;
    //property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    //property HotTrack;
    property Images;
    //property MultiLine;
    //property OwnerDraw;
    //property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    //property RaggedRight;
    //property ScrollOpposite;
    property ShowHint;
    //property Style;
    //property TabHeight;
    property TabIndex: Integer read GetTabIndex write SetTabIndex
default -1;
    property TabOrder;
    property TabPosition;
    property TabStop;
    //property TabWidth;
    property Visible;
    property OnChange: TNotifyEvent read fOnPageChanged write
fOnPageChanged;
    property OnChanging;
    property OnContextPopup;
    //property OnDockDrop;
    //property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    //property OnDrawTab;
    //property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    //property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnPageChanged;
    property OnResize;
    //property OnStartDock;
    property OnStartDrag;
    //property OnUnDock;
  end;

procedure Register;

implementation

{
 *********************************************************************
********
 *                                                                   
      *
 *  This file is part of the Lazarus Component Library (LCL)         
      *
 *                                                                   
      *
 *  See the file COPYING.modifiedLGPL, included in this distribution,
      *
 *  for details about the copyright.                                 
      *
 *                                                                   
      *
 *  This program is distributed in the hope that it will be useful,  
      *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of   
      *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.             
      *
 *                                                                   
      *
 *********************************************************************
********
}

{---------------------------------------------------------------------
---------
  TExCustomPage WMPaint
  Params: a TLMPaint message
 ---------------------------------------------------------------------
---------}
procedure TExCustomPage.WMPaint(var Msg: TLMPaint);
var
 Notebook: TExCustomNoteBook;
 ACanvas:TCanvas;
 ahwnd:THandle;
begin
  if (Parent<>nil) and (Parent is TExCustomNoteBook) then begin
    NoteBook:=TExCustomNoteBook(Parent);
    if (NoteBook.PageIndex>=0) and
(NoteBook.Page[NoteBook.PageIndex]=Self) then
    begin
     if (FDraw <> nil) and not (csDesigning in ComponentState) then
     begin
      ACanvas:=TCanvas.Create;
      ahwnd:=self.Handle;
      ACanvas.Handle:=GetDeviceContext(ahwnd);
      FDraw(self,ACanvas);
      ACanvas.Free;
     end
     else inherited WMPaint(Msg);
    end;
  end else
    inherited WMPaint(Msg);
end;

{*********************************************************************
*********
                                TExCustomNotebook
 *********************************************************************
*********}
procedure TExCustomNotebook.WMPaint(var Msg: TLMPaint);
var
 ACanvas:TCanvas;
 ahwnd:THandle;
 i,r:integer;
 arect:TRect;
begin
 if (FOwnerDraw) and not (csDesigning in ComponentState) then
 begin
  for i:=0 to PageCount-1 do
   TExCustomPage(Page[i]).OnDraw:=FDrawPage;
 end else
 begin
  for i:=0 to PageCount-1 do
   TExCustomPage(Page[i]).OnDraw:=nil;
 end;
 if (FOwnerDraw) and not (csDesigning in ComponentState) then
 begin
  if (FDrawBorder=nil) or (FDrawTab=nil) then inherited WMPaint(Msg);
  ACanvas:=TCanvas.Create;
  ahwnd:=self.Handle;
  ACanvas.Handle:=GetDeviceContext(ahwnd);
  ACanvas.Font.Assign(Font);
  if (FDrawBorder<>nil) then FDrawBorder(self,ACanvas);
  for i:=TabIndexAtClientPos(Point(5,5)) to PageCount-1 do
  begin
   aRect:=ACanvas.ClipRect;
   for r:=TabIndexAtClientPos(Point(5,5)) to i-1 do
    aRect.Left:=aRect.Left+ACanvas.TextWidth(Page[r].Caption)+13;
   aRect.Bottom:=aRect.Top+ACanvas.TextHeight('Ag')+7;
   aRect.Right:=aRect.Left+ACanvas.TextWidth(Page[i].Caption)+13;
   if (FDrawTab<>nil) then FDrawTab(Page[i],aRect,ACanvas);
  end;
  ACanvas.Free;
 end
 else inherited WMPaint(Msg);
end;

procedure TExCustomNotebook.SetOwnerDraw(value:boolean);
var
 i:integer;
begin
 FOwnerDraw:=value;
 if value then
 begin
  for i:=0 to PageCount-1 do
   TExCustomPage(Page[i]).OnDraw:=FDrawPage;
 end else
 begin
  for i:=0 to PageCount-1 do
   TExCustomPage(Page[i]).OnDraw:=nil;
 end;
end;

procedure TExCustomNotebook.SetDrawPage(value:TDrawEvent);
var
 i:integer;
begin
 FDrawPage:=value;
 if FOwnerDraw then
 begin
  for i:=0 to PageCount-1 do
   TExCustomPage(Page[i]).OnDraw:=value;
 end else
 begin
  for i:=0 to PageCount-1 do
   TExCustomPage(Page[i]).OnDraw:=nil;
 end;
end;

procedure TExCustomNotebook.CNNotify(var Message: TLMNotify);
var
 OldPageIndex:integer;
begin
  with Message do
    Case NMHdr^.code of
      TCN_SELCHANGE:
        begin
          // set the page from the NMHDR^.idfrom
          if CanChangePageIndex then begin
            OldPageIndex:=PageIndex;
            PageIndex := NMHDR^.idfrom;
            if PageIndex>=PageCount then
              PageIndex:=-1;
            //debugln(['TCustomNotebook.CNNotify ',DbgSName(Self),' A
Old=',OldPageIndex,' fPageIndex=',fPageIndex,'
FLoadedPageIndex=',FLoadedPageIndex]);
            //if PageIndex>=0 then DebugLn(['TCustomNotebook.CNNotify
Page=',DbgSName(Page[PageIndex]),'
Visible=',Page[PageIndex].Visible]);
//            UpdateAllDesignerFlags;
            if ([csLoading,csDestroying]*ComponentState=[]) then begin
              if OldPageIndex<>PageIndex then begin
                if csDesigning in ComponentState then
                  OwnerFormDesignerModified(Self);
                //DebugLn(['TCustomNotebook.CNNotify
',DbgSName(Page[PageIndex]),' ',Page[PageIndex].Visible]);
                ResizeDelayedAutoSizeChildren;
                Change;
              end;
            end;
          end;
        end;
      TCN_SELCHANGING:
        begin
          if CanChangePageIndex then
            Result := 0
          else
            Result := 1;
          //debugln('TCustomNotebook.CNNotify TCN_SELCHANGING
Result=',dbgs(Result));
        end;
    else
      begin
        {$IFDEF NOTEBOOK_DEBUG}
        DebugLn(['[TCustomNotebook.CNNotify] unhandled NMHdr code:',
NMHdr^.code]);
        {$ENDIF}
      end;
    end;
 Repaint;
end;

procedure TExCustomNotebook.InsertPage(APage: TExCustomPage; Index:
Integer);
var
  NewZPosition: integer;
begin
  {$IFDEF NOTEBOOK_DEBUG}
  DebugLn(['TExCustomNotebook.InsertPage A ',dbgsName(Self),'
Index=',Index,' Name=',
    APage.Name,' Caption=',APage.Caption]);
  {$ENDIF}
  APage.DisableAlign;
  try
    if Index<PageList.Count then
      NewZPosition:=GetControlIndex(TExCustomPage(PageList[Index]))
    else
      NewZPosition:=-1;
    PageList.Insert(Index,APage);
    APage.Parent := Self;
    if NewZPosition>=0 then
      SetControlIndex(APage,NewZPosition);
    if PageIndex = -1 then
      PageIndex := Index;
    if FOwnerDraw then
     aPage.OnDraw:=FDrawPage
    else
     aPage.OnDraw:=nil;
    
//    UpdateDesignerFlags(Index);

    if HandleAllocated and (not (csLoading in ComponentState)) then
begin
//      AddRemovePageHandle(APage);
      if PageIndex = Index then
//        DoSendPageIndex;
    end;
  finally
    APage.EnableAlign;
  end;
  {$IFDEF NOTEBOOK_DEBUG}
  DebugLn(['TExCustomNotebook.InsertPage END ',dbgsName(Self),'
Index=',
    Index,' Name=',APage.Name,' Caption=',APage.Caption]);
  {$ENDIF}
end;

{*********************************************************************
*********
                                  TPageControl
 *********************************************************************
*********

  Author: Mattias Gaertner

 *********************************************************************
********
 *                                                                   
      *
 *  This file is part of the Lazarus Component Library (LCL)         
      *
 *                                                                   
      *
 *  See the file COPYING.modifiedLGPL, included in this distribution,
      *
 *  for details about the copyright.                                 
      *
 *                                                                   
      *
 *  This program is distributed in the hope that it will be useful,  
      *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of   
      *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.             
      *
 *                                                                   
      *
 *********************************************************************
********

}

{ TExPageControl }

function TExPageControl.GetActivePageIndex: Integer;
begin
  Result:=inherited PageIndex;
end;

function TExPageControl.GetActiveTabSheet: TExTabSheet;
begin
  Result:=TExTabSheet(inherited ActivePageComponent);
end;

function TExPageControl.GetTabIndex: Integer;
begin
  Result:=inherited PageIndex;
end;

function TExPageControl.GetTabSheet(Index: Integer): TExTabSheet;
begin
  Result:=TExTabSheet(inherited Page[Index]);
end;

procedure TExPageControl.SetActivePageIndex(const AValue: Integer);
begin
  inherited PageIndex:=AValue;
end;

procedure TExPageControl.SetActiveTabSheet(const AValue: TExTabSheet);
begin
  ActivePageComponent:=AValue;
end;

procedure TExPageControl.SetTabIndex(const AValue: Integer);
begin
  inherited PageIndex:=Avalue;
end;

constructor TExPageControl.Create(TheOwner: TComponent);
begin
  PageClass:=TExTabSheet;
  inherited Create(TheOwner);
end;

function TExPageControl.FindNextPage(CurPage: TExTabSheet; GoForward,
  CheckTabVisible: Boolean): TExTabSheet;
var
  I, StartIndex: Integer;
begin
  Result := nil;
  if PageCount = 0 then
    exit;
  StartIndex := IndexOf(CurPage);
  if StartIndex < 0 then
    if GoForward then
      StartIndex := PageCount - 1
    else
      StartIndex := 0;
  i := StartIndex;
  repeat
    if GoForward then
    begin
      Inc(i);
      if i = PageCount then
        i := 0;
    end else
    begin
      if i = 0 then
        i := PageCount;
      Dec(I);
    end;
    if not CheckTabVisible or Pages[i].TabVisible then
    begin
      Result := Pages[i];
      exit;
    end;
  until i = StartIndex;
end;

procedure TExPageControl.SelectNextPage(GoForward: Boolean);
begin
  SelectNextPage(GoForward,true);
end;

procedure TExPageControl.SelectNextPage(GoForward: Boolean;
  CheckTabVisible: Boolean);
var
  NextPage: TExTabSheet;
begin
  NextPage:=FindNextPage(ActivePage,GoForward,CheckTabVisible);
  if NextPage<>nil then ActivePage:=NextPage;
end;

{*********************************************************************
*********
                                  TTabSheet
 *********************************************************************
*********

  Author: Mattias Gaertner

 *********************************************************************
********
 *                                                                   
      *
 *  This file is part of the Lazarus Component Library (LCL)         
      *
 *                                                                   
      *
 *  See the file COPYING.modifiedLGPL, included in this distribution,
      *
 *  for details about the copyright.                                 
      *
 *                                                                   
      *
 *  This program is distributed in the hope that it will be useful,  
      *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of   
      *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.             
      *
 *                                                                   
      *
 *********************************************************************
********
}

{ TExTabSheet }

function TExTabSheet.GetTabIndex: Integer;
begin
  Result:=PageIndex;
end;

function TExTabSheet.GetPageControl: TExPageControl;
begin
  if (Parent is TExPageControl) then
    Result:=TExPageControl(Parent)
  else
    Result:=nil;
end;

procedure TExTabSheet.SetPageControl(APageControl: TExPageControl);
begin
  if PageControl=APageControl then exit;
  Parent:=APageControl;
end;

procedure TExTabSheet.SetTabIndex(const AValue: Integer);
begin
  PageIndex:=AValue;
end;

constructor TExTabSheet.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  ImageIndex:=0;
end;

destructor TExTabSheet.Destroy;
begin
  inherited Destroy;
end;

procedure Register;
begin
  RegisterClasses([TExPageControl,TExTabSheet,TExPage,TExCustomPage,TE
xCustomNotebook]);
  RegisterComponents('Additional',[TExPageControl]);
end;

end.