Pascal 'this' reference - oop

I am starting to explore Pascal with an Object Oriented approach. I was wondering if there is a this or self reference to the current object? I have searched around for documentation but I have not come found an answer.
Edit
Through trial and error I found that you can use self. Now my question is can I achieve this (snippet below) without the compiler throwing a 'duplicate identifier error'?
constructor Employee.create(name:String; salary:Real);
begin
self.name := name;
self.salary := salary;
end;
I have a program below which creates 2 employees and displays their information
{$mode objfpc} // directive to be used for defining classes
{$m+} // directive to be used for using constructor
program EmployeeTest;
type
Employee = class
private
name:String;
salary:Real;
public
constructor create(name:String; salary:Real);
procedure setName(name:String);
function getName():String;
procedure setSalary(salary:Real);
function getSalary():Real;
procedure displayEmployee;
end;
var empl1,empl2:Employee;
constructor Employee.create(name:String; salary:Real);
begin
setName(name);
setSalary(salary);
end;
procedure Employee.setName(name:String);
begin
self.name := name;
end;
procedure Employee.setSalary(salary:Real);
begin
self.salary := salary;
end;
function Employee.getName():String;
begin
getName := self.name;
end;
function Employee.getSalary():Real;
begin
getSalary := self.salary;
end;
procedure Employee.displayEmployee;
begin
writeln('Name: ',getName,', Salary: $',getSalary:0:2);
end;
begin
empl1 := Employee.create('Bob', 75000);
empl2 := Employee.create('Joe', 50000);
empl1.displayEmployee();
empl2.displayEmployee();
readln; {pause}
end.

Didn't think that I would be answering my question.
Found the answer here.
You must use {$mode delphi} instead of {$mode objfpc} if you want to duplicate variable names inside nested functions.

Don't use the same name for a parameter and a property. Use the prefix A for a parameter.
Don't implement getter and setter methods. Use in Pascal the property keyword.
Use the prefix F for private fields.
Use the prefix T for a self defined type.
Here is an example for your class:
type
TEmployee = class(TObject)
private
FName: String;
FSalary:Real;
public
constructor Create(AName:String; ASalary:Real);
property Name: String read FName write FName;
property Salary: Real read FSalary write FSalary;
procedure DisplayEmployee;
end;
constructor TEmployee.Create(AName:String; ASalary:Real);
begin
inherited Create;
FName := AName;
FSalary := ASalary;
end;
procedure TEmployee.DisplayEmployee;
begin
WriteLn('Name: ', FName, ', Salary: $', FSalary:0:2);
end;

Related

Using Object Orientated subclasses in a separate form

I have created a factory unit that contains multiple subclasses for different functions.
FACTORY UNIT
//parent
type
TfactoryU = class(Tobject)
public
constructor create;
end;
//subclass 1
TFormPosition = class (TfactoryU)
private
fFormName:tform;
public
constructor create (formName:tform);
procedure centerForm(frm:tform);
end;
implementation
{ TfactoryU }
constructor TFormPosition.Create(formName:tform);
begin
Inherited Create;
fFormName:=formname;
end;
procedure TFormPosition.centerForm(frm:tform);
begin
frm.Left := (Screen.Width - frm.Width) div 2;
frm.Top := (Screen.Height - frm.Height) div 2;
end;
constructor TfactoryU.create;
begin
end;
However, I do not know how to call the subclass procedure from a different unit.
MAIN UNIT
procedure TfrmMERCH.FormActivate(Sender: TObject);
var
objfactoryU:TfactoryU;
begin
objfactoryU:=tformposition.create(frmmerch);
objfactoryU.centerForm(frmmerch);
The calling of the procedure centerForm is underlined in red.
centerForm() is not a member of TfactoryU, that is why you get an error when trying to call it via a TfactoryU variable. You need to use a type-cast to reach it, eg:
procedure TfrmMERCH.FormActivate(Sender: TObject);
var
objfactoryU: TfactoryU;
begin
objfactoryU := tformposition.create(frmmerch);
tformposition(objfactoryU).centerForm(frmmerch);
However, since both the declaration of objfactoryU and the call to the centerForm() method are in the same procedure, you should just change the declaration instead:
procedure TfrmMERCH.FormActivate(Sender: TObject);
var
objfactoryU: tformposition;
begin
objfactoryU := tformposition.create(frmmerch);
objfactoryU.centerForm(frmmerch);

