Solved

Creating TMyPageControl component

Posted on 2000-05-09
6
228 Views
Last Modified: 2010-04-04
What I want to do is creating a Custom component descendant from TPageControl like:
TMyPageControl = class(TPageControl)

but what I realy need is inserting new property items on TTabSheet control like:

TMyTabSheet = class(TTabSheet)
property Item1;
property Item2;
property Item3;

and this TMyTabSheet to be linked with TMyPageControl.
So how can I link this to controls and to function on the same way as TPageControl?

Thank you
0
Comment
Question by:isaka
  • 3
  • 2
6 Comments
 
LVL 6

Expert Comment

by:edey
ID: 2793290
you just declare your new tabsheet (TMyTabSheet), create an instance of it & set it's pageControl property to your pageControl.

Gl
Mike
0
 
LVL 6

Expert Comment

by:edey
ID: 2793313
here I have an example clipped from a text editor I have written:

  TMySheet = class(TTabSheet)
  private
     fFileName : string;
     procedure setFileName(value : string);
  public
     text : TRichEdit;
     property fileName : string read fFileName write setFileName;
     constructor create(AOwner : TComponent);override;
  end;

constructor TMySheet.create(AOwner : TComponent);
begin
     inherited;
     text := TRichEdit.create(self);
     text.parent := self;
     text.align := alClient;
     text.modified := false;
     text.ScrollBars := ssBoth;
     text.PlainText := form1.CheckBox1.Checked;
     form1.toolbutton3.down := form1.checkbox1.checked;
     text.WordWrap := form1.checkbox5.checked;
     form1.toolButton2.Down := form1.checkbox5.checked;
     text.WantTabs := true;
     text.WantReturns := true;
     fFileName := '';
end;

procedure TForm1.New1Click(Sender: TObject);
var
   t : TMySheet;
begin
     t := TMySheet.create(noteBook);
     with t do
     begin
          parent := notebook;
          pageControl := noteBook;
     end;
     notebook.ActivePage := t;
     noteBookChange(self);
end;



GL
Mike
0
 

Author Comment

by:isaka
ID: 2793560
Thank you Mike on you answer,

But in this way I can't make a component which work at design time.

isak
0
ScreenConnect 6.0 Free Trial

Check out the updates in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI that improves session organization and overall user experience. See the enhancements for yourself!

 

Author Comment

by:isaka
ID: 2793835
Adjusted points from 50 to 100
0
 
LVL 2

Accepted Solution

by:
mullet_attack earned 100 total points
ID: 2794040
isaka,
A subclassed PageControl has been something I've wanted often also, so your question made me act. It seems to work, although not fully tested yet. I would appreciate your feedback.

for the example I added a property called 'framed' to MyTabSheet. I couldn't think of anything useful to do :-)

The overridden property editors allow design time adding of MyTabSheets.

-------------------------------------
unit MyPage;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, DsgnIntf, menus, editintf;

type
  TMyPageControl = class;  // forward declaration
  TMyPageEditor = class(TComponentEditor)
  function GetVerbCount:integer;override;
  function GetVerb(index:integer):string;override;
  procedure ExecuteVerb(index:integer);override;
 end;

  TMyTabEditor = class(TComponentEditor)
  function GetVerbCount:integer;override;
  function GetVerb(index:integer):string;override;
  procedure ExecuteVerb(index:integer);override;
 end;

  TMyTabSheet = class(TTabSheet)
  private
    FFramed: boolean;
    function GetMyPageControl: TMyPageControl;
    procedure SetMyPageControl(const Value: TMyPageControl);
    procedure SetFramed(const Value: boolean);
  protected
    property PageControl: TMyPageControl read GetMyPageControl write SetMyPageControl;
  public
    constructor Create(AOwner : TComponent);override;
  published
    property Framed : boolean read FFramed write SetFramed default false;
  end;

  TMyPageControl = class(TPageControl)
  private
    function GetPage(Index: Integer): TMyTabSheet;
    procedure SetActivePage(const Value: TMyTabSheet);
    function GetActivePage :  TMyTabSheet;
  protected
    { Protected declarations }
  public
    property Pages[Index: Integer]: TMyTabSheet read GetPage;
  published
    property ActivePage: TMyTabSheet read GetActivePage write SetActivePage;
end;

procedure Register;
function FindUniqueName(Component : TComponent ; const NewName: string): string;

implementation

procedure Register;
begin
  RegisterNoIcon([TMyTabSheet]);
  RegisterClass(TMyTabSheet);
  RegisterComponents('Planetech', [TMyPageControl]);
  RegisterComponentEditor(TMyPageControl,TMyPageEditor);
  RegisterComponentEditor(TMyTabSheet,TMyTabEditor);
