I'm using VFI (Visual Form Inheritance) and I need to check if a component of an instantiated form belongs to the formclass or to the form superclass.
any ideas ?
unit1
TFormStatus = class(TForm)
cpPanel: TPanel;
lblStatus: TLabel;
end;
unit 2
TFormCodigo = class(TFormStatus)
lblCodigo: TLabel;
end;
frmCodigo: TFormCodigo:
In any instances of frmCodigo I want to detect that lblCodigo is local to TFormCodigo and cpPanel / lblStatus are inherited components;
for i:=0 to Self.ComponentCount-1 do begin
if "InheritedComponent" (Self.Components[i]) then ...
end;
Something like this is possible using RTTI for object properties, but I dont know if it is possible for components.
Thanks.
If I understand you correctly, you need TRttiMember.Parent. For example see this article by Rob Love. You'll need Delphi 2010 or later I think.
In fact this is just part of an excellent series of articles - these articles will also tell you how to get hold of the fields, properties etc. without having to know their names.
Maybe something "stupid" like
function TFormStatus.IsStatusComponent(AComponent: TComponent): Boolean;
begin
Result := (AComponent = cpPanel) or (AComponent = lblStatus);
end;
already fulfils your needs?
In your TFormCordigo you can override ReadState method that is called every time a resource is read for a particular form. After inherited called ComponentCount contains the number of components created up to the current member of hierarchy, so after all you have list of borders for components that you can save elsewhere.
The code below illustrates this approach
procedure TInhTestForm.Button3Click(Sender: TObject);
var
i: integer;
begin
inherited;
Memo1.Lines.Clear;
for i:=0 to ComponentCount-1 do
begin
Memo1.Lines.Add(format('%s inroduced in %s', [Components[i].Name, ComponentParent(i).ClassName]));
end;
end;
function TInhTestForm.ComponentParent(Index: integer): TClass;
var
i, j: integer;
begin
Result:=Nil;
for i:=Low(fComponentBorders) to High(fComponentBorders) do
begin
if Index <= fComponentBorders[i] - 1 then
begin
j:=i;
Result:=Self.ClassType;
while j < High(fComponentBorders) do
begin
Result:=Result.ClassParent;
Inc(j);
end;
break;
end;
end;
end;
procedure TInhTestForm.ReadState(Reader: TReader);
begin
inherited;
SetLength(fComponentBorders, Length(fComponentBorders) + 1);
fComponentBorders[High(fComponentBorders)]:=ComponentCount;
end;
Related
i want to ask how to retain controlls when im making a copy of a control. for example i have an edit box that can be controlled with a slider for value change. when i make a copy using this code i achieve a copy of the items but the slider stops controlling editbox values. how can i fix that?
TypInfo;
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
procedure CloneEvents(Source, Dest: TControl);
var
I: Integer;
PropList: TPropList;
begin
for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], #PropList) - 1 do
SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
end;
procedure DuplicateChildren(const ParentSource: TWinControl;
const WithEvents: Boolean = True);
var
I: Integer;
CurrentControl, ClonedControl: TControl;
begin
for I := ParentSource.ControlCount - 1 downto 0 do
begin
CurrentControl := ParentSource.Controls[I];
ClonedControl := TControlClass(CurrentControl.ClassType).Create(CurrentControl.Owner);
ClonedControl.Parent := ParentSource;
CloneProperties(CurrentControl, ClonedControl);
ClonedControl.Name := CurrentControl.Name + '_';
if WithEvents then
CloneEvents(CurrentControl, ClonedControl);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DuplicateChildren(Panel1);
end;
Unless I'm misunderstanding you, your CloneProperties doesn't seem to have anything to do with the question you're asking. In your example of an edit control E1 and a slider S1, you can clone both of them to produce E2 and S2, but somewhere in your code there must be a statement that changes the value in E1 depending on the value of S1. However, in the way you've most likely written it, that statement doesn't apply to E2 and S2.
The simplest way around that is to write a method which takes the component instances and links the operation of the two together. e.g.
procedure TForm1.SetEditControlFromSlider(AnEdit : TEdit; ASlider : { TWhatever the slider actually is);
begin
// Set AnEdit's value from ASlider's properties
end;
Then, you can call this with Edit/Slider pairs like this
SetEditControlFromSlider(E1, S1);
[...]
SetEditControlFromSlider(E2, S2);
I can imagine you might not like having to do that.
IMO, the cleanest solution is to avoid attempting to clone components altogether and create a TFrame containing the Edit, Slider and the code that connects them, and then add to your form as many instances of the frame as you need. It's as easy as falling off a log.
type
TEditFrame = class(TFrame) // needs to be in its own unit, Used by your form
Edit1: TEdit;
TrackBar1: TTrackBar;
procedure TrackBar1Change(Sender: TObject);
private
public
end;
[...]
procedure TEditFrame.TrackBar1Change(Sender: TObject);
begin
Edit1.Text := IntToStr(TrackBar1.Position)
end;
Then, you can add clones of the frame to TForm1 by
procedure TForm1.Button1Click(Sender: TObject);
var
AFrame : TEditFrame;
begin
Inc(FrameCount); // Field of TForm1
AFrame := TEditFrame.Create(Self);
AFrame.Name := AFrame.Name + IntToStr(FrameCount);
AFrame.Parent := Self;
AFrame.Top := AFrame.Height * FrameCount;
end;
Note that because the code which links the two components, TrackBar1Change, it compiled into the frame's unit, it is automatically shared by every instance of the frame you create, without any need to "clone" the code.
I have two components A and B. Component B derives from component A and shares most properties and procedures with it. Now I have a lengthy procedure like this:
procedure DoSomething;
begin
Form1.Caption := Component_A.Caption;
// hundreds of additional lines of code calling component A
end;
Depending on whether component B is active or not, I would like to reuse the above procedure and replace the Component_A part with the name of component B. It should look like this then:
procedure DoSomething;
var
C: TheComponentThatIsActive;
begin
if Component_A.Active then
C := Component_A;
if Component_B.Active then
C := Component_B;
Form1.Caption := C.Caption;
end;
How can I do that in Delphi2007?
Thanks!
TheComponentThatIsActive should be the same type that ComponentA is (TComponentA).
Now, if you run into a stumbling block where some properties/methods only belong to ComponentB, then check and typecast it.
procedure DoSomething;
var
C: TComponentA;
begin
if Component_A.Active then
C := Component_A
else if Component_B.Active then
C := Component_B
else
raise EShouldNotReachHere.Create();
Form1.Caption := C.Caption;
if C=Component_B then
Component_B.B_Only_Method;
end;
You can pass ComponentA or ComponentB to DoSomething as a parameter.
ComponentA = class
public
procedure Fuu();
procedure Aqq();
end;
ComponentB = class(ComponentA)
public
procedure Blee();
end;
implementation
procedure DoSomething(context:ComponentA);
begin
context.Fuu();
context.Aqq();
end;
procedure TForm1.Button1Click(Sender: TObject);
var cA:ComponentA;
cB:ComponentB;
begin
cA:= ComponentA.Create();
cB:= ComponentB.Create();
DoSomething(cA);
DoSomething(cB);
cA.Free;
cB.Free;
end;
I got quite a large application which is currently being styled up.
To save me changing all the buttons in the IDE/Object Inspector I am planning on just doing a few functions for the main objects like
procedure StyleButton(AButton : TButton)
begin
AButton.Color := clGreen;
AButton.Font.Style = [fsBold];
end;
etc etc and then add that to the forms onCreates as needed
StyleButton(Button1); whatever etc
There is no issue passing objects in params like this. It does just reference the first object right?
It works fine and I can't think of any issues, but because this is a large application which thousands of users I just want to be sure there will be no issues/memory leaks/resource consumpution issues.
Will also be doing similar things with TAdvStringGrid and TEdit/TMemo components.
Then allows just 1 place to change these settings.
Or someone have a better idea?
This is an excellent idea. The function will modify whichever object you pass to it.
You are not passing by reference. You are passing by value. The value you are passing is a reference. "Passing by reference" means you'd use the var or out keywords, which are not appropriate in this situation.
Your idea is just fine, as the other answerers have already said. Just want to propose a solution that goes even further than David's and something you may want to consider in order to avoid having to add many statements like:
StyleButton(Button1);
StyleButton(Button2);
to each and every form for each and every control you would like to style;
What I would propose is to add a single method call to for example each form's OnShow event:
procedure TForm1.FormShow(Sender: TObject);
begin
TStyler.StyleForm(Self);
end;
The TStyler could be implemented in a separate unit that looks like this:
interface
type
TStyler = class;
TStylerClass = class of TStyler;
TStyler = class(TObject)
public
class procedure StyleForm(const aForm: TCustomForm);
class procedure StyleControl(const aControl: TControl); virtual;
class function GetStyler(const aControl: TControl): TStylerClass;
end;
implementation
uses
Contnrs;
type
TButtonStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
TEditStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
TLabelStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
var
_Controls: TClassList;
_Stylers: TClassList;
{ TStyler }
class function TStyler.GetStyler(const aControl: TControl): TStylerClass;
var
idx: Integer;
begin
Result := TStyler;
idx := _Controls.IndexOf(aControl.ClassType);
if idx > -1 then
Result := TStylerClass(_Stylers[idx]);
end;
class procedure TStyler.StyleForm(const aForm: TCustomForm);
procedure _StyleControl(const aControl: TControl);
var
i: Integer;
StylerClass: TStylerClass;
begin
StylerClass := TStyler.GetStyler(aControl);
StylerClass.StyleControl(aControl);
if (aControl is TWinControl) then
for i := 0 to TWinControl(aControl).ControlCount - 1 do
_StyleControl(TWinControl(aControl).Controls[i]);
end;
var
i: Integer;
begin
_StyleControl(aForm);
end;
class procedure TStyler.StyleControl(const aControl: TControl);
begin
// Do nothing. This is a catch all for all controls that do not need specific styling.
end;
{ TButtonStyler }
class procedure TButtonStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TButton then
begin
TButton(aControl).Font.Color := clRed;
TButton(aControl).Font.Style := [fsBold];
end;
end;
{ TEditStyler }
class procedure TEditStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TEdit then
begin
TEdit(aControl).Color := clGreen;
end;
end;
{ TLabelStyler }
class procedure TLabelStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TLabel then
begin
TLabel(aControl).Font.Color := clPurple;
TLabel(aControl).Font.Style := [fsItalic];
end;
end;
initialization
_Controls := TClassList.Create;
_Stylers := TClassList.Create;
_Controls.Add(TButton);
_Stylers.Add(TButtonStyler);
_Controls.Add(TEdit);
_Stylers.Add(TEditStyler);
_Controls.Add(TLabel);
_Stylers.Add(TLabelStyler);
finalization
FreeAndNiL(_Controls);
FreeAndNiL(_Stylers);
end.
This solution basically employs polymorphism and a registry that links control classes to styler classes. It also uses class procedures and functions to avoid having to instantiate anything.
Please note that the registry is implemented in this example as two lists that need to be kept in sync manually as the code assumes that finding a class at index X will find the styler at the same index in the other list. This can of course be improved upon very much, but is sufficient here to show the concept.
No, There is no issue (in your specific case) passing a object as parameter
procedure StyleButton(AButton : TButton)
when you do this you are passing a address memory (reference) and setting some properties of the referenced object, so there is not problem.
To add to what Rob and RRUZ have already said, you could consider an extra helper using open array parameters:
procedure StyleButtons(const Buttons: array of TButton);
var
i: Integer;
begin
for i := low(Buttons) to high(Buttons) do
StyleButton(Buttons[i]);
end;
You can then call this as:
StyleButtons([btnOK, btnCancel, btnRelease64bitDelphi]);
which is, in my view, more readable at the call-site than:
StyleButton(btnOK);
StyleButton(btnCancel);
StyleButton(btnRelease64bitDelphi);
Note that I passed the open array as a const parameter because that is more efficient when dealing with arrays. Because each element of the array is itself a reference to the button, you are able to modify the actual button. The const just means that you cannot change the reference.
I have a form (form2) and I implemented the following PUBLIC method:
function ShowInterface(i:integer):boolean;
This form is in a package that will be DYNAMIC LOADED. Now I want to instantiate this form (form2) and execute the method above.
Important: I can't reference form2's unit in form1.
I tryed this code, but it never finds "ShowInterface" pointer (returns nil).
procedure TfrmForm1.Button1Click(Sender: TObject);
var
PackageModule: HModule;
AClass: TPersistentClass;
ShowInterface: function (i:integer):boolean;
frm: TCustomForm;
begin
PackageModule := LoadPackage('form2.bpl');
if PackageModule <> 0 then
begin
AClass := GetClass('TfrmForm2');
if AClass <> nil then // <<-- FINE!! IT FINDS OUT 'TfrmForm2' in 'form2.bpl')
begin
frm := TComponentClass(AClass).Create(Self) as TCustomForm;
ShowInterface := frm.MethodAddress('ShowInterface'); // <<-- HERE!! ALLWAYS RETURNS "NIL"
if #ShowInterface <> nil then
ShowInterface(1);
// but if I call frm.Show, it works fine. frm is "loaded"!!!
frm.Free;
end;
DoUnloadPackage(PackageModule);
end;
end;
Thanks in advance.
MethodAddress only works for published methods. Move it to the published section and it should work.
Or, if you have Delphi 2010, the extended RTTI offers a way to find public methods by name. (Or other visibility levels, if you change it from the default.)
As Mason and TOndrej said, I have to put the method in published section. (Thank you!)
But, some fixes were needed:
procedure TfrmForm1.Button1Click(Sender: TObject);
type
TShowInterface = function(i:integer):boolean of object;
var
PackageModule: HModule;
AClass: TPersistentClass;
Routine: TMethod;
ShowInterface : TShowInterface;
frm: TCustomForm;
begin
PackageModule := LoadPackage('form2.bpl');
if PackageModule <> 0 then
begin
AClass := GetClass('TfrmForm2');
if AClass <> nil then
begin
frm := TComponentClass(AClass).Create(Self) as TCustomForm;
Routine.Data := Pointer(frm);
Routine.Code := frm.MethodAddress('ShowInterface');
if Assigned(Routine.Code) then
begin
ShowInterface := TShowInterface(Routine);
ShowInterface(1); // showinterface executes a "ShowModal", so we can "free" form after this.
end;
frm.Free;
end;
DoUnloadPackage(PackageModule);
end;
end;
In D2007 and some earlier versions, that only works with published methods, or extended RTTI: {$METHODINFO ON}. I haven't used D2010 yet; it seems to have a new RTTI system which has been extended a lot.
Using the Typinfo unit, it is easy to enumerate properties as seen in the following snippet:
procedure TYRPropertiesMap.InitFrom(AClass: TClass; InheritLevel: Integer = 0);
var
propInfo: PPropInfo;
propCount: Integer;
propList: PPropList;
propType: PPTypeInfo;
pm: TYRPropertyMap;
classInfo: TClassInfo;
ix: Integer;
begin
ClearMap;
propCount := GetPropList(PTypeInfo(AClass.ClassInfo), propList);
for ix := 0 to propCount - 1 do
begin
propInfo := propList^[ix];
propType := propInfo^.PropType;
if propType^.Kind = tkMethod then
Continue; // Skip methods
{ Need to get GetPropInheritenceIndex to work
if GetPropInheritenceIndex(propInfo) > InheritLevel then
Continue; // Dont include properties deeper than InheritLevel
}
pm := TYRPropertyMap.Create(propInfo.Name);
FList.Add(pm);
end;
end;
However, what I need is to figure out the exact class from which each property inherits.
For example in TControl, the Tag property comes from TComponent, which gives it an inheritance depth of 1 (0 being a property declared in TControl itself, such as Cursor).
Calculating the inheritance depth is easy if I know which class first defined the property. For my purposes, wherever a property first gained published visibility is where it first appeared.
I am using Delphi 2007. Please let me know if more detail is required. All help will be appreciated.
This works for me.
The crux is getting the parent's TypeInfo from the passed through child TypeInfo
procedure InheritanceLevel(AClassInfo: PTypeInfo; const AProperty: string; var level: Integer);
var
propInfo: PPropInfo;
propCount: Integer;
propList: PPropList;
ix: Integer;
begin
if not Assigned(AClassInfo) then Exit;
propCount := GetPropList(AClassInfo, propList);
for ix := 0 to propCount - 1 do
begin
propInfo := propList^[ix];
if propInfo^.Name = AProperty then
begin
Inc(level);
InheritanceLevel(GetTypeData(AClassInfo).ParentInfo^, AProperty, level)
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
level: Integer;
begin
level := 0;
InheritanceLevel(PTypeInfo(TForm.ClassInfo), 'Tag', level);
end;
I don't know if you can find this using the RTTI available in Delphi 2007. Most properties in the TComponent tree are declared as protected in the original class, and then redeclared as published further down, and you only have RTTI for published members.
I was right about to describe something very similar to Lieven's solution when I saw that he'd beat me to it. This will find the first class where the property was published, if that's what you're looking for, but it won't find where the property was originally declared. You need Delphi 2010's extended RTTI if you wanted that.