Invalid Pointer Operation freeing an object - delphi

Being new to OOP, I'm curious why Delphi XE7 generated an invalid pointer operation on a logging class I was using whenI try to free it. So I created a simple test to create an object and then free it. I'm not sure what I'm missing here and why it throws this exception when MyObject.Free is called.
In the first unit, I create an instance of this object as shown here.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyObject: TMyObject;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
MyObject := TMyObject.Create;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
MyObject.Free;
end;
end.
In the 2nd unit, I have the object defined as follows.
unit Unit2;
interface
uses System.Classes;
type
TMyObject = class
public
constructor Create;
destructor Free;
end;
implementation
constructor TMyObject.Create;
begin
inherited Create;
end;
destructor TMyObject.Free;
begin
inherited Free;
end;
end.
Any help is appreciated.

Always implement a destructor by overriding the virtual destructor named Destroy.
type
TMyObject = class
public
constructor Create;
destructor Destroy; override;
end;
constructor TMyObject.Create;
begin
inherited;
end;
destructor TMyObject.Destroy;
begin
inherited;
end;
To destroy an instance call the method named Free in TObject. This calls the virtual destructor Destroy only if the instance is not nil.
Learn more from the documentation:
http://docwiki.embarcadero.com/Libraries/en/System.TObject.Free
http://docwiki.embarcadero.com/Libraries/en/System.TObject.Destroy
The name MyObject is weak. Object is used for instances. Class is used for classes.

Related

Does class(TInterfacedObject) need a destructor in Delphi?

I run in this situation where Destroy() is never called.
unit Unit2;
interface
type
// Interface
ITest = Interface(IInterface)
function IsTrue() : Boolean;
end;
TmyClass = class(TInterfacedObject, ITest)
public
// Interface implementation
function IsTrue() : Boolean;
constructor Create();
destructor Destroy(); override;
end;
implementation
constructor TmyClass.Create();
begin
inherited Create();
end;
destructor TmyClass.Destroy();
begin
inherited Destroy();
end;
published
// Property
property IsItTrue: Boolean read IsTrue;
end.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, unit2;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fMyClass: TmyClass;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
fMyClass.Free; // if refcount = 0 this works, if refcount <> 0 pointer error.
//or
fMyClass := Nil; // no error but Destroy wil not be executed
Close();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fMyClass := TMyClass.Create();
end;
end.
Reading this article, there is only a constructor but no destructor implemented.
Is there any particular reason for this?
And should I release (if needed) all other objects that will be defined in myClass by implementing a finalization section?
The most likely reason for the destructor not being called would be because you don't assign your object to an interface variable.
procedure Test1;
var
vMyObj : TObject;
begin
vMyObj := myclass.Create;
end; <-Destructor NOT called here
procedure Test2;
var
vMyIntf : IInterface;
begin
vMyIntf := myclass.Create;
end; <-Destructor IS called here.
If that's the case, I invite you to read this answer for more information.
Your fMyClass variable is an object reference, not an interface, so it does not participate in TInterfaceObject's reference counting.
You need to change this:
fMyClass: TmyClass;
to this:
fMyClass: ITest;
And then you can get rid of fMyClass.Free; altogether:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, unit2;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fMyClass: ITest;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
fMyClass := nil; // no error and Destroy will be executed
Close();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fMyClass := TMyClass.Create();
end;
end.
fMyClass := nil; will invoke reference counting only if fMyClass is an interface variable, not an object reference, and you can't call Free() on an interface variable.

TPopupMenu as subcomponent, don't works

I'm trying to develop a component, specifically a button linked to a popup menu.
I can not understand why I do not see the PopupMenu.
Down here my code:
unit DropDownButton;
interface
uses
System.SysUtils,
System.Classes,
Vcl.Controls,
Vcl.StdCtrls,
System.Types,
Vcl.Menus;
type
TDropDownButton = class;
TDropDownButton = class(TButton)
private
FDropDownMenu: TPopupMenu;
protected
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
published
property DropDownMenu: TPopupMenu read FDropDownMenu;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Flexline', [TDropDownButton]);
end;
constructor TDropDownButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDropDownMenu:= TPopupMenu.Create(Self);
FDropDownMenu.Name:= 'Menu';
FDropDownMenu.SetSubComponent(True);
end;
procedure TDropDownButton.Click;
var
_point: TPoint;
begin
_point:= Self.ClientToScreen(Point(0,0));
FDropDownMenu.Popup(_point.X,_point.Y + Height);
inherited Click;
end;
end.
Thanks in advance.
I'd like to make a dropdown button to use in my project