end;

{ TMyPageControl }

function TMyPageControl.GetActivePage: TMyTabSheet;
begin
  result := TMyTabSheet(inherited ActivePage);
end;

function TMyPageControl.GetPage(Index: Integer): TMyTabSheet;
begin
  result := TMyTabSheet(inherited Pages[Index]);
end;

procedure TMyPageControl.SetActivePage(const Value: TMyTabSheet);
begin
  inherited ActivePage := (TMyTabSheet(Value));
end;

{ TMyTabSheet }

constructor TMyTabSheet.Create(AOwner: TComponent);
begin
  inherited;
  fframed := false;
end;

function TMyTabSheet.GetMyPageControl: TMyPageControl;
begin
  result := TMyPageControl(inherited PageControl);
end;

procedure TMyTabSheet.SetFramed(const Value: boolean);
begin
  FFramed := Value;
  if fFramed then
    ControlStyle := ControlStyle + [csFramed]
  else
    ControlStyle := ControlStyle - [csFramed];
  RecreateWnd;
end;

procedure TMyTabSheet.SetMyPageControl(const Value: TMyPageControl);
begin
  inherited PageControl := TPageControl(value);
end;

{ TMyPageEditor }

procedure TMyPageEditor.ExecuteVerb(index: integer);
var
 tempMyTabSheet : TMyTabSheet;
begin
  inherited;
  case index of
    0:
      begin
        tempMyTabSheet := TMyTabSheet.create(TMyPageControl(Component).Owner);
        tempMyTabSheet.PageControl := TMyPageControl(Component);
        tempMyTabSheet.name := FindUniqueName(component,'MyTabSheet');
        designer.modified;
      end;
    1: with component as TMyPageControl do
        if ActivePageIndex = PageCount -1 then
          ActivePage := Pages[0]
        else
          ActivePage := Pages[ActivePageIndex + 1];
    2: with component as TMyPageControl do
        if ActivePageIndex = 0 then
          ActivePage := Pages[PageCount -1]
        else
          ActivePage := Pages[ActivePageIndex - 1];
    3:
      begin
        TMyTabSheet(TMyPageControl(Component).ActivePage).free;
        designer.modified;
      end;
  end;
end;

function TMyPageEditor.GetVerb(index: integer): string;
begin
 case index of
  0:Result := 'New Page';
  1:Result := 'Next Page';
  2:Result := 'Previous Page';
  3:Result := 'Delete Page';
 end;
end;

function TMyPageEditor.GetVerbCount: integer;
begin
  result := 4;
end;

{ TMyTabEditor }

procedure TMyTabEditor.ExecuteVerb(index: integer);
var
 tempMyTabSheet : TMyTabSheet;
begin
  inherited;
  case index of
    0:
      begin
        tempMyTabSheet := TMyTabSheet.create(TMyTabSheet(Component).Owner);
        tempMyTabSheet.PageControl := TMyPageControl(TMyTabSheet(Component).PageControl);
        tempMyTabSheet.name := FindUniqueName(component, 'MyTabSheet');
        designer.modified;
      end;
    1: with TMyTabSheet(component).PageControl as TMyPageControl do
        if ActivePageIndex = PageCount -1 then
          ActivePage := Pages[0]
        else
          ActivePage := Pages[ActivePageIndex + 1];
    2: with TMyTabSheet(component).PageControl as TMyPageControl do
        if ActivePageIndex = 0 then
          ActivePage := Pages[PageCount -1]
        else
          ActivePage := Pages[ActivePageIndex - 1];
    3:
      begin
        TMyTabSheet(component).free;
        designer.modified;
      end;
  end;
end;

function TMyTabEditor.GetVerb(index: integer): string;
begin
 case index of
  0:Result := 'New Page';
  1:Result := 'Next Page';
  2:Result := 'Previous Page';
  3:Result := 'Delete Page';
 end;
end;

function TMyTabEditor.GetVerbCount: integer;
begin
  result := 4;
end;

function FindUniqueName(Component : TComponent ; const NewName: string): string;
var
    t : Integer;
    n : integer;
begin
  n := 0;
  Result := Format('%s%d', [NewName, n]);
  with (Component.owner) as TForm do
    begin
      While FindComponent(result) <> nil do
        begin
          inc(n);
          Result := Format('%s%d', [NewName, n]);
        end;
    end;
end;

end.

0
 

Author Comment

by:isaka
ID: 2804281
It works perfect.
Thank you for your brilliant answer.
0

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Strange behavior when a form is closed 6 58
Reconfigure Delphi Install? 2 51
How to debug For loops? 3 49
Firemonkey allowing RTL on android 6 33
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question