I want to extend TApplication by adding extra methods, variables, and code to be initialized in the constructor.
Deriving my own class from TApplication won't work, obviously, because the global VAR Application is declared (Vcl.Forms) and instantiated (VclControls.InitControls) as TApplication. Obviously, I will try to stay away from hacking and recompiling that unit.
There is a post on SO that might seem similar, but it is not because the owner of the post wants to override the TApplication for a whole different reason.
The class declaration would be something like (work in progress):
TYPE
TAppData= class(TObject)
private
FAppName: string;
FLastFolder: string; { used by AppLastUsedFolder } //todo: reaname to FLastFolder
function getLastUsedFolder: string;
public
Initializing: Boolean; { Used in cvIniFile.pas. Set it to false once your app finished initializing. }
constructor Create(aAppName: string);
{--------------------------------------------------------------------------------------------------
App path/name
--------------------------------------------------------------------------------------------------}
function AppDir : string;
function SysDir : string;
function AppDataFolder(ForceDir: Boolean= FALSE): string;
function AppDataFolderAllUsers: string;
function AppShortName: string;
property AppName: string read FAppName;
property LastUsedFolder: string read getLastUsedFolder write FLastFolder;
{--------------------------------------------------------------------------------------------------
App Control
--------------------------------------------------------------------------------------------------}
function RunningFirstTime: Boolean;
procedure Restart;
procedure SelfDelete;
procedure Restore;
function RunSelfAtWinStartUp(Active: Boolean): Boolean;
function RunFileAtWinStartUp(FilePath: string; Active: Boolean): Boolean; { Porneste anApp odata cu windows-ul }
{-------------------------------------------------------------------------------------------------
APPLICATION Version
--------------------------------------------------------------------------------------------------}
function GetVersionInfoV : string; { MAIN. Returns version without Build number. Example: v1.0.0 }
function GetVersionInfo(ShowBuildNo: Boolean= False): string;
function GetVersionInfoMajor: Word;
function GetVersionInfoMinor: Word;
function GetVersionInfo_: string;
function getVersionFixedInfo(CONST FileName: string; VAR FixedInfo: TVSFixedFileInfo): Boolean;
{--------------------------------------------------------------------------------------------------
BetaTester tools
--------------------------------------------------------------------------------------------------}
function RunningHome: Boolean;
function BetaTesterMode: Boolean;
function IsHardCodedExp(Year, Month, Day: word): Boolean;
end;
I thought of a Class Helper but I need to initialize stuff in the constructor:
constructor TAppData.Create(aAppName: string);
begin
inherited Create;
Initializing:= True; { Used in cvIniFile.pas. Set it to false once your app finished initializing. }
FAppName:= aAppName;
FRunningFirstTime:= NOT FileExists(IniFile);
ForceDirectories(AppDataFolder);
//ToDo: !!!!!!!!!!!!!!!!!!!!!!!! CreateLogForm; But this will create dependencies on the Log!
end;
Related
In C++, you can explicitly define a unique specialization for a templated function, like (to steal an example)
// A generic sort function
template <class T>
void sort(T arr[], int size)
{
// code to implement Quick Sort
}
// Template Specialization: A function
// specialized for char data type
template <>
void sort<char>(char arr[], int size)
{
// code to implement counting sort
}
Is there a way to do the equivalent with Delphi generic methods? When I try
function TryStrConv<T>(S: string; var Val: T): boolean;
function TryStrConv<float>(S: string; var Val: float): boolean;
I get warnings about how I have to use the Overload directive.
What I'm hoping to get is a way to write a generic TryStrConv where the default instantiation returns false and does nothing, while the int and float instantiations, which I want to provide explicitly, use TryStrToInt and TryStrToFloat. Alternatively, if there's a generic conversion facility in Delphi that I'm missing, I'd like to get pointed at it.
Thanks.
You cannot at declaration already fill the generic argument. You either overload with one generic method and one without being generic like this:
function TryStrConv<T>(S: string; var Val: T): boolean; overload;
function TryStrConv(S: string; var Val: Extended): boolean; overload;
But need to be aware that it only picks the non generic one for Extended and not the other floating point types Delphi has like Double or Single.
Another way can be if you are on a version of Delphi XE7 or higher to use the new intrinsic functions to branch the generic methods implementation (it gets resolved at compiletime and the non executed path gets eliminated). It could for example look like this (I omitted the type of the TryStrConv method but you know in Delphi you cannot have generic standalone routines but they have to be methods of some type even if just static):
function TryStrConv<T>(S: string; var Val: T): boolean;
begin
if GetTypeKind(T) = tkFloat then
begin
// do stuff with val being a float type, still need to handle the different float types though
case GetTypeData(TypeInfo(T)) of
ftDouble: DoStuffWithDouble;
// if you need to pass Val here you might need to do some pointer
// ref/deref hardcasts like PDouble(#Val)^ because otherwise you
// are not allowed to cast type T to Double (or any other type)
....
end;
else
Result := False;
end;
You can do something similar like this:
Type
TCalc = record
class function TryStrConv(S: string; var Val: Double): boolean; overload; static;
class function TryStrConv(S: string; var Val: integer): boolean; overload; static;
class function TryStrConv<T>(S: string; var Val: T): boolean; overload; static;
end;
{ TCalc }
class function TCalc.TryStrConv(S: string; var Val: Double): boolean;
begin
Result := TryStrToFloat(s,Val);
end;
class function TCalc.TryStrConv(S: string; var Val: integer): boolean;
begin
Result := TryStrToInt(S,Val);
end;
class function TCalc.TryStrConv<T>(S: string; var Val: T): boolean;
begin
Result := false;
end;
And testing:
var
iVal : Integer;
dVal : Double;
sVal : String;
ok : Boolean;
begin
ok := TCalc.TryStrConv('12',iVal);
WriteLn(ok,' ',iVal); // True 12
ok := TCalc.TryStrConv('12',dVal);
WriteLn(ok,' ',dVal); // True 1.2 E+1
ok := TCalc.TryStrConv('12',sVal);
WriteLn(ok,' ',sVal); // False
ReadLn;
end.
As Stefan says: You will have to write a specific function for each of the float types.
I admit I'm not a Delphi expert, so I need some advice.
I have a pre-built class with this definition
TS7Helper = class
private
function GetInt(pval: pointer): smallint;
procedure SetInt(pval: pointer; const Value: smallint);
function GetWord(pval: pointer): word;
procedure SetWord(pval: pointer; const Value: word);
function GetDInt(pval: pointer): longint;
procedure SetDInt(pval: pointer; const Value: longint);
function GetDWord(pval: pointer): longword;
procedure SetDWord(pval: pointer; const Value: longword);
function GetDateTime(pval: pointer): TDateTime;
procedure SetDateTime(pval: pointer; const Value: TDateTime);
function GetReal(pval: pointer): single;
procedure SetReal(pval: pointer; const Value: single);
function GetBit(pval: pointer; BitIndex: integer): boolean;
procedure SetBit(pval: pointer; BitIndex: integer; const Value: boolean);
public
procedure Reverse(pval : pointer; const S7Type : TS7Type);
property ValBit[pval : pointer; BitIndex : integer] : boolean read GetBit write SetBit;
property ValInt[pval : pointer] : smallint read GetInt write SetInt;
property ValDInt[pval : pointer] : longint read GetDInt write SetDInt;
property ValWord[pval : pointer] : word read GetWord write SetWord;
property ValDWord[pval : pointer] : longword read GetDWord write SetDWord;
property ValReal[pval : pointer] : single read GetReal write SetReal;
property ValDateTime[pval : pointer] : TDateTime read GetDateTime write SetDateTime;
end;
Var
S7 : TS7Helper;
procedure TS7Helper.SetInt(pval: pointer; const Value: smallint);
Var
BW : packed array[0..1] of byte absolute value;
begin
pbyte(NativeInt(pval)+1)^:=BW[0];
pbyte(pval)^:=BW[1];
end;
(I cut some code, so don't look for the implementation clause, etc... the helper class is compiling ok....)
Trivially, I want to invoke the SetInt property (as stated in the class documentation)... but the following code gives me an error "Cannot access private symbol TS7Helper.SetInt".
S7.SetInt(#MySnap7Array[i * 2], gaPlcDataScrittura[i]);
What am I doing wrong ?
SetInt and GetInt is the getter and setter for ValInt property as stated in the definition of ValInt. So you shoud use S7.ValInt like
S7.ValInt[#MySnap7Array[i * 2]] := gaPlcDataScrittura[i];
In Delphi,
A private member is invisible outside of the unit or program where its class is declared.
Note: "program" refers to files starting with program keyword (usually the .dpr file), not to the project as a whole.
So you can only call TS7Helper.SetInt from the same unit where TS7Helper class is declared.
Otherwise, #DmLam answer is the correct way to solve it.
Indeed there is a lot of stuff online about this but more I read more confuse I am. I have written a component called Combinatorics that does some math probability stuff. The code is pretty short and easy because I don't want it to be complicated. I am doing a little preview here:
//Combinatorio.pas
type
ICombinatorio = interface
function getSoluzioni(): integer; //soluzioni means "Solutions"
function getFormula(): string;
end;
//ImplCombinatorio.pas
type
TCombinazioni = class(TInterfacedObject, ICombinatorio)
private
n, k: integer;
ripetizione: boolean;
function fattoriale(const x: integer): integer;
public
constructor Create(const n, k: integer; const ripetizione: boolean);
function getSoluzioni(): integer;
function getFormula(): string;
end;
TDisposizioni = class(TInterfacedObject, ICombinatorio)
private
n, k: integer;
ripetizione: boolean;
function fattoriale(const x: integer): integer;
public
constructor Create(const n, k: integer; const ripetizione: boolean);
function getSoluzioni(): integer;
function getFormula(): string;
end;
TPermutazioni = class(TInterfacedObject, ICombinatorio)
private
n: integer;
k: string;
ripetizione: boolean;
function fattoriale(const x: integer): integer;
public
constructor Create(const n: integer; const k: string; ripetizione: boolean);
function getSoluzioni(): integer;
function getFormula(): string;
end;
You don't need to see how functions and procedures are implemented, it's not important for the question (and you can easily imagine what they do).
This is my first component ever, I have compiled and installed it and it works. However I cannot understand something.
unit TCombinatorio;
interface
uses
System.SysUtils, System.Classes, Combinatorio, ImplCombinatorio;
type
cCombinatorio = (cNull = 0, cDisposition = 1, cPermutation = 2, cCombination = 3);
type
TCombinatorics = class(TComponent)
strict private
{ Private declarations }
Fn, Fk: integer;
FRep: boolean;
FType: cCombinatorio;
FEngine: ICombinatorio;
procedure Update;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
function getSolution: integer;
function getFormula: string;
published
property n: integer read Fn write Fn;
property k: integer read Fk write Fk;
property kind: cCombinatorio read FType write FType default cNull;
property repetitions: boolean read FRep write FRep;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('RaffaeleComponents', [TCombinatorics]);
end;
{ TCombinatorics }
constructor TCombinatorics.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Fn := 0;
Fk := 0;
FType := cNull;
repetitions := false;
end;
function TCombinatorics.getFormula: string;
begin
Update;
Result := FEngine.getFormula;
end;
function TCombinatorics.getSolution: integer;
begin
Update;
Result := FEngine.getSoluzioni;
end;
procedure TCombinatorics.Update;
begin
case FType of
cDisposition:
FEngine := TDisposizioni.Create(n, k, repetitions);
cPermutation:
FEngine := TPermutazioni.Create(n, '', repetitions);
cCombination:
FEngine := TCombinazioni.Create(n, k, repetitions);
cNull:
raise Exception.Create('You have to select a type.');
end;
end;
end.
Look at the Update; procedure. I have created that because when the user drops the component ( link ) in the form he has to setup in the object inspector (or with the code somewhere) 3 important parameters required in the constructor.
Since FEngine: ICombinatorio I can assign to it a class (TCombinazioni, TDisposizioni or TPermutazioni) without try finally because there is the ref count mechanism. I am not sure if I have coded this properly. Suppose that:
The user selects cDisposition and does a calculation
The user selects cDisposition (different values) and does a calculation
The user selects cPermutation and does a calculation
I am always working on the FEngine. How does the ref count go to zero? Does it go to zero when the form (and the component) destroys? I hope I have explained well what I don't understand. The FEngine is a private variable and I assing to it at runtime different classes (calling the Create). Does the ref count go to 0 when the form destroys or when a new class is assigned?
I coded it like above because nick hodges did that in his book and I trust him of course but I'd like to know what I do.
Based on the code that can be seen, the first time Update is called, a new implementor of ICombinatorio is created and assigned to FEngine; the reference count will be 1. The following times that Update is called, another new instance of ICombinatorio implementor will be created (its reference count will be 1) and is assigned to FEngine. The previous implementor instance that FEngine pointed to will have its reference count decremented; if it is zero, then it will be destroyed. (It probably will be based on your code sample).
Also, when the destructor of the component is called (when the owning Form is destroyed), the implicit instance clean-up code will set FEngine to nil, which will decrement the reference count (and, based on your sample, will be destroyed).
So, based on your code sample, I would expect your code will work properly; cleanly instanciating and destroying the ICombinatorio interfaced objects.
I have a class I want to pass to a datasnap server, but the class contains this field Picture which should be a TPicture but for now I use an integer to avoid getting the marshall error "tkPointer currently not supported" :(
I have tried omitting a field/property "Picture" from getting marshalled by adding [JSONMarshalled(False)] but with no luck.
I have added the units as suggested in the thread here
JSONMarshalled not working in Delphi
unit TestObjU;
interface
uses
Classes, System.Generics.Collections, System.SyncObjs, System.SysUtils,
JSON, DBXJsonReflect, REST.JSON,
Data.FireDACJSONReflect, FireDAC.Comp.Client, vcl.ExtCtrls,
pngimage, graphics, variants,
GlobalFunctionsU, GlobalTypesU;
{$M+}
{$RTTI EXPLICIT FIELDS([vcPrivate])}
type
EPerson = class(Exception);
EPersonsList = class(Exception);
TGender = (Female, Male);
TPerson = class(TObject)
private
FFirstName: string;
FLastName: string;
FId: Integer;
FGender: TGender;
FModified : Boolean;
[JSONMarshalled(False)]
FPicture: Integer;
// [JSONMarshalled(False)] FPicture : TPicture;
function GetName: string;
procedure SetFirstName(const Value: string);
procedure SetLastName(const Value: string);
function GetId: Integer;
procedure SetGender(const Value: TGender);
procedure SetModified(const Value: Boolean);
public
property Id : Integer read GetId;
property Name : string read GetName;
property FirstName : string read FFirstName write SetFirstName;
property LastName : string read FLastName write SetLastName;
property Gender : TGender read FGender write SetGender;
property Modified : Boolean read FModified write SetModified;
// property Picture : TPicture read FPicture write FPicture;
[JSONMarshalled(False)]
property Picture : Integer read FPicture write FPicture;
function Update : Boolean;
function Delete : Boolean;
constructor Create(AId : Integer; AFirstName, ALastName : string; AGender : TGender); overload;
constructor Create(AFirstName, ALastName : string; AGender : TGender); overload;
destructor destroy; override;
function ToJsonString: string;
end;
But clearly it has no effect on the marshalling, Picture is still there - what am I missing?
function TPerson.ToJsonString: string;
begin
result := TJson.ObjectToJsonString(self);
end;
08-03-2016 10:26:24 [NORMAL] AddPerson serialized {"firstName":"Donald","lastName":"Duck","id":24,"gender":"Female","modified":false,"picture":92415648}
You are using TJson.ObjectToJsonString from REST.Json unit and that one needs different attribute to skip fields named JSONMarshalledAttribute
You should change your code to [JSONMarshalledAttribute(False)]
Delphi has a bit of mix up between older Data.DBXJsonReflect and newer REST.Json units and you should not mix them together in same code. Pick only one of them.
REST.Json.TJson.ObjectToJsonString
REST.Json.Types.JSONMarshalledAttribute
Data.DBXJSONReflect.JSONMarshalled
Yes - I found the solution, when using DBX (and not REST) you'll need add this unit "Data.DBXJSON" rather than the "REST.JSON" and change the two "from/to" methods for un/marshaling the object something like this.
NOTE. ToJSONString leaks for some reason, I'll have to investigate that more.
function TPerson.ToJsonString: string;
var
JSONMarshal: TJSONMarshal;
begin
result := '';
JSONMarshal := TJSONMarshal.Create(TJSONConverter.Create);
try
Result := JSONMarshal.Marshal(self).ToString;
finally
JSONMarshal.Free;
end;
end;
class function TPerson.FromJsonString(AJSONString: string): TPerson;
var
JSONUnMarshal: TJSONUnMarshal;
begin
JSONUnMarshal := TJSONUnMarshal.Create;
try
Result := JSONUnMarshal.Unmarshal(TJSONObject.ParseJSONValue(AJSONString)) as TPerson;
finally
JSONUnMarshal.Free;
end;
end;
I'm an newbee concerning interfaces. I googled a lot but i can't figure out what to do in the following situation.
i created serveral interfaces, which use each other:
IPart = interface(IInterface)
Function getName: string;
procedure setName(aValue: string)
property Name: string read getName write setname;
end;
IOfferLine= interface(iInterface)
Function getPart: IPart;
function getAmount: double;
procedure setPart(aPart: IPart);
procedure setAmount(value: double);
property Amount: double read getAmount write setAmount;
property Part: IPart read GetPart write setPart;
end;
IOffer= interface(iInterface)
function getOffLines: tList<IOfferline>;
procedure setOffLines(aList: tList<IOfferline>);
property OffLines: tList<IOfferlines> read getOffLines write setOfflines;
end;
Now i want to implement those interface.
TPart = class(TInterfacedObject, IPart)
private
_Name: string;
function getName: string;
procedure setName(aValue: string);
public
property Name: string read getName write setName;
end;
TOfferLine = class(TInterfacedObject, IOfferLine)
private
_amount: double;
_part: TPart;
function getAmount: double;
function getPart: tPart;
procedure setAmount(aValue: double);
procedure setPart(aPart: TPart);
public
property Amount: double read getAmount write setAmount;
property Part: TPart read GetPart write SetPart;
end;
TOffer = class(TInterfacedObject, IOffer)
private
_OfferLines: tList<TOfferline>;
function getOffLines: tList<tOfferline>;
procedure setOffLines(aList: tList<tOfferline>);
public
property offLines: tList<TOfferline> read getOffLines write setOffLines;
end;
I have added the implementation.
function TOfferLine.getPart: tPart;
begin
result := _part;
end;
But i still get 'Missing implementation of interface method IOfferline.GetPart;'
And i Can't figure out why.
I dont know what you are trying to to but if you didn't write you code so messy it would be easier to read. But thank God we have a Source formatter.
There are seval problems in you code:
First You have your property declared as property OffLines: TList<IOfferline**s**> while your interface is named IOfferline
Then TOfferline you have a method procedure setPart(aPart: TPart); that should be procedure setPart(aPart: IPart); because thats how you declared your interface. And all the other places where you Use TPart should be IPart.
And the same goes for TOffer
Here is a cleaned up version of your code :
unit Unit20;
interface
uses
Generics.Collections;
type
IPart = interface(IInterface)
function getName: string;
procedure setName(aValue: string);
property Name: string read getName write setName;
end;
IOfferLine = interface(IInterface)
function getPart: IPart;
function getAmount: double;
procedure setPart(aPart: IPart);
procedure setAmount(value: double);
property Amount: double read getAmount write setAmount;
property Part: IPart read getPart write setPart;
end;
IOffer = interface(IInterface)
function getOffLines: TList<IOfferLine>;
procedure setOffLines(aList: TList<IOfferLine>);
property OffLines: TList < IOfferLine > read getOffLines write setOffLines;
end;
TPart = class(TInterfacedObject, IPart)
private
_Name: string;
function getName: string;
procedure setName(aValue: string);
public
property Name: string read getName write setName;
end;
TOfferline = class(TInterfacedObject, IOfferLine)
private
_amount: double;
_part: TPart;
function getAmount: double;
function getPart: IPart;
procedure setAmount(aValue: double);
procedure setPart(aPart: IPart);
public
property Amount: double read getAmount write setAmount;
property Part: IPart read getPart write setPart;
end;
TOffer = class(TInterfacedObject, IOffer)
private
_OfferLines: TList<TOfferline>;
function getOffLines: TList<IOfferLine>;
procedure setOffLines(aList: TList<IOfferLine>);
public
property OffLines: TList < IOfferLine > read getOffLines write setOffLines;
end;
implementation
{ TOfferline }
function TOfferline.getAmount: double;
begin
end;
function TOfferline.getPart: IPart;
begin
end;
procedure TOfferline.setAmount(aValue: double);
begin
end;
procedure TOfferline.setPart(aPart: IPart);
begin
end;
{ TOffer }
function TOffer.getOffLines: TList<IOfferLine>;
begin
end;
procedure TOffer.setOffLines(aList: TList<IOfferLine>);
begin
end;
{ TPart }
function TPart.getName: string;
begin
end;
procedure TPart.setName(aValue: string);
begin
end;
end.
The reason the compiler is saying that the implementation is missing is simply because the implementation is missing.
Your interface for IOfferLine declares this getPart method:
IOfferLine= interface(iInterface)
..
function getPart: IPart;
..
end;
But your implementing class does not provide this method. The getPart method in your class is implemented to return an object reference, not an interface reference:
TOfferLine = class(TInterfacedObject, IOfferLine)
private
..
function getPart: tPart;
..
end;
You need to ensure that your implementing class actually provides the members required by the interfaces that it implements, exactly and precisely:
TOfferLine = class(TInterfacedObject, IOfferLine)
private
..
function getPart: IPart;
..
end;
function TOfferline.getPart: IPart;
begin
result := _part as IPart;
end;
However, since the reference to the Part maintained by the OfferLine object (in the _part variable) is an object reference, then references to that object obtained using interfaces (via the getPart: IPart method) could result in that Part object being destroyed since the object reference in OfferLine is not counted (literally).
You can of course avoid this by making the Part reference held by OfferLine an interface reference itself, but whether this is valid is difficult to say with out a complete picture of your entire object model. If the lifetimes of your objects are ensured by some other mechanism not apparent from the question then it may not be an issue, but if it is not something that has been specifically considered thus far then it probably does need addressing.
Although it is possible to do safely, as a general rule mixing object references and interface references to the same objects is a recipe for problems.