Delphi Form in DLL works, but Delphi Frame - not

I am trying to create a Form and a Frame in Delphi-made DLL using handles only. The form appears in host application normally, but the frame doesn't appear at all.
What could be wrong?
Below I provide a piece of code that creates both Frame and Window:
library DLL1;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
System.SysUtils,
System.Classes,
DllMain in 'DllMain.pas',
Winapi.Windows,
Vcl.Forms,
Vcl.Controls {DLLFrame1: TFrame},
DllForm in 'DllForm.pas' {Form1};
{$R *.res}
type
TSingleton = class
private
fra: TDLLFrame1;
frm: TForm1;
class var __instance: TSingleton;
class function __getInstance(): TSingleton; static;
public
class property Instance: TSingleton read __getInstance;
procedure CreateDLLFrame(AppHandle, ParentWindow: HWND);
procedure CreateDLLForm(AppHandle, ParentWindow: HWND);
procedure DestroyDLLFrame();
procedure DestroyDLLForm();
end;
procedure CreateDLLFrame(AppHandle, ParentWindow: HWND); stdcall;
begin
TSingleton.Instance.CreateDLLFrame(AppHandle, ParentWindow);
end;
procedure CreateDLLForm(AppHandle, ParentWindow: HWND); stdcall;
begin
TSingleton.Instance.CreateDLLForm(AppHandle, ParentWindow);
end;
procedure DestroyDLLFrame(); stdcall;
begin
TSingleton.Instance.DestroyDLLFrame();
end;
procedure DestroyDLLForm(); stdcall;
begin
TSingleton.Instance.DestroyDLLForm();
end;
exports
CreateDLLFrame,
CreateDLLForm,
DestroyDLLFrame,
DestroyDLLForm;
procedure TSingleton.CreateDLLFrame(AppHandle, ParentWindow: HWND);
begin
Application.Handle := AppHandle;
fra := TDLLFrame1.CreateParented(ParentWindow);
fra.Show();
end;
procedure TSingleton.DestroyDLLForm();
begin
frm.Free();
end;
procedure TSingleton.DestroyDLLFrame();
begin
fra.Free();
end;
procedure TSingleton.CreateDLLForm(AppHandle, ParentWindow: HWND);
begin
Application.Handle := AppHandle;
frm := TForm1.CreateParented(ParentWindow);
frm.Show();
end;
class function TSingleton.__getInstance(): TSingleton;
begin
if __instance = nil then
__instance := TSingleton.Create();
Result := __instance;
end;
end.
The DLLFrame:
unit DllMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TDLLFrame1 = class(TFrame)
mmoText: TMemo;
pnlSend: TPanel;
edtSend: TEdit;
btnSend: TButton;
private
public
constructor Create(AOwner: TComponent); override;
end;
implementation
{$R *.dfm}
{ TDLLFrame1 }
constructor TDLLFrame1.Create(AOwner: TComponent);
begin
inherited;
if AOwner = nil then
MessageBox(0, 'Frame owner is NIL', 'Debug', 0)
else
MessageBox(0, PWideChar(AOwner.Name), 'Debug', 0);
end;
end.
Delphi TFrame descend from TWinControl (and thus, TControl), they have an Owner and they have a Parent (often these are the same). The Owner controls the Frame's lifetime while the Parent controls where it's displayed (i.e. which Window handle is to be used). For example, in a VCL app with 2 form units and a frame unit, you could instantiate a Frame having it's owner be the Application object or the the first Form while having it's parent be the second form; the Frame would be displayed on the second form even though it's owner was the first frame.
What is the difference between Owner and Parent of a control?
This little example doesn't use DLLs, but it shows how the frame won't be displayed without a Parent being assigned:
unit CreateFrameAtRunTimeForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses CreateFrameAtRunTimeFrame;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
var
F : TFrame3;
begin
F := TFrame3.Create(self);
F.Name := 'Frame'+Random(1000000).ToString;
F.Panel1.Caption := 'Frame '+F.Name;
F.Left := 200;
F.Top := 100;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
F : TFrame3;
begin
F := TFrame3.Create(self);
F.Name := 'Frame'+Random(1000000).ToString;
F.Panel1.Caption := 'Frame '+F.Name;
F.Left := 200;
F.Top := 100;
F.Parent := self;
end;
end.
I'm sure your problem is that the Frame doesn't have a Parent control and I don't think it's possible to set one if you are only passing window handles around.

