← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/lazarus/gutsy

« back to all changes in this revision

Viewing changes to examples/designerbaseclass/customcomponentclass.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-05-06 13:46:10 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20070506134610-lf4rbsb7p0mx31x1
Tags: 0.9.22-1
http://bugs.debian.org/421850
http://bugs.debian.org/408512
* Add homepage to debian/control.
* New upstream release. (Closes: #421850, #408512)
* Remove old patch and add new symlink /usr/bin/startlazarus.
* Add myself to Uploaders.
* Add XS-X-Vcs-Svn header to debian/control.

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/designerbaseclass/customcomponentclass.pas
 
1
{
 
2
 *****************************************************************************
 
3
 *                                                                           *
 
4
 *  This file is part of the Lazarus Component Library (LCL)                 *
 
5
 *                                                                           *
 
6
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 
7
 *  for details about the copyright.                                         *
 
8
 *                                                                           *
 
9
 *  This program is distributed in the hope that it will be useful,          *
 
10
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 
11
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 
12
 *                                                                           *
 
13
 *****************************************************************************
 
14
 
 
15
  Author: Mattias Gaertner
 
16
 
 
17
  Abtract:
 
18
   Registers a new designer base class (like TForm or TDataModule) in the IDE.
 
19
}
 
20
unit CustomComponentClass;
 
21
 
 
22
{$mode objfpc}{$H+}
 
23
 
 
24
interface
 
25
 
 
26
uses
 
27
  Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf;
 
28
  
 
29
type
 
30
 
 
31
  { TMyComponentClass }
 
32
 
 
33
  TMyComponentClass = class(TComponent)
 
34
  private
 
35
    FDemoProperty: integer;
 
36
  protected
 
37
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
 
38
  public
 
39
    constructor Create(TheOwner: TComponent); override;
 
40
  published
 
41
    property DemoProperty: integer read FDemoProperty write FDemoProperty;
 
42
  end;
 
43
  
 
44
procedure Register;
 
45
 
 
46
 
 
47
implementation
 
48
 
 
49
 
 
50
procedure Register;
 
51
begin
 
52
  FormEditingHook.RegisterDesignerBaseClass(TMyComponentClass);
 
53
end;
 
54
 
 
55
{ TMyComponentClass }
 
56
 
 
57
procedure TMyComponentClass.GetChildren(Proc: TGetChildProc; Root: TComponent);
 
58
// this method is called by TWriter to retrieve the child components to write
 
59
var
 
60
  I: Integer;
 
61
  OwnedComponent: TComponent;
 
62
begin
 
63
  DebugLn(['TMyComponentClass.GetChildren ComponentCount=',ComponentCount]);
 
64
  inherited GetChildren(Proc, Root);
 
65
  if Root = Self then begin
 
66
    for I := 0 to ComponentCount - 1 do
 
67
    begin
 
68
      OwnedComponent := Components[I];
 
69
      if not OwnedComponent.HasParent then Proc(OwnedComponent);
 
70
    end;
 
71
  end;
 
72
end;
 
73
 
 
74
constructor TMyComponentClass.Create(TheOwner: TComponent);
 
75
// init the component with an IDE resource
 
76
begin
 
77
  DebugLn(['TMyComponentClass.Create ',DbgSName(TheOwner)]);
 
78
  GlobalNameSpace.BeginWrite;
 
79
  try
 
80
    inherited Create(TheOwner);
 
81
    if (ClassType <> TMyComponentClass) and not (csDesigning in ComponentState)
 
82
    then begin
 
83
      if not InitResourceComponent(Self, TDataModule) then begin
 
84
        raise EResNotFound.Create('Resource missing for class '+ClassName);
 
85
      end;
 
86
    end;
 
87
  finally
 
88
    GlobalNameSpace.EndWrite;
 
89
  end;
 
90
end;
 
91
 
 
92
end.
 
93