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.
Related
I'm trying to copy selected text, using this:
uses
Androidapi.Helpers, Androidapi.jni , AndroidAPI.JNIBridge,
Androidapi.JNI.JavaTypes, FMX.Helpers.Android,
Androidapi.JNI.GraphicsContentViewText;
procedure TForm2.Button5Click(Sender: TObject);
var
myclipboard : JClipboardManager;
s: string;
begin
myclipboard := TJClipboardManager.create;
myclipboard.getText;
showmessage(BoolToStr(myclipboard.hasText));
end;`
There are a lot of samples in Java, but i'm not enough strong yet to understand it
You are not supposed to instantiate the ClipboardManager class directly, but instead use the Content.getSystemService() method to obtain the correct manager object. The Android documentation even says so:
You do not instantiate this class directly; instead, retrieve it through getSystemService(Class).
So, you have to do this instead:
function GetClipboardManager: JClipboardManager;
var
obj: JObject;
begin
obj := SharedActivityContext.getSystemService(TJContext.JavaClass.CLIPBOARD_SERVICE);
if Assigned(obj) then
Result := TJClipboardManager.Wrap((obj as ILocalObject).GetObjectID)
else
Result := nil;
end;
procedure TForm2.Button5Click(Sender: TObject);
var
myclipboard : JClipboardManager;
begin
myclipboard := GetClipboardManager;
if Assigned(myclipboard) then
begin
//...
end;
end;
Do note that depending on which version of Android you are running on, Context.getSystemService(CLIPBOARD_SERVICE) will return either a android.content.ClipboardManager (HoneyComb+) or android.text.ClipboardManager object. Not sure how well Delphi handles that, if at all. You will have to look at the declaration of JClipboardManager to see which one it is accessing. The latter one was deprecated in Android API level 11.
Embarcadero wants you to use FMX's cross-platform IFMXClipboardService interface instead:
uses
FMX.Platform, System.Rtti;
procedure TForm2.Button5Click(Sender: TObject);
var
Clipboard: IFMXClipboardService;
value: TValue;
hasText: boolean;
s: string;
begin
hasText := False;
if PlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(Clipboard)) then
begin
value := Clipboard.GetClipboard;
hasText := value.TryAsType<String>(s);
end;
ShowMessage(BoolToStr(hasText));
if hasText then ShowMessage(s);
end;
I have 5 forms created at design time. I need to dynamically create an instance of each form and put on a tab.
My question: If the form names are in an array of strings and I call my procedure like this:
ShowForm(FormName[3]);// To show the 3rd form on a tab page.
How can I define and create the new instance for each form?
This is what I have for now:
procedure TForm1.ShowFormOnTab(pProcName:String);
var
NewForm: TfrmSetupItemCategories;//***HERE IS MY PROBLEM***
NewTab: TTabSheet;
FormName: String;
begin
NewTab := TTabSheet.Create(PageControl1);
NewTab.PageControl:= PageControl1;
NewTab.Caption:='hi';
PageControl1.ActivePage := NewTab;
if pProcName='ProcfrmSetupItemCategories' Then
begin
NewForm:=TfrmSetupItemCategories.Create(NewTab);
NewTab.Caption := NewForm.Caption;
end;
if pProcName='ProcfrmZones' Then
begin
NewForm:=TfrmZones.Create(NewTab);
NewTab.Caption := NewForm.Caption;
end;
.
.
.
end;
the line that reads "HERE IS MY PROBLEM" is where I need help. I can't reuse NewForm as a variable with a second form in this way...
Note: My problem is NOT the tab. Rather it's creating a new instance of the form using the same variable name.
Declare the NewForm variable as TForm:
var
NewForm: TForm;
begin
NewForm := TMyForm.Create(Tab1); //compiles OK
NewForm := TMyOtherForm.Create(Tab2); //also compiles OK
end;
I'm assuming TMyForm and TMyOtherForm both are derivatives of TForm.
DRY
You can also reduce your repeating code using a class reference variable, like this:
procedure TForm1.ShowFormOnTab(pProcName:String);
var
NewForm: TForm;
ClassToUse: TFormClass;
NewTab: TTabSheet;
FormName: String;
begin
NewTab := TTabSheet.Create(PageControl1);
NewTab.PageControl:= PageControl1;
NewTab.Caption:='hi';
PageControl1.ActivePage := NewTab;
if pProcName='ProcfrmSetupItemCategories' then
ClassToUse := TfrmSetupItemCategories
else if pProcName='ProcfrmZones' then
ClassToUse := TfrmZones
else
ClassToUse := nil;
if Assigned(ClassToUse) then
begin
NewForm := ClassTouse.Create(NewTab);
NewTab.Caption := NewForm.Caption;
//if you access custom properties or methods, this is the way:
if NewForm is TfrmZones then
TfrmZones(NewForm).ZoneInfo := 'MyInfo';
end;
end;
Register your classes and then create the forms from a string
As Sir Rufo points in his comment, you can even go further registering your classes (I'm not sure if this can be done in Lazarus, that exercise is up to you).
First, register the form classes you want to instantiate from the class name, previous to any call to your ShowFormOnTab method, for example:
procedure TMainForm.FormCreate(Sender: TObject);
begin
RegisterClass(TfrmSetupItemCategories);
RegisterClass(TfrmZones);
//and other classes
end;
Then, you can change the code to get the class reference from the class name string:
procedure TForm1.ShowFormOnTab(pProcName:String);
var
NewForm: TForm;
ClassToUse: TFormClass;
ClassNameToUse: string;
NewTab: TTabSheet;
FormName: String;
begin
NewTab := TTabSheet.Create(PageControl1);
NewTab.PageControl:= PageControl1;
NewTab.Caption:='hi';
PageControl1.ActivePage := NewTab;
//get rid of 'Proc' and add the T
//or even better, pass directly the class name
ClassNameToUse := 'T' + Copy(pProcName, 5, MaxInt);
ClassToUse := TFormClass(FindClass(ClassNameToUse));
if Assigned(ClassToUse) then
begin
NewForm := ClassTouse.Create(NewTab);
NewTab.Caption := NewForm.Caption;
//if you access custom properties or methods, this is the way:
if NewForm is TfrmZones then
TfrmZones(NewForm).ZoneInfo := 'MyInfo';
end;
end;
That way, the code remains the same for any number of classes.
For more info about this, take a look at Creating a Delphi form from a string in delphi.about.com.
Declare your variable as an ancestor type:
var
NewForm: TForm;
or
var
NewForm: TCustomForm;
Drawback: you'll need to cast the variable to the specific class if you want to call any methods of your form that you have declared yourself.
Use a 'soft' cast if you want to have the compiler check that NewForm is actually a TMyForm at runtime:
(NewForm as TMyForm).MyMethod;
When you are absolutely sure that NewForm is a TMyForm (like when you just created it), you can also use a 'hard' cast:
TMyForm(NewForm).MyMethod;
With registered classes, in the initialization of the used forms, you could shorten it to
Function CreateAndDock(pc:TPageControl;const FormName:String):Boolean;
begin
Result := false;
if Assigned(GetClass(FormName)) and GetClass(FormName).InheritsFrom(TCustomForm) then
With TFormClass( GetClass(FormName)).Create(pc.Owner) do
begin
ManualDock(pc);
Show;
Result := true;
end;
end;
procedure TForm4.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(Integer(CreateAndDock(pagecontrol1,'TDockForm'))));
ShowMessage(IntToStr(Integer(CreateAndDock(pagecontrol1,'TNotExists'))));
end;
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.
Is it possible to, for instance, replace and free a TEdit with a subclassed component instantiated (conditionally) at runtime? If so, how and when it should be done? I've tried to set the parent to nil and to call free() in the form constructor and AfterConstruction methods but in both cases I got a runtime error.
Being more specific, I got an Access violation error (EAccessViolation). It seems François is right when he says that freeing components at frame costruction messes with Form controls housekeeping.
This more generic routine works either with a Form or Frame (updated to use a subclass for the new control):
function ReplaceControlEx(AControl: TControl; const AControlClass: TControlClass; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
begin
Result := nil;
Exit;
end;
Result := AControlClass.Create(AControl.Owner);
CloneProperties(AControl, Result);// copy all properties to new control
// Result.Left := AControl.Left; // or copy some properties manually...
// Result.Top := AControl.Top;
Result.Name := ANewName;
Result.Parent := AControl.Parent; // needed for the InsertControl & RemoveControl magic
if IsFreed then
FreeAndNil(AControl);
end;
function ReplaceControl(AControl: TControl; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
Result := nil
else
Result := ReplaceControlEx(AControl, TControlClass(AControl.ClassType), ANewName, IsFreed);
end;
using this routine to pass the properties to the new control
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;
use it like:
procedure TFrame1.AfterConstruction;
var
I: Integer;
NewEdit: TMyEdit;
begin
inherited;
NewEdit := ReplaceControlEx(Edit1, TMyEdit, 'Edit2') as TMyEdit;
if Assigned(NewEdit) then
begin
NewEdit.Text := 'My Brand New Edit';
NewEdit.Author := 'Myself';
end;
for I:=0 to ControlCount-1 do
begin
ShowMessage(Controls[I].Name);
end;
end;
CAUTION: If you are doing this inside the AfterConstruction of the Frame, beware that the hosting Form construction is not finished yet.
Freeing Controls there, might cause a lot of problems as you're messing up with Form controls housekeeping.
See what you get if you try to read the new Edit Caption to display in the ShowMessage...
In that case you would want to use
...ReplaceControl(Edit1, 'Edit2', False)
and then do a
...FreeAndNil(Edit1)
later.
You have to call RemoveControl of the TEdit's parent to remove the control. Use InsertControl to add the new control.
var Edit2: TEdit;
begin
Edit2 := TEdit.Create(self);
Edit2.Left := Edit1.Left;
Edit2.Top := Edit2.Top;
Edit1.Parent.Insertcontrol(Edit2);
TWinControl(Edit1.parent).RemoveControl(Edit1);
Edit1.Free;
end;
Replace TEdit.Create to the class you want to use, and copy all properties you need like I did with Left and Top.
You can actually use RTTI (look in the TypInfo unit) to clone all the matching properties. I wrote code for this a while back, but I can't find it now. I'll keep looking.