Dynamically assigning anonymous generic functions in pascal

I have the following class hierarchy
I would like to be able to dynamically assign anonymous methods which operate on objects of both types TB and TC.
So here is a simple contrived example:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TNotifyEventWrapper = class
private
FProc: TProc<TObject>;
public
constructor Create(Proc: TProc<TObject>);
published
procedure Event(Sender: TObject);
end;
IA = interface
procedure Foo;
end;
TA = class(TInterfacedObject)
procedure Foo;
end;
TB = class(TA, IA)
procedure Foo;
end;
TC = class(TA, IA)
procedure Foo;
end;
TControl = class
strict private
public
class var NEW : TNotifyEventWrapper;
class var Foo : TNotifyEvent;
class function GetWrapper<T:TA, IA, constructor>(D: T): TNotifyEventWrapper;
class procedure AssignFooHandler<T:TA, IA, constructor>;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TC.Foo;
begin
ShowMessage('TC.Foo');
end;
class function TControl.GetWrapper<T>(D: T): TNotifyEventWrapper;
begin
Result :=
TNotifyEventWrapper.Create
(
procedure (S : TObject)
begin
T(D).Foo;
end
);
end;
class procedure TControl.AssignFooHandler<T>;
var
X : T;
begin
X := T.Create;
try
TControl.NEW := TControl.GetWrapper<T>(X);
TControl.Foo := TControl.NEW.Event;
finally
FreeAndNil(X);
end;
end;
procedure TA.Foo;
begin
ShowMessage('TA.Foo');
end;
procedure TB.Foo;
begin
ShowMessage('TB.Foo');
end;
constructor TNotifyEventWrapper.Create(Proc: TProc<TObject>);
begin
inherited Create;
FProc := Proc;
end;
procedure TNotifyEventWrapper.Event(Sender: TObject);
begin
FProc(Sender);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TControl.Foo(Sender);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TControl.AssignFooHandler<TC>; //TB
end;
end.
I would like to be able to call
TControl.AssignFooHandler<TC>;
And have the TControl.Foo(Sender); method invoke TC.Foo
Also I want TControl.AssignFooHandler<TB>; to result in TControl.Foo(Sender); invoking TB.Foo
Unfortunately, when I run this, it always invokes the base class method TA.Foo.
I'm not sure how to get around this.
Your Generic is constrained to descendants of TA and IA. TA.Foo is not declared as virtual, and T(B|C).Foo() are not declared to override it. That is why TA.Foo() is being called every time. You need to make TA.Foo() virtual and T(B|C).Foo override it, then T(B/C).Foo will get called as expected.
Also, you are freeing the T(A/B/C) object that you are passing to TControl.GetWrapper() before TControl.Foo() ever gets a chance to invoke the Foo() method of that object. In this particular example, it is OK since none of the Foo() methods access any object member fields, but once you start doing that in actual production code, it is likely to crash. You need to keep the T(A/B/C) object alive until you are done using the TNotifyEventWrapper object.

Delphi 7: an abstract class through VFI