Object within another Object not persisting between units Delphi

Sorry if this question is a duplicate but I couldn't find any solution to my problem anywhere...
The code below shows how I'm assigning values from a listview into an object that is a property of another object:
Main Unit:
procedure TForm1.SBCadClick(Sender: TObject);
var
Procedimento: TProcedimento;
Produto: TItemProcedimento;
item: TListViewItem;
begin
...
Procedimento := TProcedimento.Create;
for item in LVItensProcedimento.Items do
begin
Produto := TItemProcedimento.Create;
Produto.PRO_ID := item.Tag;
Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso'))
.Text.ToDouble;
Procedimento.AddPRC_Produtos(Produto);
Produto.DisposeOf;
end;
DM.gravaProcedimento(Procedimento); // from here we go into another unit to use its function, passing an object as a parameter
Before the command DM.gravaProcedimento(Procedimento); the produto is correctly being added to the TObjectList of TProcedimento, I can get its contents correctly with Procedimento.GetPRC_Produtos. But when I debug the next unit shown below, its getting random IDs that means its not being persisted from one unit to the other:
unit DM:
procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
produto: TItemProcedimento;
dura: string;
begin
...
produto := TItemProcedimento.Create;
for produto in Procedimento.GetPRC_Produtos do
begin
DM.FDQ.Append;
DM.FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID; // here the value gets a random ID like 45684 instead of the current item ID
DM.FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
DM.FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
DM.FDQ.Post;
end;
produto.DisposeOf;
DM.FDQ.ApplyUpdates;
DM.FDQ.Close;
end;
This is the class definition of my objects:
unit uClasses;
interface
uses
System.SysUtils, System.Types, Generics.Collections;
type
TItemProcedimento = class
private
FPRO_Nome: string;
FPRO_Tipo: integer;
FPRO_Custo: double;
FPRO_ID: integer;
FPRO_Rendimento: integer;
FPRO_Potencia: double;
FIPR_Uso: double;
procedure SetPRO_Custo(const Value: double);
procedure SetPRO_ID(const Value: integer);
procedure SetPRO_Nome(const Value: string);
procedure SetPRO_Rendimento(const Value: integer);
procedure SetPRO_Tipo(const Value: integer);
procedure SetPRO_Potencia(const Value: double);
procedure SetIPR_Uso(const Value: double);
public
constructor Create;
published
property PRO_Rendimento: integer read FPRO_Rendimento
write SetPRO_Rendimento;
property PRO_ID: integer read FPRO_ID write SetPRO_ID;
property PRO_Nome: string read FPRO_Nome write SetPRO_Nome;
property PRO_Tipo: integer read FPRO_Tipo write SetPRO_Tipo;
property PRO_Custo: double read FPRO_Custo write SetPRO_Custo;
property PRO_Potencia: double read FPRO_Potencia write SetPRO_Potencia;
property IPR_Uso: double read FIPR_Uso write SetIPR_Uso;
end;
TProcedimento = class
private
FPRC_Nome: string;
FPRC_Duracao: TDateTime;
FPRC_Preco: double;
FPRC_ID: integer;
FPRC_Consumo: double;
FPRC_Produtos: TObjectList<TItemProcedimento>;
procedure SetPRC_Consumo(const Value: double);
procedure SetPRC_Duracao(const Value: TDateTime);
procedure SetPRC_ID(const Value: integer);
procedure SetPRC_Nome(const Value: string);
procedure SetPRC_Preco(const Value: double);
public
constructor Create;
function GetPRC_Produtos: TObjectList<TItemProcedimento>;
procedure AddPRC_Produtos(const Value: TItemProcedimento);
procedure DelPRC_Produtos(const Value: TItemProcedimento);
procedure CleanPRC_Produtos;
published
property PRC_Preco: double read FPRC_Preco write SetPRC_Preco;
property PRC_Consumo: double read FPRC_Consumo write SetPRC_Consumo;
property PRC_ID: integer read FPRC_ID write SetPRC_ID;
property PRC_Nome: string read FPRC_Nome write SetPRC_Nome;
property PRC_Duracao: TDateTime read FPRC_Duracao write SetPRC_Duracao;
end;
implementation
{ TProcedimento }
procedure TProcedimento.CleanPRC_Produtos;
begin
if not Assigned(FPRC_Produtos) then
FPRC_Produtos := TObjectList<TItemProcedimento>.Create
else
FPRC_Produtos.Clear;
end;
constructor TProcedimento.Create;
begin
SetPRC_Consumo(0);
SetPRC_Duracao(0);
SetPRC_ID(0);
SetPRC_Nome('');
SetPRC_Preco(0);
end;
procedure TProcedimento.DelPRC_Produtos(const Value: TItemProcedimento);
begin
FPRC_Produtos.Delete(FPRC_Produtos.IndexOf(Value));
end;
function TProcedimento.GetPRC_Produtos: TObjectList<TItemProcedimento>;
begin
if Assigned(FPRC_Produtos) then
result := FPRC_Produtos
else
begin
CleanPRC_Produtos;
result := FPRC_Produtos;
end;
end;
procedure TProcedimento.SetPRC_Consumo(const Value: double);
begin
FPRC_Consumo := Value;
end;
procedure TProcedimento.SetPRC_Duracao(const Value: TDateTime);
begin
FPRC_Duracao := Value;
end;
procedure TProcedimento.SetPRC_ID(const Value: integer);
begin
FPRC_ID := Value;
end;
procedure TProcedimento.SetPRC_Nome(const Value: string);
begin
FPRC_Nome := Value;
end;
procedure TProcedimento.SetPRC_Preco(const Value: double);
begin
FPRC_Preco := Value;
end;
procedure TProcedimento.AddPRC_Produtos(const Value: TItemProcedimento);
begin
FPRC_Produtos.Add(Value);
end;
{ TItemProcedimento }
constructor TItemProcedimento.Create;
begin
SetPRO_Custo(0);
SetPRO_ID(0);
SetPRO_Nome('');
SetPRO_Tipo(0);
SetPRO_Rendimento(0);
end;
procedure TItemProcedimento.SetIPR_Uso(const Value: double);
begin
FIPR_Uso := Value;
end;
procedure TItemProcedimento.SetPRO_Custo(const Value: double);
begin
FPRO_Custo := Value;
end;
procedure TItemProcedimento.SetPRO_ID(const Value: integer);
begin
FPRO_ID := Value;
end;
procedure TItemProcedimento.SetPRO_Nome(const Value: string);
begin
FPRO_Nome := Value;
end;
procedure TItemProcedimento.SetPRO_Potencia(const Value: double);
begin
FPRO_Potencia := Value;
end;
procedure TItemProcedimento.SetPRO_Rendimento(const Value: integer);
begin
FPRO_Rendimento := Value;
end;
procedure TItemProcedimento.SetPRO_Tipo(const Value: integer);
begin
FPRO_Tipo := Value;
end;
end.
Any particular reason why this is happening? What am I doing wrong here?
The problem is that you are destroying the TItemProcedimento objects before gravaProcedimento() has a chance to use them.
You are calling Produto.DisposeOf() immediately after Procedimento.AddPRC_Produtos(Produto) exits, and also in gravaProcedimento(), too. DO NOT DO THAT!
AddPRC_Produtos() saves the original Produto object into a TObjectList, which takes ownership of the object (as TObjectList is set to OwnsObjects=True by default). That means the object will be destroyed automatically when it is removed from the list, which includes when the list is cleared or destroyed.
So, you need to get rid of your DisposeOf() calls completely.
Also, you need to get rid of the call to TItemProcedimento.Create in gravaProcedimento(), too. It does not belong there. All you are doing by that is creating a memory leak on non-ARC systems.
It seems you do not have a firm grasp of how Delphi object lifetimes actually work. You DO NOT need to call Create on an object variable before assigning an object instance to it. And you DO NOT need to call DisposeOf() on an object variable when you are doing using the variable, only when you are done using the object itself (which TObjectList will handle for you).
Try this instead:
procedure TForm1.SBCadClick(Sender: TObject);
var
Procedimento: TProcedimento;
Produto: TItemProcedimento;
item: TListViewItem;
begin
...
Procedimento := TProcedimento.Create;
try
for item in LVItensProcedimento.Items do
begin
Produto := TItemProcedimento.Create;
try
Produto.PRO_ID := item.Tag;
Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso')).Text.ToDouble;
Procedimento.AddPRC_Produtos(Produto);
// Produto.DisposeOf; // <-- DO NOT DO THIS HERE!!!
except
Produto.DisposeOf; // <-- DO THIS HERE INSTEAD, if AddPRC_Produtos fails!!!
raise;
end;
end;
DM.gravaProcedimento(Procedimento);
finally
Procedimento.DisposeOf; // <-- ADD THIS, if needed!!!
end;
end;
procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
produto: TItemProcedimento;
dura: string;
begin
...
// produto := TItemProcedimento.Create; // <- DO NOT DO THIS!!!
for produto in Procedimento.GetPRC_Produtos do
begin
FDQ.Append;
try
FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID;
FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
FDQ.Post;
except
FDQ.Cancel; // <-- ADD THIS!!!
raise;
end;
end;
// produto.DisposeOf; // <-- DO NOT DO THIS!!!
FDQ.ApplyUpdates;
FDQ.Close;
end;
You should not call Produto.DisposeOf in procedure TForm1.SBCadClick.
You are destroying the object you have just added..

