I'm writing simple component. What I want to achieve is that my MethodOptions will change in Object Inspector according to Method I choose.
Something like this:
So far I coded:
TmyMethod = (cmFirst, cmSecond);
TmyMethodOptions = class(TPersistent)
published
property SomethingInBase: boolean;
end;
TmyMethodOptionsFirst = class(TmyMethodOptions)
published
property SomethingInFirst: boolean;
end;
TmyMethodOptionsSecond = class(TmyTMethodOptions)
published
property SomethingInSecond: boolean;
end;
TmyComponent = class(TComponent)
private
fMethod: TmyMethod;
fMethodOptions: TmyMethodOptions;
procedure ChangeMethod(const Value: TmyMethod);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Method: TmyMethod read fMethod write ChangeMethod default cmFirst;
property MethodOptions: TmyMethodOptions read fMethodOptions
write fMethodOptions;
end;
implementation
procedure TmyComponent.ChangeMethod(const Value: TmyMethod);
begin
fMethod := Value;
fMethodOptions.Free;
// case...
if Value = cmFirst then
fMethodOptions := TmyMethodOptionsFirst.Create
else
fMethodOptions := TmyMethodOptionsSecond.Create;
// fMethodOptions.Update;
end;
constructor TmyComponent.Create(AOwner: TComponent);
begin
inherited;
fMethodOptions := TmyMethodOptions.Create;
fMethod := cmFirst;
end;
destructor TmyComponent.Destroy;
begin
fMethodOptions.Free;
inherited;
end;
Of course it does almost nothing (except hanging IDE) and I don't have any starting point where to search the suitable knowledge to achieve this.
If I understand correctly I believe that this the same technique the Developer Express implemented in their Quantum Grid component, for dynamically showing different properties for various field types in the grid. There is an explanation of the mechanism here: Technology of the QuantumGrid
Related
I'm developing a component for Query. It works like the "Properties" feature of DevExpress, but I need to place the order of the Unpublished Property I wrote to DFM with DefineProperties in the DFM file at the top of the TCollectionItem.
It works the same way in DevExpress. If you add a Field to the cxGrid and assign a value to the Properties property, you will see the value "PropertiesClassName" in the DFM file at the top.
When I open the DFM file and bring this Property to the top, the setter property of the "PropertiesClassName" Property works and I create that Class. It works seamlessly when reading data from the DFM stream. But no matter what I did I couldn't get the "PropertiesClassName" Property value to the top.
If you create a cxGrid on the form and add Field, and then take the "PropertiesClassName" property from DFM to the bottom of the DFM file, when you open the form again, you will see that it cannot find the relevant Class and an error occurs.
To change the DFM flow, I first assigned a value to the "PropertiesClassName" Property and then created the Class, but the problem was not solved. I did the opposite of this but the problem is still the same.
DFM Context
object QuerySearchEngine1: TQuerySearchEngine
SearchFields = <
item
FieldName = 'TestField'
Properties.Convert2String = True
PropertiesClassName = 'TSearchBooleanProperties'
end>
DFM Context should be like
object QuerySearchEngine1: TQuerySearchEngine
SearchFields = <
item
PropertiesClassName = 'TSearchBooleanProperties'
FieldName = 'TestField'
Properties.Convert2String = True
end>
Classes
TSearchField = class(TCollectionItem)
private
FFieldName: string;
FProperties: TSearchFieldProperties;
FPropertiesClassName: string;
private
procedure SetFieldName(const Value: string);
procedure SetProperties(const Value: TSearchFieldProperties);
private
procedure ReaderProc(Reader: TReader);
procedure WriterProc(Writer: TWriter);
procedure SetPropertiesClassName(const Value: string);
protected
constructor Create(Collection: TCollection); override;
procedure DefineProperties(Filer: TFiler); override;
public
property PropertiesClassName: string read FPropertiesClassName write SetPropertiesClassName;
published
property FieldName: string read FFieldName write SetFieldName;
property Properties: TSearchFieldProperties read FProperties write SetProperties;
end;
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
end;
procedure TSearchField.SetPropertiesClassName(const Value: string);
begin
var Item: TSearchFieldPropertiesItem;
if TryValidateSearchFieldPropertiesClassName(Value, Item) then
begin
if not Assigned(FProperties) or not (FProperties.ClassType = Item.ClassType) then
begin
if Assigned(FProperties) then
begin
FProperties.Free;
FProperties := nil;
end;
FPropertiesClassName := Item.ClassType.ClassName;
FProperties := Item.ClassType.Create;
end;
end
else
begin
FPropertiesClassName := '';
if Assigned(FProperties) then
begin
FProperties.Free;
FProperties := nil;
end;
end;
end;
Property Editor
type
TSearchFieldPropertiesProperty = class(TClassProperty)
private
function GetInstance: TPersistent;
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
end;
function TSearchFieldPropertiesProperty.GetValue: string;
begin
for var I := 0 to Self.PropCount - 1 do
begin
var Inst := Self.GetComponent(I);
if Assigned(Inst) and Self.HasInstance(Inst) then
begin
if Inst is TSearchField then
begin
var PropInst := GetObjectProp(Inst, Self.GetPropInfo);
if Assigned(PropInst) then
begin
for var Item in SearchFieldPropertiesList do
begin
if PropInst.ClassType = Item.ClassType then
begin
Result := Item.Name;
Exit;
end;
end;
end;
end;
end;
end;
end;
procedure TSearchFieldPropertiesProperty.SetValue(const Value: string);
begin
var Item: TSearchFieldPropertiesItem;
if TryValidateSearchFieldPropertiesName(Value, Item) then
begin
var Inst := GetInstance;
if Assigned(Inst) then
begin
var Context := TRttiContext.Create;
var Rtype := Context.GetType(Inst.ClassType);
for var Prop in Rtype.GetProperties do
begin
if SameText(Prop.Name, 'PropertiesClassName') then
begin
Prop.SetValue(Inst, TValue.From<string>(Item.ClassType.ClassName));
Break;
end;
end;
end;
end;
end;
Pic for Design Time
The only problem is changing the order of the Property in that DFM flow.
Original answer at the bottom, here is a new suggestion:
We actually have something very similar in the JVCL where TJvHotTrackPersistent publishes a HotTrackOptions property.
This property is backed by an instance of TJvHotTrackOptions that gets derived in other classes that need specialized versions of it.
To tell the streaming subsystem to use the actual class found at streaming time, the constructor of that options class calls SetSubComponent(True); which places csSubComponent in the ComponentStyle property.
So what you should do is get rid of your DefineProperties, have TSearchFieldProperties inherit from TComponent and call SetSubComponent(True) in its constructor.
Then you create as many classes derived from TSearchFieldProperties as you need, each with its own set of published properties.
This means you should also get rid of the methods you showed in your submission.
In the end, you should have something along those lines:
type
TSearchFieldProperties = class(TComponent)
public
constructor Create(AOwner: TComponent); override;
end;
TIntegerSearchFieldProperties = class(TSearchFieldProperties)
private
FIntValue: Integer;
published
property IntValue: Integer read FIntValue write FIntValue;
end;
constructor TSearchFieldProperties.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetSubComponent(True);
end;
With this you do not fight against the streaming system but rather work with it in the way it is meant to be used.
But if you stop there, you'll notice there is no way for you to specify the actual class name to be used for the TSearchFieldProperties instance used for the TSearchField.Properties property.
The only way to get the class name to be streamed before the subcomponent is streamed is to actually declare the class name as a published property, declared before the subcomponent like this:
type
TSearchField = class(TCollectionItem)
published
// DO NOT change the order of those two properties, PropertiesClassName must come BEFORE Properties for DFM streaming to work properly
property PropertiesClassName: string read GetPropertiesClassName write SetPropertiesClassName;
property Properties: TSearchFieldProperties read FProperties write SetProperties;
end;
function TSearchField.GetPropertiesClassName: string;
begin
Result := Properties.ClassName;
end;
procedure TSearchField.SetPropertiesClassName(const AValue: string);
begin
FProperties.Free; // no need to test for nil, Free already does it
FProperties := TSearchFieldPropertiesClass(FindClass(AValue)).Create(self);
end;
It might work if you just declare the published property like without creating a csSubComponent hierarchy but you'll most likely stumble on other hurdles along the way.
Note: this answer is wrong because DefineProperties is called last in TWriter.WriteProperties and so there is no way to change the order properties defined like this are written.
What if you change your DefineProperties override from this:
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
end;
to this:
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
inherited DefineProperties(Filer);
end;
Basically, call the inherited method AFTER you have defined your own property.
Note that I also specified which inherited method is called. I know it's not required, but it makes intent clearer and allows for Ctrl-Click navigation.
I have a class that contains a TObjectList<T> list of objects of another class.
TMyElementClass = class (TPersistent)
private
....
public
....
end;
TMyElemContainerClass = class (TPersistent)
private
fElemList: TObjectList<TMyElementClass>;
...
published
ElemList: TObjectList<TMyElementClass> read fElemList write fElemList;
end;
var
Elements: TMyElemContainerClass;
I register both classes:
System.Classes.RegisterClass (TMyElemContainerClass);
System.Classes.RegisterClass (TMyElementClass);
The problem is, when the Elements object is "saved" to a stream, all of the published fields are correctly saved, but the list itself isn't.
What's wrong?
TObjectList is not a streamable class. Just because you use it in a published property doesn't mean the streaming system automatically knows how to stream it. If you are using the DFM streaming system, only classes that derive from TPersistent are streamable, but TObjectList does not. You will have to implement custom streaming logic for it.
Consider changing your design to use TCollection and TCollectionItem instead, eg:
TMyElementClass = class (TCollectionItem)
private
...
public
...
published
...
end;
TMyElemCollectionClass = class (TCollection)
private
function GetElem(Index: Integer): TMyElementClass;
procedure SetElem(Index: Integer; Value: TMyElementClass);
public
constructor Create; reintroduce;
function Add: TMyElementClass; reintroduce;
function Insert(Index: Integer): TMyElementClass; reintroduce;
property Elements[Index: Integer]: TMyElementClass read GetElem write SetElem; default;
end;
TMyElemContainerClass = class (TPersistent)
private
fElemList: TMyElemCollectionClass;
procedure SetElemList(Value: TMyElemCollectionClass);
...
public
constructor Create;
destructor Destroy; override;
...
published
ElemList: TMyElemCollectionClass read fElemList write SetElemList;
end;
...
constructor TMyElemCollectionClass.Create;
begin
inherited Create(TMyElementClass);
end;
function TMyElemCollectionClass.GetElem(Index: Integer): TMyElementClass;
begin
Result := TMyElementClass(inherited GetItem(Index));
end;
procedure TMyElemCollectionClass.SetElem(Index: Integer; Value: TMyElementClass);
begin
inherited SetItem(Index, Value);
end;
function TMyElemCollectionClass.Add: TMyElementClass;
begin
Result := TMyElementClass(inherited Add);
end;
function TMyElemCollectionClass.Insert(Index: Integer): TMyElementClass;
begin
Result := TMyElementClass(inherited Insert(Index));
end;
constructor TMyElemContainerClass.Create;
begin
inherited;
fElemList := TMyElemCollectionClass.Create;
end;
destructor TMyElemContainerClass.Destroy;
begin
fElemList.Destroy;
inherited;
end;
procedure TMyElemContainerClass.SetElemList(Value: TMyElemCollectionClass);
begin
fElemList.Assign(Value);
end;
Remy gave you one avenue to try.
Another possible way would be implement this list streaming manually.
You would have to
derive your TMyElemContainerClass from TComponent
remove ElemList from published properties
override DefineProperties method that would declare some virtual, not-existing published property to be streamed in and out. You may even name it ElemList or by any other identifier you would see fit. It would be used by Delphi instead your TObjectList object.
implement stream-oriented reader and writer methods for the said virtual property, they should iterate through all the items and save/load them.
Explore documentation from here: http://docwiki.embarcadero.com/Libraries/Berlin/en/System.Classes.TComponent.DefineProperties
See one of many (and there really are many) examples (using arrays rather than lists, but the idea is the same) at How to use DefineProperties in a custom Class Object for Arrays - Delphi
I have done a very simply subclass of the TSwitch that will not respond to mouse clicks or even allow setting IsChecked at runtime. I have not created this as a component so its only runtime constructed. It works if I create a TSwitch at runtime but will not work if its my subclassed switch.
TLayoutSwitch = class(TCustomSwitch, ILayoutBaseControl)
The issue appears to be in SendMessage called by TSwitchModel.SetValue. In TMessageSender.SendMessage. I cannot figure out how TSwitchModel is constructed so that the Receiver object is set.
RAD Studio 10 Seattle
TLayoutSwitch = class(TCustomSwitch, ILayoutBaseControl)
private
FGroupID: integer;
procedure SetGroupID(const Value: integer);
function GetIBHeight: Single;
function GetIBWidth: Single;
procedure SetIBHeight(const Value: Single);
procedure SetIBWidth(const Value: Single);
procedure DoSwitchEvent(Sender: TObject);
public
LayoutControlType: TLayoutControlType;
property LFIBGroup_ID: integer read FGroupID write SetGroupID;
property LFIBWidth: Single read GetIBWidth write SetIBWidth;
property LFIBHeight: Single read GetIBHeight write SetIBHeight;
procedure WriteToStream(ms: TStream);
procedure ReadFromStream(ms: TStream; NewWidth: Single = 1; NewHeight: Single = 1);
constructor Create(AOwner: TComponent); override;
end;
Instantiate code
ctrl := TLayoutSwitch.Create(Background);
ctrl.Parent := Background;
ctrl.BringToFront;
(ctrl as ILayoutBaseControl).ReadFromStream(ms, Background.Width/tmpW, Background.Height/tmpH);
Your class name TLayoutSwitch "misguides" FMX to search for a presenter named LayoutSwitch-style which of course doesn't exist in the framework. However, it is possible to change that name to the ordinary Switch-style in the OnPresentationNameChoosing event which is fired directly after the standard name construction.
Declare a TPresenterNameChoosingEvent procedure in your class, for example:
procedure ChoosePresentationName(Sender: TObject; var PresenterName: string);
and assign this to the event in the constructor
constructor TLayoutSwitch.Create(Owner: TComponent);
begin
inherited;
OnPresentationNameChoosing := ChoosePresentationName;
...
end;
Implementation could be as simple as
procedure TLayoutSwitch.ChoosePresentationName(Sender: TObject; var PresenterName: string);
begin
PresenterName := 'Switch-style';
end;
The Switch-style presenter/presentation is the one used by TSwitch. Therefore it now looks and behaves the same.
I have a Delphi XE+ application with 3 forms, 2 of them created dynamically, like so:
form_main is triggering form_equip
form_equip is triggering form_certif
form_main -> form_equip -> form_certif
1'st: Open form_equip
procedure Tform_main.button_equip_addClick(Sender: TObject);
var
form_equip: Tform_equip;
begin
form_equip:= Tform_equip.Create(Self);
form_equip.equip_id:= 0;
form_equip.ShowModal;
FreeAndNil(form_equip);
end;
On form_equip I have a public procedure has_changes
2'nd: Open form_certif
procedure Tform_equip.button_certif_addClick(Sender: TObject);
var
form_certif: Tform_certif;
begin
form_certif:= Tform_certif.Create(Self);
form_certif.index:= 0;
form_certif.ShowModal;
FreeAndNil(form_certif);
end;
Now, when I press OK button from form_certif
procedure Tform_certif.button_okClick(Sender: TObject);
begin
//do something...
form_equip.has_changes; //this public procedure from form_equip is not visible because form was created as local var on form_main
end;
The question is, how can I transmit the sender/parent name to form_certif so can I see the public procedures and variables from form_equip?
A simple way is to declare inside unit_equip as global:
var
form_equip: Tform_equip
but I avoid to do this because form_equip is made to be opened dynamically in multiple windows with different names...
Pass all needed information from form_equip to form_certif. That way form_certif is decoupled from any dependence of form_equip.
procedure Tform_equip.button_certif_addClick(Sender: TObject);
var
form_certif: Tform_certif;
begin
form_certif:= Tform_certif.Create(nil);
try
form_certif.index:= 0;
// Pass all other needed variable values to form_certif
// including callback methods
form_certif.Has_Changes_Method := Self.Has_Changes();
if form_certif.ShowModal = mrOk then
begin
// take care of changes
end;
finally
FreeAndNil(form_certif);
end;
end;
And this is how it would look in the form_certif unit:
type
THas_Changes_Method = procedure of Object;
TForm_Certif = class(TForm)
...
private
FIndex: Integer;
FHasChanges: THas_Changes_Method;
public
property Index: Integer read FIndex write FIndex;
property Has_Changes_Method: THas_Changes_Method read fHasChanges write fHasChanges;
end;
Pass the information as a parameter in the constructor. Declare the constructor like this:
constructor Create(AOwner: TComponent; const ParentName: string);
In the implementation of the constructor, make a note of the name that was passed.
Since you are creating forms in code, you can add custom constructor to the form and pass other form as parameter.
Tform_certif = class(TForm)
...
protected
form_equip: Tform_equip;
public
constructor Create(AOwner: TComponent; Aform_equip: Tform_equip); reintroduce;
end;
constructor Tform_certif.Create(AOwner: TComponent; Aform_equip: Tform_equip);
begin
inherited Create(AOwner);
form_equip := Aform_equip;
end;
So now you can call form_equip.has_changes, because it is a field that you have initialized during construction of your Tform_certif form and it points to particular instance of Tform_equip that created this particular instance of Tform_certif.
procedure Tform_certif.button_okClick(Sender: TObject);
begin
//do something...
// test whether form_equip is assigned to avoid AV by calling methods on nil object
if Assigned(form_equip) then form_equip.has_changes;
end;
And to create your Tform_certif you would use following code
procedure Tform_equip.button_certif_addClick(Sender: TObject);
var
form_certif: Tform_certif;
begin
form_certif:= Tform_certif.Create(Self, Self);
form_certif.index:= 0;
form_certif.ShowModal;
FreeAndNil(form_certif);
end;
There is also variation of above constructor code, where you only need to send one parameter and then test in constructor whether AOwner it is of Tform_equip type and you don't need to change code in button_certif_addClick for using that kind of solution.
Tform_certif = class(TForm)
...
protected
form_equip: Tform_equip;
public
constructor Create(AOwner: TComponent); override;
end;
constructor Tform_certif.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if AOwner is Tform_equip then form_equip := Tform_equip(AOwner);
end;
I've used frames in Delphi for years, and they are one of the most powerful features of the VCL, but standard use of them seems to have some risk such as:
It's easy to accidentally move or edit the frame sub-components on a frame's host form without realising that you are 'tweaking' with the frame - I know this does not affect the original frame code, but it's generally not what you would want.
When working with the frame you are still exposed to its sub-components for visual editing, even when that frame is years old and should not be touched.
So I got to thinking....
Is there a way of 'grouping' components such that their positions are 'locked'? This would be useful for finished forms as well as frames. Often other developers return code to me where only the form bounds have changed and even they did not intend any change.
Is there any way of turning a frame and its components into a single Delphi component? If so, the frame internals would be completely hidden and its useability would increase further.
I'm interested in any thoughts...
Brian.
Registering your frames as a component solves both 1. and 2.:
the components on the frame are locked when you put that frame control on a form or other frame
you will get a component (actually: control) that you can design visually
But: there are a few catches (which can be solved, see article link), of which the most important is this one:
When you put components on your frame, and later drop that frame as a component on a Delphi form or frame, the components are visible in the Structure Pane.
The problem is that because they are visible in the structure pane, you can delete them, causing access violations.
The trick to solve this to not forget the 'sprig'.
I learned that valuable lesson from Ray Konopka during DelphiLive 2009.
Since the lesson is so valuable, I wrote a blog post on it that describes it in detail.
The essential portion is this little piece of code (more details in the blog post):
procedure RegisterFramesAsComponents(const Page: string; const FrameClasses: array of TFrameClass);
var
FrameClass: TFrameClass;
begin
for FrameClass in FrameClasses do
begin
RegisterComponents(Page, [FrameClass]);
RegisterSprigType(FrameClass, TComponentSprig);
end;
end;
Hope this helps.
--jeroen
Yes, just register them as components. :-)
Design your frame normally and after this register it. Also be sure to not have unwanted dependencies on different units since these are linked when your 'component' is used. Also you can add published properties in order to use them in the Object Inspector later. See for example the following code generated by the IDE (see also my comments):
unit myUnit;
uses
...
type
TmyComp = class(TFrame) //set your frame name to be the name your component
ToolBar1: TToolBar; //different components added in the form designer
aliMain: TActionList;
...
published //this section is added by hand
property DataSource: TDataSource read FDataSource write SetDataSource; //some published properties added just for exemplification
property DefFields: string read FDefFields write SetDefFields;
...
end;
procedure Register; //added by hand
implementation
{$R *.DFM}
procedure Register;
begin
RegisterComponents('MyFrames', [TmyComp]); //register the frame in the desired component category
end;
Compile the above in a package of your choice, install it and check you component palette. :-)
HTH
I'm almost always creating frame instances in code. This is easy and worked well for me so far.
Just for increasing contribution, note that if you go to Structure window and right-click on the TFrame name that you chose, and click on the Add to Palete menu option.
This will make a component out of your Frame and you don't need to create any Register procedure. ;-)
I also ran into that problem when trying to use frames as components. There are various possibilities to fix the obvious issues, but they all undermine the principle of information hiding (all the frame's subcomponents are exposed as published properties, which means everyone can access them).
I solved it by implementing a generic "frame control" component:
unit RttiBrow.Cbde.FrameControl;
interface
uses
Classes, Controls, Forms, Messages, ExtCtrls;
type
TFrameClass = class of TFrame;
TComponentFrame = class (TFrame)
private
function GetClientHeight: Integer;
function GetClientWidth: Integer;
procedure SetClientHeight(const Value: Integer);
procedure SetClientWidth(const Value: Integer);
function GetOldCreateOrder: Boolean;
procedure SetOldCreateOrder(const Value: Boolean);
function GetPixelsPerInch: Integer;
procedure SetPixelsPerInch(const Value: Integer);
function GetTextHeight: Integer;
procedure SetTextHeight(const Value: Integer);
published
{ workarounds for IDE bug }
property ClientWidth: Integer read GetClientWidth write SetClientWidth stored False;
property ClientHeight: Integer read GetClientHeight write SetClientHeight stored False;
property OldCreateOrder: Boolean read GetOldCreateOrder write SetOldCreateOrder stored False;
property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch stored False;
property TextHeight: Integer read GetTextHeight write SetTextHeight stored False;
end;
TComponentFrame<TFrameControl: class { TControl }> = class (TComponentFrame)
private
function GetController: TFrameControl; inline;
protected
property Controller: TFrameControl read GetController;
public
constructor Create (AOwner: TComponent); override;
end;
TFrameControl<T: TFrame> = class (TWinControl)
private
FFrame: T;
function PlainFrame: TFrame;
protected
procedure CreateParams (var Params: TCreateParams); override;
property Frame: T read FFrame;
public
constructor Create (AOwner: TComponent); override;
property DockManager;
published
property Align;
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property UseDockManager default True;
property DockSite;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentBackground;
property ParentColor;
property ParentCtl3D;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property ShowHint;
property TabOrder;
property TabStop;
property Touch;
property Visible;
property OnAlignInsertBefore;
property OnAlignPosition;
property OnCanResize;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGesture;
property OnGetSiteInfo;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
implementation
uses
Windows;
{ TFrameControl<T> }
constructor TFrameControl<T>.Create(AOwner: TComponent);
begin
inherited;
FFrame := T (TFrameClass (T).Create (Self));
PlainFrame.Parent := Self;
PlainFrame.Align := alClient;
end;
procedure TFrameControl<T>.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_CLIPCHILDREN;
Params.ExStyle := Params.ExStyle or WS_EX_CONTROLPARENT;
end;
function TFrameControl<T>.PlainFrame: TFrame;
begin
Result := FFrame; // buggy compiler workaround
end;
{ TComponentFrame }
function TComponentFrame.GetOldCreateOrder: Boolean;
begin
Result := False;
end;
function TComponentFrame.GetPixelsPerInch: Integer;
begin
Result := 0;
end;
function TComponentFrame.GetTextHeight: Integer;
begin
Result := 0;
end;
procedure TComponentFrame.SetClientHeight(const Value: Integer);
begin
Height := Value;
end;
procedure TComponentFrame.SetClientWidth(const Value: Integer);
begin
Width := Value;
end;
procedure TComponentFrame.SetOldCreateOrder(const Value: Boolean);
begin
end;
procedure TComponentFrame.SetPixelsPerInch(const Value: Integer);
begin
end;
procedure TComponentFrame.SetTextHeight(const Value: Integer);
begin
end;
function TComponentFrame.GetClientHeight: Integer;
begin
Result := Height;
end;
function TComponentFrame.GetClientWidth: Integer;
begin
Result := Width;
end;
{ TComponentFrame<TFrameControl> }
constructor TComponentFrame<TFrameControl>.Create(AOwner: TComponent);
begin
inherited;
Assert (AOwner <> nil);
Assert (AOwner.InheritsFrom (TFrameControl));
end;
function TComponentFrame<TFrameControl>.GetController: TFrameControl;
begin
Result := TFrameControl (Owner);
end;
end.
With this class, adding a frame as a component becomes a two-stage process:
// frame unit
type
TFilteredList = class;
TFrmFilteredList = class (TComponentFrame<TFilteredList>)
// lots of published sub-components and event methods like this one:
procedure BtnFooClick(Sender: TObject);
end;
TFilteredList = class (TFrameControl<TFrmFilteredList>)
private
procedure Foo;
public
// the component's public interface
published
// the component's published properties
end;
procedure Register;
...
procedure Register;
begin
RegisterComponents ('CBDE Components', [TFilteredList]);
end;
procedure TFrmFilteredList.BtnFooClick(Sender: TObject);
begin
Controller.Foo;
end;
procedure TFilteredList.Foo;
begin
end;
...
When using this approach, the user of your component won't see your sub-components.