Using Spring, when I declare a smart pointer for a record
SmartPerson = IShared<Pperson>;
And then create it
Smartperson := Shared<PPerson>.Make;
*by the way, think this is really cool.
How then do I go about getting RTTI on the smart pointer? Obviously, I know it's based on a TPerson record, but what steps are needed to sort of reverse what happens when Spring allocates the pointer in the first place?
I see when the record pointer is created it uses code like this
tkPointer: IShared<Pointer>(Result) := Shared.TRecordFinalizer.Create(TypeInfo(T));
followed by code like this
constructor Shared.TRecordFinalizer.Create(typeInfo: PTypeInfo);
var
Size : integer;
begin
inherited Create;
fTypeInfo := typeInfo.TypeData.RefType^;
size := GetTypeSize(fTypeInfo);
fValue := AllocMem(Size);
end;
My Question is how do I get, for example, a field of the record the smart pointer points to by using the smart pointer itself?
Hope that makes sense, and maybe another dumb question.
To give some more background to problem. I have a factory which uses RTTI to build a control for a field of a record.
procedure TForm3.Button1Click(Sender: TObject);
begin
Task := Shared<pTaskRecord>.make;
Task.AnalysisDates.ES := now;
Task.TaskType := TTaskTypes.DelayTask;
ControlFactory := TControlFactory.create(Self);
Edit := Controlfactory.GetControl('TAnalysisDates','ES');
if assigned(Edit) then
begin
AddObject(Edit.Invoke);
Edit.Value := #Task.AnalysisDates;
end;
end;
Which works. It returns an TDateEdit based on attribute tags on a record
I was thinking perhaps what I could do is this
Edit := Controlfactory.GetControl(Task,Task.ES);
//passing in my smart pointer, along with field
then the factory would have everything it needs to hook the control up without having to do it in code myself.
Edit.Value := #Task.AnalysisDates;
the above line could be handled by the factory. Anyway just an idea
Related
In Delphi there is the procedure UniqueString which forces the parameter passed to it to have a reference count of 1. It is usually done to ensure that so it is safe to pass it to a different thread without messing up the reference counting. (*1)
It has always irked me that I have to assign the string to a variable first before I can call this procedure. Is there any reason why it could not be implemented as a function?
Like:
procedure TMyThread.Create(const _SomeParam: string);
begin
FStringField := MakeUniqueString(_SomeParam);
inherited Create(false);
end;
Instead of:
procedure TMyThread.Create(const _SomeParam: string);
begin
FStringField := _SomeParam;
UniqueString(FStringField);
inherited Create(false);
end;
And is there any problem with writing such a function as
function MakeUniqueString(const _s: string): string;
begin
Result := _s;
UniqueString(Result);
end;
EDIT:
*1: Yes, my claim that reference counting is not thread safe is at least outdated or may even have been wrong alltogether. You can stop telling me that.
You can use
FStringField := Copy(_SomeParam, 1);
That will make a unique copy.
(Trivia: although documented as required, you can actually leave out the Count parameter and Copy will copy everything from the starting index to the end.)
Or you can make your own UniqueString:
function MakeUnique(const value: string): string; inline;
begin
Result := value;
UniqueString(Result);
end;
FStringField := MakeUnique(_SomeParam);
(Trivia: If you remove the inline, FStringField will actually have refcount 2 until the parent function (TMyThread.Create in your example) exits, because the compiler creates a hidden local variable that receives the result of the MakeUnique call and then assigns it to the FStringField. The string would still be unique so far as the parallel code is concerned.)
To answer the philosophical question - no, I don't think there is any big showstopper that prevents UniqueString by being implemented as a function. It just isn't.
I have two identical statusbars (AdvOfficeStatusBar) on each form. That means Form1 has the same status bar as the Form2.Now,before I close the Form1 I would like all the values from the status bar to be transfered to that one on the form2. I suppose I could do it one by one like... :
procedure TForm2.FormShow(Sender: TObject);
begin
AdvOfficeStatusBar1.Panels[0].Text := Form1.AdvOfficeStatusBar1.Panels[0].Text;
AdvOfficeStatusBar1.Panels[1].Text := Form1.AdvOfficeStatusBar1.Panels[1].Text;
AdvOfficeStatusBar1.Panels[2].Text := Form1.AdvOfficeStatusBar1.Panels[2].Text;
AdvOfficeStatusBar1.Panels[4].Text := Form1.AdvOfficeStatusBar1.Panels[4].Text;
AdvOfficeStatusBar1.Panels[5].Text := Form1.AdvOfficeStatusBar1.Panels[5].Text;
AdvOfficeStatusBar1.Panels[6].Text := Form1.AdvOfficeStatusBar1.Panels[6].Text;
end;
I was wondering if there's a more simple way?Less code...
You're suffering from an anti-pattern called copy-paste-programming.
It makes for very easy programming, but difficult maintenance.
Every time you add a line to one statusbar, you have to go back and update to code to have it be linked into the other statusbar.
It's easy to forget updating the code and ehm well it's work, which is why this is bad practice.
A better way is to use Assign or if that does not work a loop. Both are demonstrated below.
Note that the Panel is an array property.
Normally every array_property has a associated count property.
I'm not sure what it is in this instance, but I'm guessing it's called PanelCount.
As per David's suggestion it's better to store the state somewhere inside your program, because you might redesign the form and lose the StatusBar, in which case you'd also lose the storage.
type
TForm2 = class(TForm)
private
StatusStore: array of string;
.....
end;
implementation
procedure TForm2.FormCreate(Sender: TObject);
begin
//Initialisation, you cannot use a loop, unless you'd read it from a file.
SetLength(StatusStore,6);
StatusStore[0]:= 'a';
StatusStore[1]:= 'b';
StatusStore[2]:= 'c';
StatusStore[3]:= 'd';
StatusStore[4]:= 'e';
StatusStore[5]:= 'f';
end;
procedure TForm2.FormShow(Sender: TObject);
var
i,maxi: integer;
begin
StatusStore[0]:= 'Showing Form2';
Maxi:= SizeOf(StatusStore);
i:= 0;
AdvOfficeStatusBar1.PanelCount:= Maxi;
while (i < Maxi) do begin
AdvOfficeStatusBar1.Panels[i].Text:= StatusStore[i];
end; {while}
Form1.AdvOfficeStatusBar1.Panels.Assign(Form2.AdvOfficeStatusBar1.Panels);
end;
Now whatever data is to be displayed and however many items there are, the display will update.
You can even program the loop to skip an item if you want the first or last item to be different for each form.
is this piece of code safe from memory leaks?
s := TStringList.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object to live somewhere in memory
end;
function GetSomeSettings : TStringList;
var
rawString : string;
settings : TStringList;
begin
// Singleton pattern implementation
// Trying to find already existing settings in class variable
settings := TSettingsClass.fSettings;
// If there is no already defined settings then get them
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TSettingsClass.fSettings := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
end;
Result := settings;
end;
I'm wondering s := GetSomeSettings; potentially harmful and ignoring first object, keeps it in the memory?
Yes, the StringList created on line 1 is leaked.
Essentialy, you are doing:
s := TStringList.Create;
s := AnotherStringList;
AnotherStringList.Free;
As for the GetSomeSettings routine:
Normally it is not wise or encouraged to return newly created instances as function results, because you transfer the responsibility for ownership and destruction to the calling code. Unless you have a mechanism/framework in place that takes care of it, which seems to be the case with your TSettingsClass, but there is not enough evidence for that in this little piece of code.
Nevertheless, the combination of both pieces of code display another problem: After s.Free, TSettingsClass.fSettings is destroyed but not nil. Thus the second time GetSomeSettings is called, it returns a dangling pointer.
1) you should not ask when you can check in two minutes!
program {$AppType Console};
uses Classes, SysUtils;
type TCheckedSL = class(TStringList)
public
procedure BeforeDestruction; override;
procedure AfterConstruction; override;
end;
procedure TCheckedSL.BeforeDestruction;
begin
inherited;
WriteLn('List ',IntToHex(Self,8), ' going to be safely destroyed.');
end;
procedure TCheckedSL.AfterConstruction;
begin
WriteLn('List ',IntToHex(Self,8), ' was created - check whether it is has matched destruction.');
inherited;
end;
procedure DoTest; var s: TStrings;
function GetSomeSettings: TStrings;
begin Result := TCheckedSL.Create end;
begin
Writeln('Entered DoTest procedure');
s := TCheckedSL.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object
end;
Writeln('Leaving DoTest procedure');
end;
BEGIN
DoTest;
Writeln;
Writeln('Check output and press Enter when done');
ReadLn;
END.
2) Still that could be safe in few niche cases.
in FPC (http://FreePascal.org) S could be a "global property" of some unit, having a setter which would free old list.
in Delphi Classic S could be of some interface type, supported by the created object. Granted, standard TStringList lacks any interface, but some libraries ( for example http://jcl.sf.net ) do offer interface-based string lists, with richer API (iJclStringList type and related).
in Delphi/LLVM all objects were made reference-counted, like interfaces without GUID's. So that code would be safe there.
You can declare S as a record - a so-called Extended Record having re-defined class operator Implicit so that the typecast s{record} := TStringList.Create would free the previous instance before assigning a new one. That is dangerous though, as it is VERY fragile and easy to misuse, and destroy the list in some other place leaving a dangling pointer inside the S record.
Your object may be not that vanilla TStringList, but some subclass, overriding constructors or AfterConstruction to register itself in some list, that would be all-at-once in some place. Kind of Mark/Sweep heap management around large chunk of workload. VCL TComponent may be seen as following this pattern: form is owning its component and frees them when needed. And this is what you - in reduced form - are trying to do with TSettingsClass.fSettings containter (any reference is 1-sized container). However those frameworks do require a loopback: when the object is freed it should also remove itself from all the containers, referencing it.
.
procedure TCheckedSL.BeforeDestruction;
begin
if Self = TSettingsClass.fSettings then TSettingsClass.fSettings := nil;
inherited;
end;
class procedure TSettingsClass.SetFSettings(Value);
var fSet2: TObject;
begin
if fSettings <> nil then begin
fSet2 := fSettings;
f_fSettings := nil; // breaking the loop-chain
fSet2.Destroy;
end;
f_fSettings := Value;
end;
class destructor TSettingsClass.Destroy;
begin
fSettings := nil;
end;
However then - by the obvious need to keep design symmetric - the registration should also be done as a part of the class. Who is responsible for de-registration is usually the one responsible for registration as well, unless there are reasons to skew the design.
procedure TCheckedSL.AfterConstruction;
begin
inherited;
TSettingsClass.fSettings := Self;
end;
...
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TCheckedSL.Create.Text := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
Assert( Assigned(settings), 'wrong class used for DB settings' );
end;
Result := settings;
The question more or less says it all. Given the following record structure:
type
TPerson = record
Name: string;
Age: Integer;
end;
PPerson = ^TPerson;
TPersonList = TList<TPerson>;
Is the following code valid?
procedure ReadPeople(DataSet: TDataSet; PersonList: TPersonList);
begin
PersonList.Count := DataSet.RecordCount;
if DataSet.RecordCount = 0 then
Exit;
DataSet.First;
while not DataSet.Eof do begin
PersonList[DataSet.RecNo].Name := DataSet.FieldByName('Name').AsString;
PersonList[DataSet.RecNo].Age := DataSet.FieldByName('Age').AsInteger;
DataSet.Next;
end;
end;
Do I have to use GetMem/FreeMem to allocate and free records an instance of TPersonList, or am I free to directly access the TPersonList entries directly? My gut says that the code should be valid, though I'm not sure if there's any wrinkles related to record initialization or finalization.
Your code's fine. When you use Tlist<T> with records, it treats them as value types, to be copied around. There's no need to allocate pointers for them.
The question is: Why do you declare PPerson? Make sure that you do not accidentally try to deallocate the memory of a TRecord from your list to which you were pointing in a PPerson variable.
I've got a pretty big setup form which I'd like to populate with data from a class. so I'm doing a lot of
Edt1.text := ASettings.FirstThing;
I'd like to avoid
Edt1.onchange := nil;
Edt1.text := ASettings.FirstThing;
Edt1.onchange := edt1Onchange;
How do I change the text in a text box and sidestep the onchange event.
I have used something like changing the OnChange handler, but more often, I use a flag.
updatingFromCode := true;
Edt1.Text := ASettings.FirstThing;
updatingFromCode := false;
then
procedure TForm1.OnChange(...);
begin
if updatingFromCode then
Exit;
...
Also, rather than hardcoding the OnChange the the actual OnChange procedure, I would store the Edit control's current value, then reset it (which will work if it is not set, or if another place has changed it, etc.)
oldOnChange := Edt1.OnChange;
Edt1.OnChange := nil;
Edt1.Text := ASettings.FirstThing;
Edt1.OnChange := oldOnChange;
You might consider using an object to manage the NIL'ing of the event and restoring the previously installed event handler. It's a little dangerous to assume that the event to be restored just happens to be the one assigned at design-time/which happens to have the "name that fits" - you should always save/restore the currently assigned handler, just to be safe.
This would provide an even more re-usable utility than the SetTextWithoutOnChange() routine:
TSuspendEvent = class
private
fObject: TObject;
fEvent: String;
fHandler: TMethod;
public
constructor Create(const aObject: TObject; aEvent: String);
destructor Destroy; override;
end;
constructor TSuspendEvent.Create(const aObject: TObject; aEvent: String);
const
NILEvent : TMethod = (Code: NIL; Data: NIL);
begin
inherited Create;
fObject := aObject;
fEvent := aEvent;
fHandler := GetMethodProp(aObject, aEvent);
SetMethodProp(aObject, aEvent, NILEvent);
end;
destructor TSuspendEvent.Destroy;
begin
SetMethodProp(fObject, fEvent, fHandler);
inherited;
end;
In usage, this would look something like:
with TSuspendEvent.Create(Edit1, 'OnChange') do
try
Edit1.Text := 'Reset!';
finally
Free;
end;
For the "Thou shalt not use 'with' crowd" - by all means declare yourself an additional local variable and use that if it will help you sleep easier at night. :)
Or, to make it even more convenient to use and eliminate "with", I would make the TSuspendEvent class an interfaced object and wrap its use in a function that yielded an interface reference to it that could be allowed to "live in scope", as exemplified by my AutoFree() implementation. In fact, you could use AutoFree() as-is to manage this already:
AutoFree(TSuspendEvent.Create(Edit1, 'OnChange'));
Edit1.Text := 'Reset!';
Dsabling events for a period that extends beyond the scope of a single procedure requires more management than any helper utilities are likely to be able to provide in a generic fashion I think, at least not without also having specific means for restoring events explicitly, rather than automatically.
If you simply wrapped TSuspendEvent inside it's own interface yielding function, following the same pattern as AutoFree() you could simplify this further to:
SuspendEvent(Edit1, 'OnChange');
Edit1.Text := 'Reset!';
As a final note, I think it should be fairly easy to see how this could be quite simply extended to support suspending multiple events on an object in a single call, if required, for example:
SuspendEvent(Edit1, ['OnChange', 'OnEnter']);
As far as I know if the OnChange of your object is designed to fire when the Text property is changed you have to stick with setting the event to nil temporarly. Myself, I do it this way (in a try finally):
Edt1.onchange := nil;
try
Edt1.text := ASettings.FirstThing;
finally
Edt1.onchange := edt1Onchange;
end;
You could also do some procedure to handle it for you:
procedure SetTextWithoutOnChange(anEdit: TEdit; str: String);
var
anEvent: TNotifyEvent;
begin
anEvent := anEdit.OnChange;
anEdit.OnChange := nil;
try
anEdit.Text := str;
finally
anEdit.OnChange := anEvent;
end;
end;
I know this is an old question but I thought I would add my solution that does not involve any of the complicated procedures outlined in the previous answers in case it comes up in another search.
The problem is the onChange event itself. I don't use it at all for text fields.
remove all OnChange and use the OnExit instead and tie it to the OnKeyUp.
All Edits have a common ancestor TCustomEdit.
I generally use one method called CustomEditKeyUp and point all the edits on a form to this single method (TEdit, TLabeledEdit etc etc.)
type THack = class(TCustomEdit);
procedure TForm1.CustomeEditKeyUP(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=VK_RETURN) and (Sender is TCustomEdit) then
{This is just to isolate the one occasion when they press the
enter but don't exit immediately}
if Assigned(THack(Sender).OnExit) then THack(Sender).OnExit(Sender);
end;
For some reason, the OnExit is private in a TCustomEdit so the Hack is needed. If you know that the edits are from a different route where the OnExit is public, cast if differently and the Hack is not necessary.
Then For each Edit control, use a specific OnExit
procedure TForm1.MyEditExit(Sender: TObject);
begin
if MyEdit.Modified then
begin
{Do Something here}
MyEdit.Modified := false;
end;
end;
If you want to change the value programmatically without it firing 'OnExit'
....
MyEdit.Text :='I've changed it'
MyEdit.Modified := false;
....
The big advantage for me is that when I am parsing the input for say a valid number, I only have to do this once when editing is completed and not for every single backspace, delete insert etc all surrounded by try except as the various formating functions error out as they don't understand spaces etc.. For database etc, the number of calls will be greatly reduced.
That's my two penneth.
Another way is by using Class Helpers introduced in Delphi 8.
http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Class_and_Record_Helpers_(Delphi)
You could write:
type
TEditHelper = class helper for TEdit
public
procedure SetTextDisableOnChange(const AText: string);
end;
{ TEditHelper }
procedure TEditHelper.SetTextDisableOnChange(const AText: string);
var
OnChangeTmp: TNotifyEvent;
begin
OnChangeTmp:=OnChange;
try
OnChange:=nil;
Text:=AText;
finally
OnChange:=OnChangeTmp;
end;
end;
and then:
EditCtrl.SetTextDisableOnChange('I do not invoke OnChange!');
EditCtrl.Text:='I invoke OnChange';