I need to call an event handler to tell a user to select a TCard or TLabel
and then return this value as a parameter.
I have two units GAME , SS_SPELL
This is how the code in SS_SPEll works.
// TSPELL
// ======
// The chronology is:
// 1. At appropriate points in the game (such as before turn, after cast etc aka trigger points)
// the game calls the SpellMeister's RunSpells method.
// 2. RunSpells checks the database for spells matching the card that
// initiated the spell action, and the trigger point at which it did so.
// For each one that it finds it will create an appropriate object, which
// could be a TSpell descendent or a TSpellAdjuster descendent.
// For each TSpell it finds it fires off an onFindSpell event.
// See below for details of how TSpellAdjusters are handled.
// 3. The handler for the onFindSpell events can (should) call the spells'
// AimAt method for each potential target. A potential target is a card
// or a player.
// 4. A spell's AimAt method checks if the potential target is a legitimate
// target for that spell and if so it calls its ApplySpellTo method to
// actually do the dirty deed.
So what i need is once the RunSpells gets the db info it will check if needs2ndtarget := 1 , if so then i know i need a second target for this spell.
Here is TSpellBase it is the class TSpell is created from. In an attampt to create this event i have added FOnSeek2ndTarget
in the privite section and FNeed2Target in the Protected and the public property OnSeek2ndTarget. You will also see
the TTargetEvt, currently its setup to recive TCARD but i need it to recive TCard or TLAbel no idea how to do this.
TTargetEvt = procedure (Card : TCard) of Object;
TSpellBase = class
private
FOnManaChange: TManaEvt;
FOnSeek2ndTarget: TTargetEvt;
protected
FCardType : TCardType;
FOriginator : TCard;
FNeed2Target : integer;
function LegitimateTarget (Candidate : TObject) : boolean; virtual;
public
constructor Create; virtual;
property CardType : TCardType read FCardType write FCardType; // ctLava, ctNature, ctWizard, etc etc
property Originator : TCard read FOriginator write FOriginator;
property Need2Target : integer read FNeed2Target write FNeed2Target;
property OnManaChange : TManaEvt read FOnManaChange write FOnManaChange;
property OnSeek2ndTarget : TTargetEvt read FonSeek2ndTarget write FOnSeek2ndTarget;
end;
Now in TSpell , i dont think i need anything chnaged here but its needed for the spellmiester.runspell procedure
TSpell = class(TSpellBase)
private
protected
FCategory : TCategory;
FLifeToAdd : Byte;
FMaxRandom : Byte;
FReplaceDmg : Byte;
FReplacement : string;
FStatTarget : Byte;
FTrigger : TTrigger;
procedure ApplySpellTo(Target : TObject); virtual; abstract; // Apply the spell to the target
public
procedure AimAt(Candidate: TObject); virtual;
property Category : TCategory read FCategory write FCategory;
property LifeToAdd : Byte read FLifeToAdd write FLifeToAdd;
property MaxRandom : Byte read FMaxRandom write FMaxRandom;
property ReplaceDmg : Byte read FReplaceDmg write FReplaceDmg;
property Replacement : string read FReplacement write FReplacement;
property StatTarget : Byte read FStatTarget write FStatTarget;
property Trigger : TTrigger read FTrigger write FTrigger;
end;
Here i added the FOnSeek2ndTarget in private section. and the property So now when a spell is casted it will
get to here and now calls runsspells.
TSpellMeister = class
private
FonFindSpell : TRcvSpell;
FOnManaChange : TManaEvt;
FOnSeek2ndTarget : TTargetEvt;
// FonNewAdjuster : TRcvSpell;
protected
FAdjusters : TAdjusters;
FQuery : TADOQuery;
public
constructor Create(DBCon: TADOConnection);
destructor Destroy; override;
function IfNull( const Value, Default : OleVariant ) : OleVariant;
procedure Adjust(Attacker : TCard; Victim : TObject; var TheDamage : integer); overload;
procedure Adjust(Attacker : TCard; var TheCost : integer); overload;
procedure RunSpells(Card : TCard; Trigger : TTrigger);
property onFindSpell : TRcvSpell read FonFindSpell write FonFindSpell;
property OnManaChange : TManaEvt read FOnManaChange write FOnManaChange;
property OnSeek2ndTarget: TTargetEvt read FOnSeek2ndTarget write FOnSeek2ndTarget;
// property onNewAdjuster : TRcvSpell read FonNewAdjuster write FonNewAdjuster;
end;
This is where the issue is, i added foundspell.Need2ndTarget this gets data from database if it is a 1 then it needs the user to select another target for the spell. Currently i added
if FoundSpell.Need2Target = 1 then
FOnSeek2ndTarget(Card);
but i am sure that is not correct...
//**************************************************************************
procedure TSpellMeister.RunSpells(Card: TCard; Trigger: TTrigger);
//**************************************************************************
var
OneSpell : TSpellBase;
FoundSpell : TSpell; // Just so only have to cast once
begin
assert(assigned(FonFindSpell),'TSpellMeister.RunSpells : No onFindSpell event handler!');
// Search the database
FQuery.Active := FALSE;
FQuery.Parameters.ParamByName(SQL_PARAM_SPELL_ORIGINATOR).Value := Card.CName;
FQuery.Parameters.ParamByName(SQL_PARAM_SPELL_TRIGGER ).Value := Trigger;
FQuery.Active := TRUE;
// Iterate through the spell records. For each one, create a category-specific
// TSpell descendant and fire off an onFindSpell event.
if FQuery.RecordCount > 0 then
begin
FQuery.Recordset.MoveFirst;
while not FQuery.Recordset.EOF do
begin
case TCategory(FQuery.Recordset.Fields[DB_FLD_CATEGORY].Value) of
caAboveLife : OneSpell := TSpellAboveLife.Create;
caDamage : OneSpell := TSpellDamage.Create;
caDamagePlus : OneSpell := TSpellDamagePlus.Create;
caDamagePlusPercent : OneSpell := TSpellDamagePlusPercent.Create;
caDamagePercentIncrease : OneSpell := TSpellDamagePercentIncrease.Create;
caDamagePercentDecrease : OneSpell := TSpellDamagePercentDecrease.Create;
caDamageSpells : OneSpell := TSpellDamageSpells.Create;
caDestroy : OneSpell := TSpellDestroy.Create;
.....
else raise ERangeError.CreateFmt(ERROR_INVALID_DB_NUMBER,[DB_FLD_CATEGORY,FQuery.Recordset.Fields[DB_FLD_CATEGORY].Value]);
end;
try
if assigned(OneSpell) then
begin
OneSpell.CardType := TCardType (IfNull( FQuery.Recordset.Fields[ DB_FLD_CARD_TYPE ].Value,0) );
OneSpell.Originator := Card;
OneSpell.OnManaChange := Self.OnManaChange;
OneSpell.OnSeek2ndTarget := self.OnSeek2ndTarget;
assert(OneSpell.Originator.COwner is TPlayer,'TSpellMeister.RunSpells : OneSpell.Originator.COwner not a player: ' + OneSpell.Originator.COwner.ClassName);
try
FoundSpell := TSpell(OneSpell);
FoundSpell.Originator := Card;
FoundSpell.Trigger := Trigger;
FoundSpell.CardType := TCardType ( FQuery.Recordset.Fields[ DB_FLD_CARD_TYPE ].Value );
FoundSpell.Category := TCategory ( FQuery.Recordset.Fields[ DB_FLD_CATEGORY ].Value );
FoundSpell.LifeToAdd := IfNull( FQuery.Recordset.Fields[ DB_FLD_LIFE_TO_ADD ].Value,0);
FoundSpell.MaxRandom := IfNull( FQuery.Recordset.Fields[ DB_FLD_MAX_RANDOM ].Value,0);
FoundSpell.PerCent := IfNull( FQuery.Recordset.Fields[ DB_FLD_PER_CENT ].Value,0);
FoundSpell.Plus := IfNull( FQuery.Recordset.Fields[ DB_FLD_PLUS ].Value,0);
FoundSpell.ReplaceDmg := IfNull( FQuery.Recordset.Fields[ DB_FLD_REPLACE_DMG ].Value,0);
FoundSpell.Replacement := IfNull( FQuery.Recordset.Fields[ DB_FLD_REPLACEMENT ].Value,0);
FoundSpell.StatTarget := IfNull( FQuery.Recordset.Fields[ DB_FLD_STAT_TARGET ].Value,0);
FoundSpell.Target := TTargetType( IfNull(FQuery.Recordset.Fields[ DB_FLD_TARGET ].Value,0) );
FoundSpell.Need2Target := IfNull( FQuery.Recordset.Fields[ DB_FLD_NEED2TARGET ].Value,0);
assert(FoundSpell.Originator.COwner is TPlayer,'TSpellMeister.RunSpells : FoundSpell.Originator.COwner not a player: ' + OneSpell.Originator.COwner.ClassName);
if FoundSpell.Need2Target = 1 then
FOnSeek2ndTarget(Card);
FonFindSpell(FoundSpell);
finally
FreeAndNil(OneSpell);
end;
end;
except // I think this is OK but is there a possible bug if
FreeAndNil(OneSpell); // spell adjuster added to list then destroyed?
end; // List item would then be invalid.
FQuery.Recordset.MoveNext;
end;
end;
end;
So all that is the ss_spells unit, now the game unit which uses ss_spells unit
in the forum.create i have
FSpellMeister.OnSeek2ndTarget := self.Handle2ndTarget;
with no idea what to put in Handle2ndTarget currently its just
//****************************************************************************
procedure TFGame.Handle2ndTarget(Card : TCard);
begin
showmessage('Select a target HANDLE2ndTARGET');
end;
just to see if i could at least get here..
So with this my question if you cant make it out, How do i set a var in ss_Spells to an TObject (tcard or tlabel) when the foundspell.Need2ndTarget := 1 using the event FOnSeek2ndTarget();
Simply change the signature of your TTargetEvt type, eg:
TTargetEvt = procedure (Card : TCard; var Target: TObject) of Object;
Then update RunSpells() accordingly:
var
Target: TObject;
...
if FoundSpell.Need2Target = 1 then
begin
Target := nil;
if Assigned(FOnSeek2ndTarget) then FOnSeek2ndTarget(Card, Target);
// use Target as needed...
end;
...
Then update your handler accordingly:
procedure TFGame.Handle2ndTarget(Card : TCard; var Target: TObject);
begin
Target := ...;
end;
I need to know how to use an event to return a var parameter.
Define your event like this:
type
TMyEvent = procedure(var ReturnValue: Integer) of object;
And then you add the event property in the usual way:
....
private
FOnMyEvent: TMyEvent;
....
published
property OnMyEvent: TMyEvent read FOnMyEvent write FOnMyEvent;
....
The nuance comes in how you surface the event. Generally, if you are writing a component that offers events, you must cater for the eventuality that there will be no handler attached to the event. And if the event is meant to return a value, how can you have no hander and also a returned value? The trick is to assign the parameter to the default, before you surface the event. For example:
procedure TMyComponent.DoMyEvent(out ReturnValue: Integer);
begin
Result := DefaultValueForMyEventHandler;// you supply something meaningful here
if Assigned(FOnMyEvent) then
FOnMyEvent(Result);
end;
So, if the consumer of the component has not supplied a handler for the event, then the method still yields a reasonable value.
If you read this and think that it makes no sense for FOnMyEvent to be nil, then your design is wrong. If you want to force the consumer to supply behaviour, and not be allowed to rely on a default, then an event is the wrong mechanism. In that case ask the consumer to supply the behaviour via a parameter, perhaps enforced by the signature of the component's constructor. Or maybe some other way.
I've just given you a basic example un-related to your code. I've tried to get across the concepts. Hopefully you can adapt this to your specific needs.
Related
In our project we have these structures and variable:
TPart = record
private
...
FSize: Integer;
procedure SetSize(const Value: Integer);
public
...
property Size : Integer read FSize write SetSize;
end;
TMain = record
...
material : Byte;
parts : array [1..10] of TPart;
end;
TAMain = array [1..200] of TMain;
var
whole : TAMain;
procedure TPart.SetSize(const Value: Integer);
begin
FSize := Value;
// need to know material current TMain
end;
Whenever procedure SetSize occurs
whole[x].parts[y].Size := ...;
we need to check value in material field of current TMain. (Because when the size is bigger than certain value, it is necessary to change material).
You need to have a pointer to the "main" record for each part. You can do it like this:
type
PMain = ^TMain;
TPart = record
private
//...
FSize : Integer;
FMain : PMain;
procedure SetSize(const Value: Integer);
public
//...
property Size : Integer read FSize write SetSize;
property Main : PMain read FMain write FMain;
end;
TMain = record
//...
material : Byte;
parts : array [1..10] of TPart;
end;
TAMain = array [1..200] of TMain;
procedure TPart.SetSize(const Value: Integer);
begin
FSize := Value;
// need to know material current TMain
if not Assigned(FMain) then
raise Exception.Create('Main not assigned for that part');
if FMain.material = 123 then begin
// Do something
end;
end;
For this to work, you have to assign TPart.Main property before it is needed. You didn't show how TPart records are created in your application. One way to do it is to add a method AddPart() in TMain. Then inside that method, it is easy to assign the "Main" property in the added part.
And by the way, using records is probably not the best design for this. Using classes as suggested Andreas Rejbrand if probably a better idea. The code is almost the same except there is no more explicit pointer. Just a reference to the main instance.
SITUATION. I have created an unit with some classes to solve algebra stuff (congruences and systems), I am showing you the code:
type
TCongrError = class(Exception)
end;
type
TCongruence = class(TComponent)
//code stuff
constructor Create(a, b, n: integer); virtual;
end;
type
TCongrSystem = array of TCongruence;
type
TCongruenceSystem = class(TThread)
private
resInner: integer;
FData: TCongrSystem;
function modinv(u, v: integer): integer; //not relevant
protected
procedure Execute; override;
public
constructor Create(data: TCongrSystem; var result: integer; hasClass: boolean);
end;
I have decided to use TThread because this class has an Execute method that could take some time to finish due to the length of the parameters passed to the constructor. Here's the implementation:
constructor TCongruenceSystem.Create(data: TCongrSystem; var result: integer; hasClass: boolean);
begin
inherited Create(True);
FreeOnTerminate := true;
FData := data;
setClass := hasClass;
resInner := result;
end;
procedure TCongruenceSystem.Execute;
var sysResult, i, n, t: integer;
begin
sysResult := 0;
n := 1;
//computation
Queue( procedure
begin
ShowMessage('r = ' + sysResult.ToString);
resInner := sysResult;
end );
end;
PROBLEM
If you look at the Queue you see that I am using (just as test) the ShowMessage and it is showing the correct value of sysResult. The second line by the way has some problems that I cannot understand.
The constructor has var result: integer so I can have side-effect from the passed variable and then I can assign resInner := result;. At the end (in the Queue) I am giving resInner the value of sysResult and I expect result to be updated too due to the side effect of var. Why doesn't this happen?
I have made another test changing the constructor like this:
constructor TCongruenceSystem.Create(data: TCongrSystem; result: TMemo; hasClass: boolean);
//now of course I have resInner: TMemo
And changing the Queue to this:
Queue( procedure
begin
ShowMessage('r = ' + sysResult.ToString);
resInner.Lines.Add(sysResult.ToString);
end ); //this code now works properly in both cases! (showmessage and memo)
In the constructor I am passing TMemo which is a reference and ok, but isn't the original var result: integer passed as reference too? Why then it doesn't work?
I want to do this because I'd like to do something like this:
//I put var a: integer; inside the public part of the TForm
test := TCongruenceSystem.Create(..., a, true);
test.OnTerminate := giveMeSolution;
test.Start;
test := nil;
Where giveMeSolution is just a simple procedure that uses the variable a containing the result of the system. If this is not possible what could I do? Basically the result at the end of Execute is just an integer number that has to be passed to the main thread.
I have read about ReturnValue but I am not sure how to use it.
Basically the result at the end of Execute is just an integer number that has to be passed to the main thread.
I have read about ReturnValue but I am not sure how to use it.
Using the ReturnValue property is very easy:
type
TCongruenceSystem = class(TThread)
...
protected
procedure Execute; override;
public
property ReturnValue; // protected by default
end;
procedure TCongruenceSystem.Execute;
var
...
begin
// computation
ReturnValue := ...;
end;
test := TCongruenceSystem.Create(...);
test.OnTerminate := giveMeSolution;
test.Start;
....
procedure TMyForm.giveMeSolution(Sender: TObject);
var
Result: Integer;
begin
Result := TCongruenceSystem(Sender).ReturnValue;
...
end;
Let's assume a class field FFoo : integer; ;
procedure TFoo.Foo(var x : integer);
begin
FFoo := x;
end;
Here what you are doing is assigning the value of x to FFoo. Inside the method Foo you are free to modify the value of the variable passed in as x but integers are otherwise value types that are copied on assignment. If you want to keep a reference to an external integer variable you would need to declare FFoo (or, in your case, resInner) as a PInteger (pointer to an integer). For example (simplifying) :
TCongruenceSystem = class(TThread)
private
resInner: PInteger;
protected
procedure Execute; override;
public
constructor Create(result: PInteger);
end;
where
constructor TCongruenceSystem.Create(result: PInteger);
begin
inherited Create(True);
FreeOnTerminate := true;
resInner := result;
end;
which you would call as test := TCongruenceSystem.Create(#a); and assign:
{ ** See the bottom of this answer for why NOT to use }
{ Queue with FreeOnTerminate = true ** }
Queue( procedure
begin
ShowMessage('r = ' + sysResult.ToString);
resInner^ := sysResult;
end );
The reason it works with TMemo is that classes are reference types - their variables do not hold values but rather point to the address of the object in memory. When you copy a class variable you are only copying a reference (ie: a pointer) whereas for value types the contents of the variable are copied on assignment.
With that said, there's nothing stopping you from keeping the argument typed as var x : integer and taking a reference in your constructor :
constructor TCongruenceSystem.Create(var result: Integer);
begin
inherited Create(True);
FreeOnTerminate := true;
resInner := #result; {take the reference here}
end;
but this gives the caller the impression that once the constructor is complete that you have made any modifications to the variable you intend to and they are free to dispose of the integer. Passing explicitly as PInteger gives the caller a hint that your object will keep a reference to the integer they provide and that need to ensure the underlying variable remains valid while your class is alive.
And... with all that said, I still fundamentally don't like this idea. By taking in a variable reference like this you are offloading an atypical lifetime management issue to the caller. Passing pointers is best done in place where they are used at the point of transfer only. Holding onto a foreign pointer is messy and it's too easy for mistakes to happen. A far better approach here would be to provide a completion event and have the consumer of your class attach a handler.
For example :
{ define a suitable callback signature }
TOnCalcComplete = procedure(AResult : integer) of object;
TCongruenceSystem = class(TThread)
private
Fx, Fy : integer;
FOnCalcComplete : TOnCalcComplete;
protected
procedure Execute; override;
public
constructor Create(x,y: integer);
property OnCalcComplete : TOnCalcComplete read FOnCalcComplete write FOnCalcComplete;
end;
constructor TCongruenceSystem.Create(x: Integer; y: Integer);
begin
inherited Create(true);
FreeOnTerminate := true;
Fx := x;
Fy := y;
end;
procedure TCongruenceSystem.Execute;
var
sumOfxy : integer;
begin
sumOfxy := Fx + Fy;
sleep(3000); {take some time...}
if Assigned(FOnCalcComplete) then
Synchronize(procedure
begin
FOnCalcComplete(sumOfxy);
end);
end;
Which you would then call as :
{ implement an event handler ... }
procedure TForm1.CalcComplete(AResult: Integer);
begin
ShowMessage(IntToStr(AResult));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
LCongruenceSystem : TCongruenceSystem;
begin
LCongruenceSystem := TCongruenceSystem.Create(5, 2);
LCongruenceSystem.OnCalcComplete := CalcComplete; { attach the handler }
LCongruenceSystem.Start;
end;
You'll also notice that I used Synchronize here instead of Queue. On this topic, please have a read of this question (I'll quote Remy...):
Ensure all TThread.Queue methods complete before thread self-destructs
Setting FreeOnTerminate := True in a queued method is asking for a memory leak.
I want to change the value of T according to a particular selection but it's not changing. Please have a look. The variable T has been declared along with Form1:TForm1 before 'implementation'. Basically, T should get assigned a linear or non linear equation depending upon the the selection of the respected radio buttons. I put a TEdit in the form so as to get an idea whether it is working or not. The last part is just a way to check by taking an example of Integer values.
Also, if I am not able to give a clear idea then just suggest me how to store a value of the concerned value using the Radiobuttons of the RadioGroup.
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.Items[RadioGroup1.ItemIndex] = 'Linear Tension' then
T:= 5;
if RadioGroup1.Items[RadioGroup1.ItemIndex] = 'Non-Linear tension' then
T:= 10;
end;
procedure TForm1.Edit1Change(Sender: TObject);
var
code: Integer;
value: Real;
begin
Val(Edit1.Text,value,code);
Edit1.Text := formatfloat('#.0', T);
end;
end.
It's really not a good idea to use a textual comparison for RadioGroup items. It's much better to simply use the ItemIndex directly:
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
case RadioGroup1.ItemIndex of
0: T := 5;
1: T := 10;
else
raise Exception.Create('No item selected - should not get here');
end;
ShowMessage(FloatToStr(T));
end;
Do not compare the captions because you will have magic values in your code.
Declare a ValueObject containing the Value and the Name
type
TTensionValue = record
private
FValue : Integer;
FName : string;
public
constructor Create( AValue : Integer; const AName : string );
class function EMPTY : TTensionValue;
property Value : Integer read FValue;
property Name : string;
end;
TTensionValues = TList<TTensionValue>;
class function TTensionValue.EMPTY : TTensionValue;
begin
Result.FValue := 0;
Result.FName := '';
end;
constructor TTensionValue.Create( AValue : Integer; const AName : string );
begin
// Validation of AValue and AName
if AName = '' then
raise Exception.Create( 'AName' );
if AValue < 0 then
raise Exception.Create( 'AValue' );
FValue := AValue;
FName := AName;
end;
Prepare a List with valid entries
type
TForm1 = class( TForm )
...
procedure RadioGroup1Click( Sender: TObject );
private
FTensions : TTensionValues;
procedure PopulateTensions( AStrings : TStrings );
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
procedure TForm1.AfterConstruction;
begin
inherited;
FTensions := TTensionValues.Create;
FTensions.Add( TTensionValue.Create( 5, 'Linear Tension' ) );
FTensions.Add( TTensionValue.Create( 10, 'Non-Linear tension' ) );
end;
procedure TForm1.BeforeDestruction;
begin
FTenstions.Free;
inherited;
end;
Populate that list to the RadioGroup
procedure TForm1.PopulateTensions( AStrings : TStrings );
var
LValue : TTensionValue;
begin
AStrings.BeginUpdate;
try
AStrings.Clear;
for LValue in FTensions.Count - 1 do
AStrings.Add( LValue.Name );
finally
AStrings.EndUpdate;
end;
end;
procedure TForm1.FormShow( Sender.TObject );
begin
PopulateTensions( RadioGroup1.Items );
end;
Now you only ask the TensionList for the value
procedure TForm1.RadioGroup1Click( Sender: TObject );
begin
T := FTensions[RadioGroup1.ItemIndex].Value;
end;
The selected value now only rely on the chosen ItemIndex and not on the caption text.
From what I can tell, you're simply trying to change the value displayed on Edit1 when RadioGroup1 is clicked. To achieve this, all you'll need to do is move
Edit1.Text := formatfloat('#.0', T);
to the end of your RadioGroup1Click procedure.
I'm assuming Edit1Change is the onChange procedure of Edit1. If so, according to the documentation this procedure only gets called when the Text property already might have changed. So not only will this procedure not get called (how would delphi know you intend to use the value of T to change the text of Edit1?), when it does get called, it might result in a stack overflow, since changing the text value indirectly calls the onChange event. (though setting it to the same value it already had might not call it).
That being said, checking if a value is being changed properly, does not require a TEdit, a TLabel would be a better fit there. Though in your case, i would opt for simply placing a breakpoint and stepping through the code to see if the value get's changed correctly.
There are also some a lot of additional problems with your code, such as inconsistent formatting, magic values, bad naming conventions and lines of code that serve no purpose, I would suggest you read up on those before you get into bad habits.
I have a class in my Delphi app where I would like an easy and dynamic way of resetting all the string properties to '' and all the boolean properties to False
As far as I can see on the web it should be possible to make a loop of some sort, but how to do it isn't clear to me.
if you are an Delphi 2010 (and higher) user then there is a new RTTI unit (rtti.pas). you can use it to get runtime information about your class and its properties (public properties by default, but you can use {$RTTI} compiler directive to include protected and private fields information).
For example we have next test class with 3 public fields (1 boolean and 2 string fields (one of them is readonly)).
TTest = class(TObject)
strict private
FString1 : string;
FString2 : string;
FBool : boolean;
public
constructor Create();
procedure PrintValues();
property String1 : string read FString1 write FString1;
property String2 : string read FString2;
property BoolProp : boolean read FBool write FBool;
end;
constructor TTest.Create();
begin
FBool := true;
FString1 := 'test1';
FString2 := 'test2';
end;
procedure TTest.PrintValues();
begin
writeln('string1 : ', FString1);
writeln('string2 : ', FString2);
writeln('bool: ', BoolToStr(FBool, true));
end;
to enumerate all properties of object and set it values to default you can use something like code below.
First at all you have to init TRttiContext structure (it is not neccesary, because it is a record). Then you should get rtti information about your obejct, after that you can loop your properties and filter it (skip readonly properties and other than boolean and stirng). Take into account that there are few kind of strings : tkUString, tkString and others (take a look at TTypeKind in typinfo.pas)
TObjectReset = record
strict private
public
class procedure ResetObject(obj : TObject); static;
end;
{ TObjectReset }
class procedure TObjectReset.ResetObject(obj: TObject);
var ctx : TRttiContext;
rt : TRttiType;
prop : TRttiProperty;
value : TValue;
begin
ctx := TRttiContext.Create();
try
rt := ctx.GetType(obj.ClassType);
for prop in rt.GetProperties() do begin
if not prop.IsWritable then continue;
case prop.PropertyType.TypeKind of
tkEnumeration : value := false;
tkUString : value := '';
else continue;
end;
prop.SetValue(obj, value);
end;
finally
ctx.Free();
end;
end;
simple code to test:
var t : TTest;
begin
t := TTest.Create();
try
t.PrintValues();
writeln('reset values'#13#10);
TObjectReset.ResetObject(t);
t.PrintValues();
finally
readln;
t.Free();
end;
end.
and result is
string1 : test1
string2 : test2
bool: True
reset values
string1 :
string2 : test2
bool: False
also take a look at Attributes, imo it is good idea to mark properties (wich you need to reset) with some attribute, and may be with default value like:
[ResetTo('my initial value')]
property MyValue : string read FValue write FValue;
then you can filter only properties wich are marked with ResetToAttribute
Please note, the following code works only for published properties of a class! Also, the instance of a class passed to the function below must have at least published section defined!
Here is how to set the published string property values to an empty string and boolean values to False by using the old style RTTI.
If you have Delphi older than Delphi 2009 you might be missing the tkUString type. If so, simply removeit from the following code:
uses
TypInfo;
procedure ResetPropertyValues(const AObject: TObject);
var
PropIndex: Integer;
PropCount: Integer;
PropList: PPropList;
PropInfo: PPropInfo;
const
TypeKinds: TTypeKinds = [tkEnumeration, tkString, tkLString, tkWString,
tkUString];
begin
PropCount := GetPropList(AObject.ClassInfo, TypeKinds, nil);
GetMem(PropList, PropCount * SizeOf(PPropInfo));
try
GetPropList(AObject.ClassInfo, TypeKinds, PropList);
for PropIndex := 0 to PropCount - 1 do
begin
PropInfo := PropList^[PropIndex];
if Assigned(PropInfo^.SetProc) then
case PropInfo^.PropType^.Kind of
tkString, tkLString, tkUString, tkWString:
SetStrProp(AObject, PropInfo, '');
tkEnumeration:
if GetTypeData(PropInfo^.PropType^)^.BaseType^ = TypeInfo(Boolean) then
SetOrdProp(AObject, PropInfo, 0);
end;
end;
finally
FreeMem(PropList);
end;
end;
Here is a simple test code (note the properties must be published; if there are no published properties in the class, at least empty published section must be there):
type
TSampleClass = class(TObject)
private
FStringProp: string;
FBooleanProp: Boolean;
published
property StringProp: string read FStringProp write FStringProp;
property BooleanProp: Boolean read FBooleanProp write FBooleanProp;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SampleClass: TSampleClass;
begin
SampleClass := TSampleClass.Create;
try
SampleClass.StringProp := 'This must be cleared';
SampleClass.BooleanProp := True;
ResetPropertyValues(SampleClass);
ShowMessage('StringProp = ' + SampleClass.StringProp + sLineBreak +
'BooleanProp = ' + BoolToStr(SampleClass.BooleanProp));
finally
SampleClass.Free;
end;
end;
Data.XX.NewValue := Data.XX.SavedValue;
Data.XX.OldValue := Data.XX.SavedValue;
I need to do the above a large number of times, where XX represents the value in the class. Pretending there were 3 items in the list: Tim, Bob, Steve. Is there any way to do the above for all three people without typing out the above code three times?
(Data is a class containing a number of Objects, each type TList, which contain OldValue, NewValue and SavedValue)
What I'd do if I had to do something like this is put one more TList on Data, which holds a list of all the Objects on it. Fill it in the constructor, and then when you have to do something like this, use a loop to apply the same basic operation to each item in the list.
Maybe I'm not understanding it ok but...
Here is where Object Oriented shines. You define a procedure for the class and then apply for any instance you create.
TMyPropValue = class(TObject)
private
FNewValue: double;
FOldValue: double;
procedure SetValue(AValue: double);
public
procedure RestoreOldValue;
propety NewValue: double read FNewValue write SetValue; // Raed/write property (write using a procedure)
property OldValue: double read FOldValue; // Read only property
end;
TMyClass = class(TObject)
private
FProp1: TMyPropValue;
FProp2: TMyPropValue;
public
procedure RestoreValues;
end;
//....
var
MyObj1: TMyClass;
MyObj2: TMyclass;
procedure TMyPropValue.SetValue(AValue: double);
begin
FOldValue := FNewValue;
FNewValue := AValue;
end;
// Restore the Old value of this Prop
procedure TMyPropValue.RestoreOldValue;
begin
FNewValue := FOldValue;
end;
// Restore ald the Values of the class
procedure TMyClass.RestoreValues;
begin
FProp1.RestoreOldValue;
FProp2.RestoreOldValue;
end;
// -----------
// Creating and populating a couple of objects (instances)
procedure XXX;
begin
MyObj1 := TMyClass.Create;
MyObj1.Prop1.NewValue := 10.25:
MyObj1.Prop2.NewValue := 99.10:
MyObj2 := TMyClass.Create;
MyObj2.Prop1.NewValue := 75.25:
MyObj2.Prop2.NewValue := 60.30:
end;
// Changing values, the class internaly will save the OldValue
procedure yyyy;
begin
MyObj1.Prop1.NewValue := 85.26:
MyObj1.Prop2.NewValue := 61.20:
MyObj2.Prop1.NewValue := 99.20:
MyObj2.Prop2.NewValue := 55.23:
end;
// Using a procedure from the class
procedure zzzz;
begin
MyObj1.RestoreValues;
MyObj2.RestoreValues;
end;
Hope this help
Daniel
Judging from this post and this post, I would suggest the following :
unit MyAssignment;
interface
type
TValueKind = ( EconomicGrowth,
Inflation,
Unemployment,
CurrentAccountPosition,
AggregateSupply,
AggregateDemand,
ADGovernmentSpending,
ADConsumption,
ADInvestment,
ADNetExports,
OverallTaxation,
GovernmentSpending,
InterestRates,
IncomeTax,
Benefits,
TrainingEducationSpending );
TValue = record
NewValue,
OldValue,
SavedValue : Double;
procedure SetValue( aVal : Double );
procedure SaveValue();
procedure RestoreValue();
end;
TDataArray = array [TValueKind] of TValue;
var
Data : TDataArray;
implementation
{TValue}
procedure TValue.SetValue( aVal : Double );
begin
OldValue := NewValue;
NewValue := aVal;
end;
procedure TValue.SaveValue;
begin
SavedValue := NewValue;
end;
procedure TValue.RestoreValue;
begin
NewValue := SavedValue;
OldValue := SavedValue;
end;
end.
Now you can write this kind of code :
//accessing the values :
// Data[XX] instead of Data.XX
//examples :
ShowMessage(FloatToStr(Data[Inflation].SavedValue));
Data[AgregateSupply].SetValue( 10.0 );
Data[Benefits].SaveValue;
//writing loops :
procedure RestoreValues( var aData : TDataArray ); //the "var" keyword is important here : google "arguments by value" "arguments by reference"
var
lKind : TValueKind;
begin
for lKind := Low(TValueKind) to High(TValueKind) do
aData[lKind].RestoreValue;
end;
procedure SaveValues( var aData : TDataArray );
var
lKind : TValueKind;
begin
for lKind := Low(TValueKind) to High(TValueKind) do
aData[lKind].RestoreValue;
end;
//calling these functions :
SaveValues( Data );
RestoreValues( Data );
If you need more complex manipulations on the array, it would be a good idea to put it into a class - replace the fields you wrote with only on efield of type TDataArray - and write the functions to manipulate the data as methods of this class.
I would be careful here. I know the temptation is going to be to use a common interface and reflection, or some other automation that is more flexible and, frankly, more fun to write. Avoid this temptation. There is nothing wrong with listing every item in the list out according to your pattern. Patterns are good, and the code will be readable, easy to execute, and easy to modify any individual property that does not fit the pattern.
The low tech way to avoid typing everything out is to use our old friend Excel. Put all your properties in Column A, and then use this formula in column B:
= CONCATENATE("Data.", A1, ".NewValue := Data.", A1, ".SavedValue;", CHAR(10), "Data.", A1, ".OldValue := Data.", A1, ".SavedValue;", CHAR(10))