Create object in 'with' statement without using a variable

var
UserName, NickName, UserID: string;
begin
with TStringList.Create do
begin
CommaText := 'ali,veli,4950';
UserName := x[0]; //what is x ? (x is Tstringlist.create)
NickName := x[1];
UserID := x[2];
end;
end;
If I use the below code, it works. But I don't want to declare a variable. Can I use it with any variable?
In the with statement, how can I use it?
var
tsl: TStringList;
begin
tsl := TStringlist.Create;
with tsl do
begin
CommaText := 'ali,veli,4950';
UserName := tsl[0];
NickName := tsl[1];
UserID := tsl[2];
end;
end;
When an object is created directly in a with statement, there is no syntax to refer to that object (unless it provides a member that refers to itself, which is very rare), so you typically must use a variable, as your bottom code does.
Also, both codes are leaking the TStringList object, as you are not calling Free() on it when you are done using it.
That being said, in this particular example, the [] operator is just shorthand for accessing the TStrings.Strings[] default property, which you can access without needing a variable to the created TStringList object, just like you are doing with the TStrings.CommaText property, eg:
var
UserName, NickName, UserID: string;
Begin
with TStringList.Create do
try
CommaText := 'ali,veli,4950';
UserName := Strings[0];
NickName := Strings[1];
UserID := Strings[2];
finally
Free;
end;
end;