Is it possible in Delphi 7 to create an abstract class that can be inherited through the Visual Form Inheritance technique? If so, please, provide an example.
The task is this. I want to create a form that will serve as a base form for two other forms that will inherit all the properties of that form. The two inheriting forms will be used for adding new stuff to the database (creating a product item, for example) and editing that stuff. So, I guess the base form should be thought of as an abstract class that should have okay and cancel buttons and things like that which all inheriting classes will share. Well, it is obviously an abstract class, because there is no other use of the form other than being a form to base other forms on.
Here's a simple diagram to make the point clearer:
First of all we need to define what abstract class means. There appear to me to be two competing definitions:
An abstract class is one that cannot be instantiated. This is the most commonly used definition.
An abstract class is one that contains more than one abstract method.
Since Delphi no language mechanism for enforcing definition 1, it would appear that definition 2 is the definition that applies to this question.
And the answer to the question is that classes that contain abstract methods can be used with Visual Form Inheritance.
Modern versions of Delphi do allow you to decorate classes with the abstract keyword. However, this has no effect. You can still instantiate such a class. It is my understanding that the abstract keyword was added for the benefit of the Delphi .net compiler.
Again, in modern versions of Delphi, you can configure the compiler to treat instantiation of classes with abstract methods as a compilation error. That's probably the closest you can get in Delphi to definition 1.
However, even that does not fully adhere to definition 1 since those classes can be instantiated through RTTI or virtual constructors. And the mechanism by which a designed component is instantiated is a perfect example.
Take this class for example:
type
TForm1 = class(TForm)
public
procedure Boo; virtual; abstract;
end;
Even if you set the option for W2000 Constructing instance containing abstract method to Error, you can still let the framework instantiate the class. It's only if you write TForm1.Create that the compiler objects.
You use the term abstract, but reading your question, I seriously doubt you really mean it the way abstract within Delphi is defined. I think you mean the term abstract in the general plain spoken way: you want to design a form with parts that have to be altered or added by descendants. Abstract methods in Delphi mean class routines without implementation. It does not matter though, because it is perfectly possible to design a base form, with or without abstract methods.
You can create a setup as shown in your picture/diagram as follows:
Design a form TBaseForm with 2 Edits, 2 Labels, 2 Buttons and 1 ActionList,
Add 3 actions to the ActionList: Create, Save and Cancel,
Assign the Cancel action to CancelButton.Action in advance,
Save the form,
Design a new form, inherited from TBaseForm, with the menu command: File > New > Other > [Project Name] > BaseForm
You will have a new form that has the edits, labels, buttons and actions,
Assign the Save action to the other button's action property,
Give it a "Edit Item" caption,
Save the form, and repeat it for the "Create New Item"-form.
The base form may have abstract methods, if you want to. When you create a TBaseForm instance at runtime, the compiler will give a warning constructing instance of 'TBaseForm' containing abstract method 'TBaseForm.MethodName'. It remains a warning, until you invoke the method at runtime which will produce an abstract error. Creating a descendant form which implements that method, then there will be no warning. Creating forms with abstract methods in the designer does not produce warnings. Runtime errors then may still occur though.
No, you cannot create an "abstract" base form in Delphi Visual Form Inheritance in the strict Delphi sense of the word "abstract".
However, from your description it doesn't sound like you actually need a strictly abstract base form. You don't mention a requirement for defining abstract methods at all.
It sounds like you just need a base form from which you create multiple differently specialized descendants that can share UI and implementation with the base form.
That's what VFI is for, so yes, you can do that.
I have Succeed to create a Demo with a BaseForm has Abstract Methodes and is work as charm ...
my IDE is Rad Studio RIO
my BaseForm code:
unit UBaseForm;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ExtCtrls, Vcl.StdCtrls;
type
TBaseForm = class(TForm)
Lbl_IndexPage: TLabel;
procedure Abstracted_Event(Sender: TObject); virtual; abstract;
procedure Abstracted_Proc; virtual; abstract;
function Abstracted_Func: string; virtual; abstract;
private
{ Private declarations }
public
{ Public declarations }
end;
procedure Get_SubForm(var Ref; AFormClass: TFormClass;
aOwner: TComponent; aParent: TWinControl);
var
BaseForm: TBaseForm;
implementation
{$R *.dfm}
procedure Get_SubForm(var Ref; AFormClass: TFormClass;
aOwner: TComponent; aParent: TWinControl);
var
Instance: TBaseForm;
begin
if not Assigned(TBaseForm(Ref)) then
begin
Instance := TBaseForm(AFormClass.NewInstance);
TBaseForm(Ref) := Instance;
Instance.Create(aOwner);
end
else Instance := TBaseForm(Ref);
Instance.Parent := aParent;
Instance.Align := alClient;
Instance.BorderStyle := bsNone;
Instance.OnShow := Instance.Abstracted_Event;
Instance.Show;
end;
end.
in my APP i have three Forms can inherit all the properties of that BaseForm Above Even the Methodes ...
unit UFirstPage;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
UBaseForm,
Vcl.StdCtrls, Vcl.ExtCtrls;
type
TFrmFirstPage = class(TBaseForm)
Pnl_1: TPanel;
Edt_Abst_Msg_Event: TEdit;
Pnl_2: TPanel;
Pnl_3: TPanel;
Btn_Get_Abstract_Func: TButton;
Btn_Get_Abstract_Proc: TButton;
procedure Btn_Get_Abstract_FuncClick(Sender: TObject);
procedure Btn_Get_Abstract_ProcClick(Sender: TObject);
published
procedure Abstracted_Event(Sender: TObject); override;
procedure Abstracted_Proc; override;
function Abstracted_Func: string; override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmFirstPage: TFrmFirstPage;
implementation
{$R *.dfm}
{ TFrmFirstPage }
{$REGION ' Overridden Abstract Methodes ..'}
procedure TFrmFirstPage.Abstracted_Event(Sender: TObject);
begin
inherited;
Pnl_1.Color := clBlue; Pnl_2.Color := clGray; Pnl_3.Color := clRed;
Edt_Abst_Msg_Event.Text := 'All this Properties can changed using [Abstracted_Event] | (Owner Form is: ['+ Self.ClassName +'])';
end;
function TFrmFirstPage.Abstracted_Func: string;
begin
Result := 'I''m Just an Override of Abstracted_Func ['+ Self.ClassName +']';
end;
procedure TFrmFirstPage.Abstracted_Proc;
begin
inherited;
ShowMessage('I''m Just an Override of Abstracted_Proc ['+ Self.ClassName +']');
end;
{$ENDREGION}
procedure TFrmFirstPage.Btn_Get_Abstract_FuncClick(Sender: TObject);
begin
ShowMessage(Abstracted_Func);
end;
procedure TFrmFirstPage.Btn_Get_Abstract_ProcClick(Sender: TObject);
begin
Abstracted_Proc;
end;
end.
my Second Form:
unit USecondPage;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
UBaseForm,
Vcl.StdCtrls;
type
TFrmSecondPage = class(TBaseForm)
Lbl_Abst_Msg_Event: TLabel;
Lbl_1: TLabel;
Lbl_2: TLabel;
Lbl_3: TLabel;
Btn_Do_Abst_Proc: TButton;
Btn_Get_Abst_Func: TButton;
procedure Btn_Do_Abst_ProcClick(Sender: TObject);
procedure Btn_Get_Abst_FuncClick(Sender: TObject);
published
procedure Abstracted_Event(Sender: TObject); override;
procedure Abstracted_Proc; override;
function Abstracted_Func: string; override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmSecondPage: TFrmSecondPage;
implementation
{$R *.dfm}
{ TFrmSecondPage }
{$REGION ' Overridden Abstract Methodes ..'}
procedure TFrmSecondPage.Abstracted_Event(Sender: TObject);
begin
inherited;
Lbl_1.Font.Color := clBlue; Lbl_2.Font.Color := clGray; Lbl_3.Font.Color := clRed;
Lbl_Abst_Msg_Event.Caption := 'All this Properties can changed using [Abstracted_Event] | (Owner Form is: ['+ Self.ClassName +'])';
end;
function TFrmSecondPage.Abstracted_Func: string;
begin
Result := 'I''m Just an Override of Abstracted_Func ['+ Self.ClassName +']';
end;
procedure TFrmSecondPage.Abstracted_Proc;
begin
inherited;
ShowMessage('I''m Just an Override of Abstracted_Proc ['+ Self.ClassName +']');
end;
{$ENDREGION}
procedure TFrmSecondPage.Btn_Do_Abst_ProcClick(Sender: TObject);
begin
Abstracted_Proc;
end;
procedure TFrmSecondPage.Btn_Get_Abst_FuncClick(Sender: TObject);
begin
ShowMessage(Abstracted_Func);
end;
end.
my third Form:
unit UThirdPage;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
UBaseForm,
Vcl.StdCtrls;
type
TFrmThirdPage = class(TBaseForm)
published
procedure Abstracted_Event(Sender: TObject); override;
procedure Abstracted_Proc; override;
function Abstracted_Func: string; override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmThirdPage: TFrmThirdPage;
implementation
{$R *.dfm}
{ TFrmThirdPage }
{$REGION ' Overridden Abstract Methodes ..'}
procedure TFrmThirdPage.Abstracted_Event(Sender: TObject);
begin
inherited;
// your Code Goes Here ..
// call this methode or fill it with code Not a Mandatory :)
// The Mandatory thing is to implement this Methodes Exactly where BASEFORM HAS & without Missing any one of them from the Base Class...
// Enjoy ...
end;
function TFrmThirdPage.Abstracted_Func: string;
begin
// your Code Goes Here ..
// call this methode or fill it with code Not a Mandatory :)
// Enjoy ...
end;
procedure TFrmThirdPage.Abstracted_Proc;
begin
inherited;
// your Code Goes Here ..
// call this methode or fill it with code Not a Mandatory :)
// Enjoy ...
end;
{$ENDREGION}
end.
my Main Form:
unit UMain;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.ExtCtrls,
// My Abstracted Views ..
UFirstPage,
USecondPage,
UThirdPage;
type
TFrmMain = class(TForm)
Pnl_ToolBar: TPanel;
Pnl_StatusBar: TPanel;
Btn_Previous: TButton;
Btn_Next: TButton;
Notebook_SubForms: TNotebook;
Pnl_First_PAGE: TPanel;
Pnl_Second_PAGE: TPanel;
Pnl_Third_PAGE: TPanel;
procedure FormCreate(Sender: TObject);
procedure Notebook_SubFormsPageChanged(Sender: TObject);
procedure Btn_NextClick(Sender: TObject);
procedure Btn_PreviousClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
uses
// My Abstracted Base Template ..
UBaseForm;
{$R *.dfm}
procedure TFrmMain.Btn_NextClick(Sender: TObject);
begin
case Notebook_SubForms.PageIndex of
0:begin
Notebook_SubForms.PageIndex := 1;
end;
1:begin
Notebook_SubForms.PageIndex := 2;
end;
2:begin
Notebook_SubForms.PageIndex := 0;
end;
end;
end;
procedure TFrmMain.Btn_PreviousClick(Sender: TObject);
begin
case Notebook_SubForms.PageIndex of
0:begin
Notebook_SubForms.PageIndex := 2;
end;
1:begin
Notebook_SubForms.PageIndex := 0;
end;
2:begin
Notebook_SubForms.PageIndex := 1;
end;
end;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
Get_SubForm(FrmFirstPage, TFrmFirstPage, Self, Pnl_First_PAGE);
end;
procedure TFrmMain.Notebook_SubFormsPageChanged(Sender: TObject);
begin
case Notebook_SubForms.PageIndex of
0:begin
Get_SubForm(FrmFirstPage, TFrmFirstPage, Self, Pnl_First_PAGE);
if Assigned(FrmSecondPage) then FreeAndNil(FrmSecondPage);
if Assigned(FrmThirdPage) then FreeAndNil(FrmThirdPage);
end;
1:begin
Get_SubForm(FrmSecondPage, TFrmSecondPage, Self, Pnl_Second_PAGE);
if Assigned(FrmFirstPage) then FreeAndNil(FrmFirstPage);
if Assigned(FrmThirdPage) then FreeAndNil(FrmThirdPage);
end;
2:begin
Get_SubForm(FrmThirdPage, TFrmThirdPage, Self, Pnl_Third_PAGE);
if Assigned(FrmSecondPage) then FreeAndNil(FrmSecondPage);
if Assigned(FrmSecondPage) then FreeAndNil(FrmSecondPage);
end;
end;
end;
end.
When Compile 0 error and 0 Warning..
Result:
link to download the whole demo from my Github Repo here.
the Demo can work Also in Delphi 7 (i test it) :)

Resources