In working with setting up TCPServer and FTPServer, the thing I noticed most is the need for a UserID field and a UserFlag field in IdContext. The simple addition of these would greatly facilitate setting up the components for multiple clients. You could create a descendant, but that takes a lot of unnecessary coding for something so easily added to the source code. I modified IdContext.pas as follows:
Protected
FUserFlag: Boolean;
FUserID: Integer;
...
Public
Property UserFlag: Boolean Read FUserFlag Write FUserFlag Default False;
Property UserID: Integer Read FUserID Write FUserID Default -1;
By using these I'm able to signal a state between events and I have the reference readily available whenever an event is fired. I tried to say something in the Indy project but I couldn't find anywhere to say it :/
Thank you for your suggestion, but I am not inclined to make these kind of additions to the base TIdContext class. They simply do not belong there. Deriving a custom class and assigning it to the server's ContextClass property is the correct and appropriate solution in this situation. This is why that property exists in the first place. It is really not that much coding, eg:
type
TMyContext = class(TIdServerContext)
protected
FUserFlag: Boolean;
FUserID: Integer;
...
public
Property UserFlag: Boolean Read FUserFlag Write FUserFlag;
Property UserID: Integer Read FUserID Write FUserID;
end;
procedure TMyForm.FormCreate(Sender: TObject);
begin
// must do this before activating the server...
IdTCPServer1.ContextClass := TMyContext;
end;
And then you can type-cast TIdContext object pointers to TMyContext when needed.
Various Indy servers do exactly this internally. For instance TIdFTPServer uses a TIdFTPServerContext class that has Account and Username properties for the logged in session.
That being said, if you do not want to derive a custom class, the base TIdContext class does already have a public Data property (or DataObject and DataValue properties in Delphi ARC-based compilers), which can be used for storing user-defined data, eg:
type
TMyData = class
protected
FUserFlag: Boolean;
FUserID: Integer;
...
public
Property UserFlag: Boolean Read FUserFlag Write FUserFlag;
Property UserID: Integer Read FUserID Write FUserID;
end;
procedure TMyForm.IdTCPServer1Connect(AContext: TIdContext);
begin
AContext.Data := TMyData.Create;
...
end;
And then you can simply type-cast AContext.Data to TMyData when needed.
Related
I'm coding a Rtti class, intended to simplify and generalize operations with Rtti:
tRTTI_Assistant = class (tObject)
private
fSourceObject : tObject;
...
property SourceObject : tObject read fSourceObject write fSourceObject;
...
end;
How can I declare a property that will receive a Record?
You cannot add a record class property that can take any record structure and use RTTI to resolve the inner details of the record.
For this to work you have to use another way. A TValue can be used with RTTI to resolve any type.
So declare:
tRTTI_Assistant = class (tObject)
private
//fSourceObject : tObject; // ! Use AnySource for objects as well
fAnySource : TValue;
...
//property SourceObject : tObject read fSourceObject write fSourceObject;
property AnySource: TValue read fAnySource write fAnySource;
...
end;
And call it:
myAssistant.AnySource := TValue.From(myRecord);
Now you can use RTTI for resolving not just record types, but any type.
See Convert Record to Serialized Form Data for sending via HTTP for examples how work with RTTI on a TValue:
I'm not shure what you exactly want to do. but i think Generics are what you are looking for.
type
TMyRecord = record
I:Integer;
S:string;
B:Boolean;
end;
TMyObject<T:record> = class
private
FMyRecord:T;
public
property MyRecord: T read FMyRecord write FMyRecord;
end;
Is it possible to add and implement an interface to an already existing class (which is a descendant of TInterfaced or TInterfacedPersistent) to accomplish separating Model and View into 2 units?
A small explanation why I need something like this:
I am developing a tree-structure, open-type model, which has following structure (VERY simplified and incomplete, just to illustrate the outline of the problem):
Database_Kernel.pas
TVMDNode = class(TInterfacedPersistent);
public
class function ClassGUID: TGUID; virtual; abstract; // constant. used for RTTI
property RawData: TBytes {...};
constructor Create(ARawData: TBytes);
function GetParent: TVMDNode;
function GetChildNodes: TList<TVMDNode>;
end;
Vendor_Specific_Stuff.pas
TImageNode = class(TVMDNode)
public
class function ClassGUID: TGUID; override; // constant. used for RTTI
// Will be interpreted out of the raw binary data of the inherited class
property Image: TImage {...};
end;
TUTF8Node = class(TVMDNode)
public
class function ClassGUID: TGUID; override; // constant. used for RTTI
// Will be interpreted out of the raw binary data of the inherited class
property StringContent: WideString {...};
end;
TContactNode = class(TVMDNode)
public
class function ClassGUID: TGUID; override; // constant. used for RTTI
// Will be interpreted out of the raw binary data of the inherited class
property PreName: WideString {...};
property FamilyName: WideString {...};
property Address: WideString {...};
property Birthday: TDate {...};
end;
Using a GUID-based RTTI (which uses ClassGUID), the function GetChildNodes is able to find the matching class and initialize it with the raw data. (Each dataset contains ClassGUID and RawData beside other data like created/updated timestamps)
It is important to notice that my API (Database_Kernel.pas) is strictly separated from the vendor's node classes (Vendor_Specific_Stuff.pas).
A vendor-specific program's GUI wants to visualize the nodes, e.g. giving them an user-friendly name, an icon etc.
Following idea works:
IGraphicNode = interface(IInterface)
function Visible: boolean;
function Icon: TIcon;
function UserFriendlyName: string;
end;
The vendor's specific descendants of TVMDNode in Vendor_Specific_Stuff.pas will implement the IGraphicNode interface.
But the vendor also needs to change Database_Kernel.pas to implement IGraphicNode to the base node class TVMDNode (which is used for "unknown" nodes, where RTTI was unable to find the matching class of the dataset, so at least the binary raw data can be read using TVMDNode.RawData).
So he will change my class as follows:
TVMDNode = class(TInterfacedPersistent, IGraphicNode);
public
property RawData: TBytes {...};
class function ClassGUID: TGUID; virtual; abstract; // constant. used for RTTI
constructor Create(ARawData: TBytes);
function GetParent: TVMDNode;
function GetChildNodes: TList<TVMDNode>;
// --- IGraphicNode
function Visible: boolean; virtual; // default behavior for unknown nodes: False
function Icon: TIcon; virtual; // default behavior for unknown nodes: "?" icon
function UserfriendlyName: string; virtual; // default behavior for unknown nodes: "Unknown"
end;
The problem is that IGraphicNode is vendor/program-specific and should not be in the API's Database_Kernel.pas, since GUI and Model/API should be strictly divided.
My wish would be that the interace IGraphicNode could be added and implemented to the existing TVMDNode class (which is already a descendant of TInterfacedPersistent to allow interfaces) in a separate unit. As far as I know, Delphi does not support something like this.
Beside the fact that it is not nice to mix Model and View in one single unit/class, there will be following real-world problem: If the vendor has to change my Database_Kernel.pas API to extend TVMDNode with the IGraphicNode interface, he needs to re-do all his changes, as soon as I release a new version of my API Database_Kernel.pas.
What should I do? I thought very long about possible solutions possible with Delphi's OOP. A workaround may be nesting TVMDNode's into a container class, which has a secondary RTTI, so after I have found the TVMDNode class, I could search for a TVMDNodeGUIContainer class. But this sounds very strangle and like a dirty hack.
PS: This API is an OpenSource/GPL project. I am trying to stay compatible with old generations of Delphi (e.g. 6), since I want to maximize the number of possible users. However, if a solution of the problem above is only possible with the new generation of Delphi languages, I might consider dropping Delphi 6 support for this API.
Yes it is possible.
We implemented something similar to gain control of global/singletons for testing purposes. We changed our singletons to be accessible as interfaces on the application (not TApplication, our own equivalent). Then we added the ability to dynamically add/remove interfaces at run-time. Now our test cases are able to plug in suitable mocks as and when needed.
I'll describe the general approach, hopefully you'll be able to apply it to the specifics of your situation.
Add a field to hold a list of dynamically added interface. An TInterfaceList works nicely.
Add methods to add/remove the dynamic interfaces.
Override function QueryInterface(const IID: TGUID; out Obj): HResult; virtual;. Your implementation will first check the interface list, and if not found will defer to the base implementation.
Edit: Sample Code
To answer your question:
I understand that the class now can tell others that it supports interface X now, so the interface was ADDED during runtime. But I also need to IMPLEMENT the interface's methods from outside (another unit). How is this done?
When you add the interface, you're adding an instance of the object that implements the interface. This is very much like the normal property ... implements <interface> technique to delegate implementation of an interface to another object. The key difference being this is dynamic. As such it will have the same kinds of limitations: E.g. no access to the "host" unless explicitly given a reference.
The following DUnit test case demonstrates a simplified version of the technique in action.
unit tdDynamicInterfaces;
interface
uses
SysUtils,
Classes,
TestFramework;
type
TTestDynamicInterfaces = class(TTestCase)
published
procedure TestUseDynamicInterface;
end;
type
ISayHello = interface
['{6F6DDDE3-F9A5-407E-B5A4-CDF91791A05B}']
function SayHello: string;
end;
implementation
{ ImpGlobal }
type
TDynamicInterfaces = class(TInterfacedObject, IInterface)
{ We must explicitly state that we are implementing IInterface so that
our implementation of QueryInterface is used. }
private
FDynamicInterfaces: TInterfaceList;
protected
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
public
constructor Create;
destructor Destroy; override;
procedure AddInterface(AImplementedInterface: IInterface);
end;
type
TImplementor = class (TInterfacedObject, ISayHello)
{ NOTE: This could easily have been implemented in a separate unit. }
protected
{ISayHello}
function SayHello: string;
end;
{ TDynamicInterfaces }
procedure TDynamicInterfaces.AddInterface(AImplementedInterface: IInterface);
begin
{ The simplest, but least flexible approach (see also QueryInterface).
Other options entail tagging specific GUIDs to be associated with given
implementation instance. Then it becomes feasible to check for duplicates
and also dynamically remove specific interfaces. }
FDynamicInterfaces.Add(AImplementedInterface);
end;
constructor TDynamicInterfaces.Create;
begin
inherited Create;
FDynamicInterfaces := TInterfaceList.Create;
end;
destructor TDynamicInterfaces.Destroy;
begin
FDynamicInterfaces.Free;
inherited Destroy;
end;
function TDynamicInterfaces.QueryInterface(const IID: TGUID; out Obj): HResult;
var
LIntf: IInterface;
begin
{ This implementation basically means the first implementor added will be
returned in cases where multiple implementors support the same interface. }
for LIntf in FDynamicInterfaces do
begin
if Supports(LIntf, IID, Obj) then
begin
Result := S_OK;
Exit;
end;
end;
Result := inherited QueryInterface(IID, Obj);
end;
{ TImplementor }
function TImplementor.SayHello: string;
begin
Result := 'Hello. My name is, ' + ClassName;
end;
{ TTestDynamicInterfaces }
procedure TTestDynamicInterfaces.TestUseDynamicInterface;
var
LDynamicInterfaceObject: TDynamicInterfaces;
LInterfaceRef: IUnknown;
LFriend: ISayHello;
LActualResult: string;
begin
LActualResult := '';
{ Use ObjRef for convenience to not declare interface with "AddInterface" }
LDynamicInterfaceObject := TDynamicInterfaces.Create;
{ But lifetime is still managed by the InterfaceRef. }
LInterfaceRef := LDynamicInterfaceObject;
{ Comment out the next line to see what happens when support for
interface is not dynamically added. }
LDynamicInterfaceObject.AddInterface(TImplementor.Create);
if Supports(LInterfaceRef, ISayHello, LFriend) then
begin
LFriend := LInterfaceRef as ISayHello;
LActualResult := LFriend.SayHello;
end;
CheckEqualsString('Hello. My name is, TImplementor', LActualResult);
end;
end.
You can preserve the ability to persist data and implement it through inheritance and still create the correct instances for the ClassGUIDs stored in the tables if you'd apply the factory design pattern.
For each node class there would be one class factory (or just a function pointer) responsible for creation of the correct Delphi class. Class factories may register themselves in the unit initialization section (once per application startup) at the kernel singleton object.
The kernel singleton would then map GUID to correct factory that would in turn call the correct class instance constructor (as shown at http://delphipatterns.blog.com/2011/03/23/abstract-factory)
Packages may be split into separate DLLs and classes implemented in separate units, still inheriting from one base TVMNode class.
The features you now use RTTI for can be supported in descendant classes or in the factory classes easily through some virtual methods.
You might also consider using simpler Data Transfer Objects for saving/loading the TVMNodes and perhaps take some inspiration from an already well perceived Object Relational Mapper or a Object Persistence framework as the problem you are trying to solve seem to me like exactly the problems they are handling (already)
I don't know about good Delphi open source frameworks of this class. But from other languages you can look at Java Hibernate, Microsoft .NET Entity Framework or minimalistic Google Protocol Buffers serializer
I'm using Delphi XE to write a base class, which will allow descending classes to have dll methods mapped by applying an annotation. However I get a typecasting error, which is understandable.
In essence the base class should look like this:
TWrapperBase = class
public
FLibHandle: THandle;
procedure MapMethods;
end;
procedure TWrapperBase.MapMethods;
var
MyField: TRttiField;
MyAttribute: TCustomAttribute;
pMethod: pointer;
begin
FLibHandle := LoadLibrary(PWideChar(aMCLMCR_dll));
for MyField in TRttiContext.Create.GetType(ClassType).GetFields do
for MyAttribute in MyField.GetAttributes do
if MyAttribute.InheritsFrom(TMyMapperAttribute) then
begin
pMethod := GetProcAddress(FLibHandle, (MyAttribute as TMyMapperAttribute).TargetMethod);
if Assigned(pMethod) then
MyField.SetValue(Self, pMethod); // I get a Typecast error here
end;
And a descending class could look like this:
TDecendant = class(TWrapperBase)
private type
TSomeDLLMethod = procedure(aParam: TSomeType); cdecl;
private
[TMyMapperAttribute('MyDllMethodName')]
FSomeDLLMethod: TSomeDLLMethod;
public
property SomeDLLMethod: TSomeDLLMethod read FSomeDLLMethod;
end;
I could implement this differently, by hard coding the linking for each method in an overriden 'MapMethods'. This would however require each descendant to do so which I'd like to avoid.
I know that the TValue as used in this case will contain a pointer and not of the correct type (procedure(aParam: TSomeType); cdecl; in this case).
My question: Is there a way to pass the pointer from 'GetProcAdress' as the correct type, or to set the field directly (for example by using the field address 'PByte(Self)+MyField.Offset', which you can use to set the value of a record property)?
With the old Rtti, this could be done but only for published properties and without any type checking:
if IsPublishedProp(Self, 'SomeDLLMethod') then
SetMethodProp(Self, 'SomeDLLMethod', GetProcAddress(FLibHandle, 'MethodName');
There are two problems:
First your EInvalidCast is caused by TValue being very strict about type conversions. You are passing in a Pointer and want to set a field of type TSomeDLLMethod. You need to explicitly pass a TValue that has the correct type info.
if Assigned(pMethod) then
begin
TValue.Make(#pMethod, MyField.FieldType.Handle, value);
MyField.SetValue(Self, value);
end;
Now you will run into another EInvalidCast exception which is triggered because of a bug in XE inside the GetInlineSize method of the Rtti.pas which returns 0 for a tkProcedure kind of type. I don't know in what version this got fixed but it does not exist anymore in XE5.
For XE this can be fixed by using a unit I wrote some while ago (and which I just updated to fix this bug): RttiPatch.pas.
I also reported the original issue because Pointer is assignment compatible to a procedure type so TValue should also handle this: http://qc.embarcadero.com/wc/qcmain.aspx?d=124010
You could try something like:
Move(pMethod, PByte(Self) + Field.Offset, SizeOf(Pointer));
or
PPointer(PByte(Self) + Field.Offset)^ := pMethod;
In the following type:
MyClass = class(TInterfacedPersistent)
private
FMyProperty: Integer;
published
procedure setMyProperty(Value: Integer); virtual;
property MyProperty: Integer read FMyProperty write setMyProperty;
I would like to know the name of the setter method of the "MyProperty" property via RTTI. I've tried the following:
procedure ShowSetterMethodsNames(pMyObject: TObject);
var
vPropList: TPropList;
vCount, I: Integer;
begin
vCount:= GetPropList(pMyObject.ClassInfo, tkProperties, #vPropList);
for I:= 0 to vCount -1 do
begin
if Assigned(vPropList[I]^.SetProc) then
ShowMessage(pMyObject.ClassType.MethodName(vPropList[I]^.SetProc));
end;
end;
Although the pointer is not nil, all I have is an empty message. Does anybody have some tip to me?
P.S.: I'm using Delphi XE4, and I know I should use extended RTTI instead of classic, but anyway, I can't do what I want in both features... So, any help will be appreciated. Thanks for the replies.
FINAL EDITION, problem solved:
Here is the code working, based in the (help of my friends and...) RTTI unit (DoSetValue method of TRTTIInstanceProperty class):
procedure ShowVirtualSettersNames(pObject: Pointer);
var
vSetter, vPointer: Pointer;
vPropList: TArray<TRttiProperty>;
vProp: TRttiProperty;
begin
vPropList:= RTTIUtils.ExtractProperties(TObject(pObject).ClassType); // Helper to get properties from a type, based in extended RTTI
for vProp in vPropList do
begin
vPointer:= TRttiInstanceProperty(vProp).PropInfo^.SetProc;
vPointer:= PPointer(PInteger(pObject)^ + Smallint(vPointer))^;
ShowMessage(TObject(pObject).ClassType.MethodName(vPointer));
end;
end;
This ONLY WORKS FOR VIRTUAL SETTERS, for statics the message is empty. Thanks everyone!
You can retrieve this method name, if
a) move the method to the published section (classic RTTI works with this section only (more accurately - compiled with {$M+} directive))
b) use right class specifier - MyClass.MethodName, because MethodName is class function
This code works on D7 and XE3:
MyClass = class(TInterfacedPersistent)
private
FMyProperty: Integer;
published
procedure setMyProperty(Value: Integer);
property MyProperty: Integer read FMyProperty write setMyProperty;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ppi: PPropInfo;
begin
ppi := GetPropInfo(MyClass, 'MyProperty');
ShowMessage(MyClass.MethodName(ppi.SetProc));
end;
P.S. What Delphi version are you using? What about Extended RTTI (since D2010)?
Read c:\rad studio\9.0\source\rtl\common\System.Rtti.pas
procedure TRttiInstanceProperty.DoSetValue
The setter of the property may be
a field (variable)
a static procedure
a virtual procedure (your case)
And those cases make PropInfo^.SetProc have different semantics of its value.
Direct address only applies to static procedures. For virtual methods you add a VMT offset and take the code address from that memory cell, as specified in that code i mentioned (but would not quote for copyright reasons).
Or you just could use TRttiProperty.SetValue and let Delphi do all those little under the hood details. See http://docwiki.embarcadero.com/Libraries/XE2/en/System.Rtti.TRttiProperty.SetValue
EDIT:
the code removed - it did not worked verbatim and the topic starter provided working version.
Regarding and I know I should use Extended RTTI instead of classic one - that is questionable claim. Extended RTTI is known to work noticeably slower than classic one. Dunno if someone did profiled it, but i suspect that is mostly due to the slow code of TValue. You can google and find that lot of people complained of slow TValue implementation and provided alternative ones with fixed efficiency. However since Extended RTTI only uses stock TValue it cannot benefit from those implementations and remains slower than classic one.
I have a class (TMyClass) which have a property (Items: TItems)
TItems = class;
TMyClass = class(TComponent)
private
FItems: TItems;
procedure SetItems(const Value: TItems);
protected
public
protected
property Items: TItems read FItems write SetItems;
end.
TExItems = class(TItems)
private
FNewProb: Integer;
protected
public
published
property NewProp: Integer read FNewProb write FNewProb;
end.
TExMyClass = class(TMyClass)
private
FItems: TExItems;
procedure SetItems(const Value: TItems);
protected
public
published
property Items: TExItems read FItems write SetItems;
end.
The new "Items" property is inherited from TItems but when I installed the component the new property of TExItems which is "NewProb" did not appear and it looks like the "Items" property is still TItems not TExItems...how to override it?
Thanks
Modification :
Here is the Real code
type
TKHAdvSmoothDock = class;
TKHAdvSmoothDockItem = class(TAdvSmoothDockItem)
private
FImageIndex: TImageIndex;
procedure SetImageIndex(const Value: TImageIndex);
protected
public
published
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
end;
TKHAdvSmoothDockItems = class(TAdvSmoothDockItems)
private
FOwner: TKHAdvSmoothDock;
FOnChange: TNotifyEvent;
function GetItem(Index: Integer): TKHAdvSmoothDockItem;
procedure SetItem(Index: Integer; const Value: TKHAdvSmoothDockItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TKHAdvSmoothDock);
function Add: TKHAdvSmoothDockItem;
function Insert(Index: Integer): TKHAdvSmoothDockItem;
property Items[Index: Integer]: TKHAdvSmoothDockItem read GetItem write SetItem; default;
procedure Delete(Index: Integer);
published
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TKHAdvSmoothDock = class(TAdvSmoothDock)
private
FImageChangeLink: TChangeLink;
FImages: TCustomImageList;
FItems: TKHAdvSmoothDockItems;
procedure ImageListChange(Sender: TObject);
procedure SetImages(const Value: TCustomImageList);
procedure SetItems(const Value: TKHAdvSmoothDockItems);
function GetItems: TKHAdvSmoothDockItems;
{ Private declarations }
protected
procedure UpdateImagesFromImageList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Images: TCustomImageList read FImages write SetImages;
property Items: TKHAdvSmoothDockItems read GetItems write SetItems;
end;
Regards.
Property getters and setters can be virtual, and then overridden by inheriting classes, see below for your example updated. There's one caveat with you're example code and that's you're trying to change the type of the property, which is not allowed. I would advise you check for Value is TExItems in TExMyClass.SetItems but use the inherited Items property and cast to TExItems in all methods of TExMyClass and further inheritants.
TItems = class;
TMyClass = class(TComponent)
private
FItems: TItems;
procedure SetItems(const Value: TItems); virtual;
protected
property Items: TItems read FItems write SetItems;
end;
TExItems = class(TItems)
private
FNewProb: Integer;
protected
public
published
property NewProp: Integer read FNewProb write FNewProb;
end;
TExMyClass = class(TMyClass)
private
procedure SetItems(const Value: TItems); override;
end;
Properties cannot be virtual, so they cannot be overridden. They can be hidden, in that within the context of TExMyClass, references to Items will resolve to the property declared in that class, not the one declared in the ancestor.
If you have something whose static (declared, compile-time) type is TMyClass, Items will always refer to the one from that class, even if its run-time type is TExMyClass.
You could declare SetItems as protected and virtual in the base class, and then override it in the descendant instead of declaring a whole new property that happens to have the same name.
You can implement and override methods getItem and setItem;
Implement property Item only for TMyClass
property Items: TItems read getItems write setItemps;
For TMyClass:
public:
function getItems : TItems; virtual;
procedure setItems(items: TItems); virtual;
For TExMyClass:
public:
function getItems : TItems; override;
procedure setItems(items: TItems); override;
function TExMyClass.getItems : TItems;
begin
result := fItems;
end;
procedure TExMyClass.setItems(items : TItems);
begin
self.itmes := items;
end;
so, TExMyClass.items.className = TExItems !
Technically, you can't override a property, but you can mimic override in several ways. See for example this answer for the most basic manners.
Now I do not have the code for TAdvSmoothDock so the rest is just guessing. When the property getter and setter of TAdvSmoothDock.Items are virtual, you could override them. But in more advanced components, and I suppose the ones from TMS are, then there is a good chance of TAdvSmoothDock having a protected CreateItem method which is called whenever there is need of a new item which could be overriden. If that is the case, then you should implement it like:
function TKHAdvSmoothDock.CreateItem: TAdvSmoothDockItem;
begin
Result := TKHAdvSmoothDockItem.Create;
end;
And use it like:
TKHAdvSmoothDockItem(AKHAdvSmoothDock.Items[I]).ImageIndex := ...
It is the same problem as trying to have more than one TMemo that uses the same Lines object.
Since TCustomMemo delcares on its private section FLines: TStrings; it is not possible to have more than one TMemo that uses the same FLines.
The only way (i still know) of working is to fully duplicate the whole TCustomMemo class as TLinkedCustomMemo, but defining FLines: TStrings; on the public section; also need cloning the 'TMemo' but referencing TLinkedCustomMemo, not TCustomMemo
Then using the hack of delcaring TMemo=class(TLinkedMemo) you will have public access to FLines, so you can replace that object, with the object of the main TMemo, on all the rest linked memos.
Why do such Link on the content of the TMemos?
Easy answer could be: Have more than one TMemo that shows the same text, so user can see (and edit) two (or more) different parts at a time, like some SpreadSheets do... it normally also involve an horizontal splitter between them, syncing horizontal scrollbars, etc.
Sometimes doing something that seems so easy, it is really so complicated!
Just caused by faulty on VCL design.
For the sample of the TMemos... why on the hell they have not been defined its Lines property based on TStringList insead of TStrings? That way we could use the same String List for more than one TMemo at the same time.
If want to see, how internally is dependant on such... search for class TMemoStrings (it appears on implementation section of StdCtrls). Why it must have only one TMemo?, and why it must have at all? why not had used TStringList instead of all that hell?
When some classes are so closed... it comes the hacking way of declaring classes... but how to change only a property of a control without needing to whole duplicate some classes (just to change so little things)?
Oh, yes, a real life sample for a content linked memo could be:
Let the user see (at the same time) two different parts of a text file, without double the memory storage
Or better sample: the user wants to edit a word on line 3 and another on line ten million without the need to scroll
So you put two TMemo and link the Lines property, so user has the controls to edit such Lines property (on different points) from both memo without need to scroll down and up all the times.
Another sample:
User wants to edit lines one million to one million plus twenty but needs to see lines ten to twenty at the same time.
Having to memos with a copy is not possible, more than 3GiB of RAM on a 32Bits Windows (not allowed), each Memo would need >1.6GiB of ram each... etc.
Duplicating such data is neither an option, user edit on second memo, but first must be on sync... so after loose focus (or just after edit if want good looking) you would must copy all data form one to the others memos... computing time?
-etc
There are so much samples... and most important ones are the ones i can not figure.
So answering your question in a general form, "how to hack a class to modify it a little":
Clone the code that define the class in a new unit, call that unit something that let clear it is for cloning that class with some modifications
Use the same class name only if your modifications would be backward compatile (like when additg to TEdid the Align property, use the hack of declaring it as TTheClass=class(TheUnit.TTheClass)), else use a different name
Add such new unit at the end of the uses of interface section
That is it... simple to say, hard work to do on some cases.
I allways recomend using nes classes names, except as on the sample of adding Alignment property to a TEdit.
When use the hack of declaration? When you have a full application already coded and want to add to all TEdit on it the alignment... insetead of creating a new component, adding it to component tools, redefine all forms to not use :TEdit; and use :TMyAlignedEdit... you can just simple add to uses your unit and voila... all TEdit now have such property and IDE inspertor also sees it, etc.