Generic mechanism for instantiating distinct types in Delphi

I'm trying to use generics to 'genericize' a var that instantiates network transports of different types. I'm not sure if the "generic=no RTTI" rule would invalidate the approach or not, as I'm not yet up to speed with generics.
I've read this post:
What is the correct way to structure this generic object creation , which states the following in the question:
One other thing I would like to do if possible, is to change two
creations:
LAdapter := TSQLiteNativeConnectionAdapter.Create(LFilename)
LAdapter := TFireDacConnectionAdapter.Create(FDatabaseLink.FConnection as TFDConnection, FDatabaseLink.OwnedComponent)
to use an abstract "GetAdapterClass" type function in the parent
TModelDatabaseConnection and just declare the class of adapter in the
child to do something like:
LAdapter := GetAdapterClass.Create...
This is exactly what I would like to do as well. So if you can picture this:
type
TTransport<T> = class(TComponent)
private
...
function GetTransport: TTransport;
procedure SetTransport(AValue: TTransport);
...
public
...
property Transport: TTransport read GetTransport write SetTransport;
...
end;
TTCPIPTransport = class(TTransport<T>)
private
function GetSocket(Index: Integer): String;
procedure SetSocket(Index: Integer; AValue: String);
public
property Socket[Index: Integer]: String read GetSocket write SetSocket;
end;
TServiceTransport = class(TTransport<T>)
private
function GetServiceName: String;
procedure SetServiceName(AValue: String);
public
property ServiceName: String read GetServiceName write SetServiceName;
end;
TISAPITransport = class(TServiceTransport<T>);
THTTPSysTransport = class(TServiceTransport<T>)
private
function GetURL(Index: Integer): String;
procedure SetURL(Index: Integer; AValue: String);
public
property URL[Index: Integer]: read GetURL write SetURL;
end;
etc.
The idea is to create a base class that has all fields/properties/methods that are common to all transports, then have intermediate classes that contain fields/methods/properties that are common only to a certain subset of transports, then have the final version of each transport be specific to the type.
So when I call:
var
trans: TTransport<T> // or TTransport<TTCPIPTransport> etc.
begin
trans := TTransport<TTCPIPTransport>.Create(AOwner,....);
trans.Transport.Socket[0] := '127.0.0.1:8523';
OR
trans := TTransport<TISAPITransport>.Create(AOwner,...);
trans.Transport.ServiceName = 'Foo';
...
etc.
end;
or perhaps even more generic then that, but have each instance of trans - without typecasting - have properties/fields/methods that are specific to the subclass automagically show up.
This way I can have a config screen that allows an administrator to select the type of transport say in a combo box, the have that variable value set the type inside the <> in code, and one set of code handles creation of the object by it's type.
Is this possible using generics?
Here is my first (feeble) attempt at a class factory, never done this before. It works partially (generates the correct class) but isn't accessible as a distinct subclass of the base class without typecasting, which defeats the purpose. Please see inline comments
TWSTransport = class(TComponent)
...
public
constructor Create(AOwner: TComponent); virtual;
....
end;
TWSTransportClass = Class of TWSTransport;
TWSTCPIPTransportClass = class of TWSTCPIPTransport;
TWSHTTPSysTransport = class(TWSServiceTransport);
TWSServiceTransport = class(TWSTransport);
TWSTransportStringConversion = class(TWSTransport);
TWSTransportStreamFormat = class(TWSTransportStringConversion);
TTransportFactory = class(TClassList)
private
function GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
public
procedure RegisterTransportClass(ATransportClass: TWSTransportClass);
property Transport[Index: TWSTransportClass; AOwner: TkbmMWServer]: TWSTransportClass read GetTransport;
end;
function TTransportFactory.GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
begin
if IndexOf(Index) > -1 then
Result := TWSTransportClass(Items[IndexOf(Index)])
else
Result := TWSTransportClass(Index.Create(AOwner));
end;
procedure TTransportFactory.RegisterTransportClass(ATransportClass: TWSTransportClass);
var
index: Integer;
begin
// is the transport registered?
index := IndexOf(ATransportClass);
if index < 0 then
// the transport is not registered, add it to the list
Add(ATransportClass);
end;
initialization
factory := TTransportFactory.Create;
factory.RegisterTransportClass(TWSHTTPSysTransport);
factory.RegisterTransportClass(TWSISAPIRESTTransport);
factory.RegisterTransportClass(TWSTCPIPTransport);
finalization
FreeAndNil(factory);
end.
Here's how I tested it:
procedure TForm4.FormCreate(Sender: TObject);
var
//trans: TWSTCPIPTransport; // this doesn't work
trans: TWSTransport; // this works
begin
trans := factory.Transport[TWSTCPIPTransport,Self];
showmessage(trans.classname); // this shows the correct classname - TWSTCPIPTransport
trans.AddSocket('127.0.0.1:80'); // the compiler gives an error here because this call is specific to a subclass of TWSTransport, TWSTCPIPTransport.
end;
So I'm still missing something... anyone see the mistake?

