Delphi, how to free record in TList - delphi

I want to know the best way to free a TList filled with record.
I have the following record:
type
TPkBill = record
PkBill: integer;
Constructor Create(c_PkBill: integer);
constructor TPkBill.Create(c_PkBill: integer);
begin
PkBill := c_PkBill;
end;
I create the list and fill it with the record:
procedure TfrmProject.lvBillDblClick(Sender: TObject);
var
i, iCount: integer;
item: TListItem;
oPkBill: TPkBill;
lstPkBill: Tlist;
begin
iCount := 0;
lstPkBill:= TList.Create;
//if an item is selected in lv
if (lvBill.ItemIndex = -1) then begin exit; end
else
begin
//Loop through all items and get selected item
for i := 0 to lvBill.Items.Count - 1 do
begin
item := lvBill.Items.Item[i];
if(item.Selected = true)then
begin
//create new item
oPkBill := TPkBill.Create(StrToInt(lvBill.Items[i].Caption));
//add it to a list
lstPkBill.Add(TObject(oPkBill));
//add up
iCount := iCount +1;
end;
end;
//Now we have a list ok pkBill
if(iCount > 1)then //other stuff I do
end
I want to be able to free the TList and also to free the record.
Here is what I already tried:
for i := 0 to lstPkBill.Count - 1 do
begin
//TObject(TPkBill(lstPkBill[i])).Free; //Acces violation at adress..
//FreeMem(TPkBill(lstPkBill[i])); //Incompatible types
//FreeMem(TObject(lstPkBill[i])); //Incompatible types
end;
lstPkBill.Clear;
FreeAndNil(lstPkBill);
Thanks you for the help, it's appreciated!

You have defined a record with a constructor. Calling a record constructor does not allocate memory on the heap, like a class constructor does. Your oPkBill variable exists on the stack. Calling oPkBill := TPkBill.Create(...) merely populates the members of that variable. You are then type-casting that entire variable (which only contains one Integer member) into a TObject pointer. You are not actually allocating any memory on the heap for the list item, so there is no need to free them.
I suspect what you were actually trying to do is something more like this:
type
PPkBill = ^TPkBill;
TPkBill = record
PkBill: integer;
Constructor Create(c_PkBill: integer);
end;
constructor TPkBill.Create(c_PkBill: integer);
begin
PkBill := c_PkBill;
end;
procedure TfrmProject.lvBillDblClick(Sender: TObject);
var
i: Integer;
item: TListItem;
oPkBill: PPkBill;
lstPkBill: TList;
begin
if lvBill.ItemIndex = -1 then Exit;
//an item is selected in lv
lstPkBill := TList.Create;
try
//Loop through all items and get selected items
for i := 0 to lvBill.Items.Count - 1 do
begin
item := lvBill.Items.Item[i];
if item.Selected then
begin
//create new item
New(oPkBill);
try
oPkBill^ := TPkBill.Create(StrToInt(lvBill.Items[i].Caption));
//add it to a list
lstPkBill.Add(oPkBill);
except
Dispose(oPkBill);
raise;
end;
end;
end;
//Now we have a list ok pkBill
if (lstPkBill.Count > 1) then
begin
//other stuff I do
end;
finally
for i := 0 to lstPkBill.Count - 1 do
Dispose(PPkBill(lstPkBill[i]));
lstPkBill.Free;
end;
end;

Related

Finding an embedded TFrame