Delphi class variables

I have the following code:
// irrelevant code ...
type
Zombie = class
private
...
Age : Integer;
Alive : Boolean;
TotalDeadZombies, TotalZombieAge : Double;
public
...
procedure ZombieGrow();
procedure CheckIfDead();
...
Function AvgLife() : Double;
end;
procedure Zombie.ZombieGrow();
begin
...
if (Alive = false) then
begin
TotalDeadZombies := TotalDeadZombies + 1;
TotalZombieAge := TotalZombieAge + Age;
end;
end;
procedure Zombie.CheckIfDead();
begin
if Random(100) < 20 then
Alive := False;
end;
function Zombie.AvgLife() : Double;
begin
Result := TotalZombieAge / TotalDeadZombie;
end;
The problem I have is I want to display the average age of dead zombies. This would be done via something like :
Write('Average age '+Floattostr(Round(AvgLife)))
However, this is called in another class (not shown here), and from my understanding of OOP, it would require me to specify an instantiated object, e.g zombies[1].AvgLife if they were stored in, say, a Zombies[] array (just an example).
Is there a way of making it so the variables TotalDeadZombies and TotalZombieAge are not tied to any instantiated zombies, but rather to a class variable that I can then just call AvgLife somehow? Is it as simple as just making them global variables? Or can it be done another way?
You just have to declare the variables as class var; then they belong to the class, and not to a particular instance of a class.
type
TZombie = class
public
class var TotalDeadZombies, TotalZombieAge: Double;
end;
You can access these like TZombie.TotalDeadZombies. Similarly, there are class methods, class properties, etc.
Have a look at the official documentation.