I have a TFrame that is Inherited from a TBaseFrame = class(TFrame)
Inside this there is an embeded TFrame with same inheritence
TViewStandardMovimentoFinanceiro = class(TFrameBase)
ViewStandardEdiMovimentoFinanceiro1: TViewStandardEdiMovimentoFinanceiro;
TViewStandardEdiMovimentoFinanceiro = class(TFrameBase)
TFrameBase = class(TFrame, INaharView, INaharViewAdapter)
The TViewStandardMovimentoFinanceiro is created with parent set to the main form (particularly to a THorzScrollBox)
From INSIDE the TViewStandardMovimentoFinanceiro frame I tried the classical approach of using the Children list and have not found that embedded TFrame.
I have tried also using the Parent`s Children list with no success. Same thing with the Components List
What I want to do is to to locate all available TFrames so I can ask for an interface (I know how to do that)
What am I missing?
Following recommendations bellow I have implemented this code for testing:
function TFrameBase.LocateControl(AControl: TControl; ADomainName: string): TControlHandler;
var
NaharView: INaharView;
ControlHandler: TControlHandler;
i: integer;
begin
result := nil;
for i := 0 to AControl.ChildrenCount - 1 do
if (AControl.Children[i] is TFrame) and (AControl.Children[i] <> Self) then
if Supports((AControl.Children[i] as TFrame), INaharView, NaharView) then
begin
ControlHandler := NaharView.Control[ADomainName];
if Assigned(ControlHandler) then
exit(ControlHandler);
end;
end;
function GetUltimateParent(Control: TControl): TControl;
begin
if Control.Parent is TControl then
Result := GetUltimateParent(TControl(Control.Parent))
else
Result := Control;
end;
function TFrameBase.GetNaharControl(ADomainName: string): TControlHandler;
var
i: integer;
ControlHandler: TControlHandler;
begin
if NaharControls.ContainsKey(ADomainName) then
Exit(NaharControls.Items[ADomainName])
else
begin
ControlHandler := LocateControl(GetUltimateParent(Self), ADomainName);
if Assigned(ControlHandler) then
exit(ControlHandler);
end;
raise EViewControlDomainNameNotFound.Create(ADomainName);
end;
When LocateControl is executed it goes several levels to the top and from there it tries to iterate on Children List, it only contains 3 items in a form form full of controls.
Your function LocateControl need to be recursive, as stated by Ondrej. Something like this
function TFrameBase.LocateControl(AControl: TControl; ADomainName: string): TControlHandler;
var
NaharView: INaharView;
ControlHandler: TControlHandler;
i: integer;
begin
result := nil;
for i := 0 to AControl.ChildrenCount - 1 do
begin
if (AControl.Children[i] is TFrame) and (AControl.Children[i] <> Self) then
begin
if Supports((AControl.Children[i] as TFrame), INaharView, NaharView) then
begin
ControlHandler := NaharView.Control[ADomainName];
if Assigned(ControlHandler) then
begin
exit(ControlHandler);
end;
end;
end;
// recursive bit
Result := LocateControl(AControl.Children[i], ADomainName):
if assigned( Result ) then
begin
exit;
end;
end;
end;

StringGrid Objects - access violation

I am trying to make use of the Objects property of the Stringgrid inside my descendant and I think I am doing something wrong.
So, I created a simple class for use in my StringGrid cells, something like:
type
TKind = (tkNone,tkStart, tkEnd, tkMiddle);
TMyCell = class(TObject)
private
FKind:string; // TKind: start, middle, end, none
FOfType:string; // new, registered, paid, over, none
FActualDate:TDate;
FTheText:string; // if you want to show a text in it
FIsWeekend:Boolean;
function IsItWeekend(dt:Tdate):boolean;
procedure setKind(s:string);
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create;
property Kind:string read FKind write setKind;
property OfType:string read FOfType write FOfType;
property ActualDate:TDate read FActualDate write FActualDate;
property TheText:string read FTheText write FTheText;
property IsWeekend:Boolean read FIsWeekend write FIsWeekend default false;
{ Public declarations }
published
{ Published declarations }
end;
implementation
procedure TMyCell.setKind(s:string);
begin
FKind:=s;
end;
function TMyCell.IsItWeekend(dt:Tdate):boolean;
begin
if (DayOfTheWeek(dt)=6) or (DayOfTheWeek(dt)=7) then IsItWeekend:=true else IsItWeekend:=false;
end;
constructor TMyCell.Create;
var
i:integer;
a,l,z:word;
dt:TDate;
begin
FKind:='none';
FOfType:='none';
FActualDate:=now;
FTheText:='';
FIsWeekend:=IsItWeekend(FActualDate);
end;
then, in my StringGrid descendant (TMyGrid), I do the following:
TMyGrid = class(TStringGrid)
private
FStartSelection:integer;
FFixedColor:TColor;
FRowCount:integer;
...
published
property ColCount;
property RowCount;
...
constructor TMyGrid.Create(AOwner: TComponent);
var
i:integer;
a,l,z:word;
dt:TDate;
j: Integer;
myCell:TMyCell;
begin
inherited;
...// different settings
RowCount:=5;
for i := 0 to colCount-1 do
for j := 0 to RowCount-1 do
begin
Objects[i, j] := TMyCell.Create;
end;
end;
destructor TMyGrid.Destroy;
var
i,j:integer;
begin
for i := 0 to colCount-1 do
for j := 0 to RowCount-1 do
begin
TMyCell(Objects[i, j]).Free;
end;
inherited;
end;
... // other stuff
procedure Register;
begin
RegisterComponents('mygrid', [TMyGrid]);
end;
The problem is I don't know how do I tell my control that there are more rows when the developer changes the RowCount in the objectInspector before running the app.
So I drop my StrinGrid descendant on a form, and set the rowCount to 10. But my StringGrid does not have Objects created for the new rows, So the cells on ARow=5->9 do not have objects created... because in OnCreate I only set the initial value of the RowCount to 5 and create objects for i:=0 to RowCount-1.
Is there an event or method where I can tell the StringGrid to create the Objects after the developer changes the rowCount in ObjectInspector?
I am sure that this is my problem because, using the above code, when I drop my stringGrid on a form and set it's rowCount (design time or runtime) to 10 then I want to assign a value to Kind property of a cell that is on a Row>4 I get an AccessViolation, but if I do that for a row that is <= 4 the assignment works just fine.
I found something that should help here: http://embarcadero.newsgroups.archived.at/public.delphi.ide/200904/0904193279.html
but I do not know how and where to place this code in my StringGrid descendant class so it would get called when RowCount is changed at designtime/runtime
EDIT
After reading your comments I tried your idea (that seemed to work) to override the SizeChanged (I did not know that method existed, must have skipped it when I serached before).
Anyway, I added this code to my class:
TMyGrid = class(TStringGrid)
private
...
procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
procedure UpdateGridDimensions(NewColCount, NewRowCount: Integer);
...
procedure TMyGrid.SizeChanged(OldColCount, OldRowCount: Longint);
begin
inherited;
if (OldRowCount<>FRowCount)or(OldColCount<>ColCount) then
UpdateGridDimensions(ColCount, FRowCount);
end;
procedure TMyGrid.UpdateGridDimensions(NewColCount, NewRowCount: Integer);
var
C, R: Integer;
Old: Integer;
begin
if NewColCount <> ColCount then
begin
if NewColCount < ColCount then
begin
for R := 0 to RowCount-1 do
begin
for C := ColCount-1 downto NewColCount do
Objects[C, R].Free;
end;
end;
Old := ColCount;
ColCount := NewColCount;
if NewColCount > Old then
begin
for R := 0 to RowCount-1 do
begin
for C := Old to NewColCount-1 do
Objects[C, R] := TMyCell.Create;
end;
end;
end;
if NewRowCount <> RowCount then
begin
if NewRowCount < RowCount then
begin
for C := 0 to ColCount-1 do
begin
for R := RowCount-1 downto NewRowCount do
Objects[C, R].Free;
end;
end;
Old := RowCount;
RowCount := NewColCount;
if NewRowCount > Old then
begin
for C := 0 to ColCount-1 do
begin
for R := Old to NewRowCount-1 do
Objects[C, R] := TMyCell.Create;
end;
end;
end;
end;
but now whenever I drop my control on a form, the rowcount is 93... where do I set that rowCount? Because I DONT.
And still, if I increase the RowCount from 93 to something else like 100, then my Objects exist for the first 93 rows but they do not get created for the 93-100 rows...
So the idea sounded great, but it does not work as I expect it...
Any thoughts?
Am I doing it wrong?
// SizeChanged - Called when the size of the grid has changed.
protected
procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
You can override dynamic method SizeChanged and initialize grid according to new size. You can check is it designtime or not (LU RD suggested link). And as David mentioned, it is better to keep Objects property for consumers of component. Create and use your own TList/TObjectList instead.

Displaying item when LVItemGetCaption is being called with EasyListView?

I am trying to implement virtual data mode with EasyListview
From the demo :
procedure TForm1.AddItems(Count: Integer);
var
i: Integer;
begin
// Add items to the listview. Actually the items are added to the first
// group. This group is created automatically when the first item is added.
LV.BeginUpdate;
try
for i := 0 to Count - 1 do
LV.Items.AddVirtual;
finally
LV.EndUpdate;
end;
end;
procedure TForm1.LVItemGetCaption(Sender: TCustomEasyListview;
const Item: TEasyItem; Column: Integer; var Caption: WideString);
begin
case Column of
0: Caption := 'Item ' + IntToStr(Item.Index);
1: Caption := 'Detail ' + IntToStr(Item.Index);
end;
end;
If I add some items which are string :
procedure TForm1.AddItems(Count: Integer);
var
i: Integer;
begin
// Add items to the listview. Actually the items are added to the first
// group. This group is created automatically when the first item is added.
LV.BeginUpdate;
try
for i := 0 to Count - 1 do
begin
LV.Items.AddVirtual.Caption := 'DISPLAY ME ' + IntToStr(i);
end;
finally
LV.EndUpdate;
end;
end;
How to get and displaying the stored virtual caption(=string) when LVItemGetCaption is being called?
If I get the caption with Caption := LV.Items.Items[Item.Index].Caption ; then Stack overflow.
You must add your data object to the item. E.g.:
type
TMyData = class
Caption: string;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
item: TEasyItemVirtual;
MyData: TMyData;
begin
EasyListview1.BeginUpdate;
try
for i := 0 to 100 - 1 do
begin
MyData := TMyData.Create;
MyData.Caption := Format('My Item %D',[i]);
item := EasyListview1.Items.AddVirtual;
item.Data := MyData;
end;
finally
EasyListview1.EndUpdate;
end;
end;
procedure TForm1.EasyListview1ItemGetCaption(Sender: TCustomEasyListview; Item: TEasyItem;
Column: Integer; var Caption: WideString);
begin
case Column of
0: Caption := TMyData(Item.Data).Caption;
1: Caption := TMyData(Item.Data).Caption;
end;
end;
And don't forget to free your object:
procedure TForm1.EasyListview1ItemFreeing(Sender: TCustomEasyListview; Item: TEasyItem);
begin
if Assigned(Item.Data) then
Item.Data.Free;
end;
Virtual nodes are ones that don't store their data. They're just views of data you are expected to already have in some other data structure of your program. When the control needs to display a node, it asks your program what text it should use by firing the OnItemGetCaption event.
In fact, it will call the event any time it needs to know the value of the Caption property, so when you try to handle the caption-fetching event by fetching the value of the caption, you trigger infinite recursion.

Delphi: Shift-Up and Shift-Down in the Listview

Is there a feature in the Listview control to shift items up and down?
Not having worked with TListView very much (I mostly use database grids), I took your question as a chance to learn something. The following code is the result, it is more visually oriented that David's answer. It has some limitations: it will only move the first selected item, and while it moves the item, the display for vsIcon and vsSmallIcon is strange after the move.
procedure TForm1.btnDownClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index<ListView1.Items.Count then
begin
temp := ListView1.Items.Insert(Index+2);
temp.Assign(ListView1.Items.Item[Index]);
ListView1.Items.Delete(Index);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
procedure TForm1.btnUpClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index>0 then
begin
temp := ListView1.Items.Insert(Index-1);
temp.Assign(ListView1.Items.Item[Index+1]);
ListView1.Items.Delete(Index+1);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
You have two options:
Delete them and then re-insert them at the new location.
Use a virtual list view and move them in your data structure.
My routine for doing the first of these options is like this:
procedure TBatchTaskList.MoveTasks(const Source: array of TListItem; Target: TListItem);
var
i, InsertIndex: Integer;
begin
Assert(IsMainThread);
BeginUpdate;
Try
//work out where to move them
if Assigned(Target) then begin
InsertIndex := FListItems.IndexOf(Target);
end else begin
InsertIndex := FListItems.Count;
end;
//create new items for each moved task
for i := 0 to high(Source) do begin
SetListItemValues(
FListItems.Insert(InsertIndex+i),
TBatchTask(Source[i].Data)
);
Source[i].Data := nil;//handover ownership to the new item
end;
//set selection and focus item to give feedback about the move
for i := 0 to high(Source) do begin
FListItems[InsertIndex+i].Selected := Source[i].Selected;
end;
FBatchList.ItemFocused := FListItems[InsertIndex];
//delete the duplicate source tasks
for i := 0 to high(Source) do begin
Source[i].Delete;
end;
Finally
EndUpdate;
End;
end;
The method SetListItemValues is used to populate the columns of the list view.
This is a perfect example of why virtual controls are so great.

delphi 7: How can I find item of object collection?

how can I find by name and get the Item in a collection of object ?
procedure TfoMain.InitForm;
begin
// Liste des produits de la pharmacie 1
FListeDispoProduit := TListeDispoProduit.Create(TProduit);
with (FListeDispoProduit) do
begin
with TProduit(Add) do
begin
Name := 'Produit 01';
CIP := 'A001';
StockQty := 3;
AutoRestock := 1;
QtyMin:= 2;
end;
with TProduit(Add) do
begin
Name := 'Produit 02';
CIP := 'A002';
StockQty := 5;
AutoRestock := 0;
QtyMin:= 2;
end;
function getProductByName(productName: String): TProduit;
var
i : integer;
begin
for i := 0 to fProductList.Count -1 do
begin
if (TProduit(fProductList.Items[i]).Name = productName)
Result :=
end;
end;
I want to edit qty about a product name.
How can I do this?
thank you
If your collection object is a TCollection, then it has an Items property (which you should have been about to see in the documentation, or in the source code). Use that and its Count property to write a loop where you inspect each item to see whether it matches your target.
var
i: Integer;
begin
for i := 0 to Pred(FListeDespoProduit.Count) do begin
if TProduit(FListeDespoProduit.Items[i]).Name = productName then begin
Result := TProduit(FListeDespoProduit.Items[i]);
exit;
end;
end;
raise EItemNotFound.Create;
end;
Items is a default property, which means you can omit it from your code and just use the array index by itself. Instead of FListeDespoProduit.Items[i], you can shorten it to just FListeDespoProduit[i].
function getProductByName(productName: String): TProduit;
var
i : integer;
begin
for i := 0 to fProductList.Count -1 do
begin
if (TProduit(fProductList.Items[i]).Name = productName)
Result := TProduit(fProductList.Items[i]); // this???
end;
end;
You can then go:
MyProduit := getProductByName('banana');
MyProduit.StockQty := 3;
Or whatever you wish.
Your TProduit implements (Add). It doesn't already implement (Get) (or something similar)?
Are you inheriting this code? Is there more detail?
Edit: otherwise you'll have to create the Get procedure yourself, possibly by looping over the list and finding a match, then returning it.

Resources