Solved

good methode to dublicate a TList

Posted on 2010-09-24
8
1,580 Views
Last Modified: 2012-05-10
I#m  working with 2 TList instances

I need a copy / clone of the orginal List,

only copy the List with Blist assign AList , but when I do freeList B also Items inside List A are free.

Any more flexible more general solution ?
BList .Assign(AList)  ;



my Solution :



procedure DublicateLists(ALIst, BList : TList)

begin



       for i := 0 to ALIst.Count -1 do 

          begin

                aListPtr := AList.Items[i];





               new (BListPtr);



               BLIstPtr^. .....   :=   ALitsPtr^. ......





               BList.add(BListPtr);

          

          end;

end;

Open in new window

0
Comment
Question by:BdLm
  • 4
  • 3
8 Comments
 
LVL 25

Expert Comment

by:epasquier
ID: 33752541
you can't with TList without knowing what kind of data it contains.
what do you put in your TList ?
0
 
LVL 8

Author Comment

by:BdLm
ID: 33752574
inside the List  , aListPtr are stores  ,  defined as a record ;

aListPtr = record

      adata  : string;
      bdata  :  integer
      ......
  end;


won't read out the values of  AlIst // AListItemPtr  and copy value by value to a new BListItemPtr , that is the point
Solution sould be univeral and not only valid for my defined type of List Items

 

0
 
LVL 9

Assisted Solution

by:auke_t
auke_t earned 100 total points
ID: 33752704
0
 
LVL 25

Accepted Solution

by:
epasquier earned 400 total points
ID: 33752757
Here is a complete sample project that show how TList with pointers on records should be handled in those scenarios :
- creation
- deletion of 1 element, with item memory disposal
(TList.Delete would not free the memory pointed by the pointer stored in the list)
- element copy
- list destruction

Add will add a random item in first list. they are displayed like : HexaAddress ID Name
ex: 02099F78 0 AAFW
Use Ren and Del button with the item selected in the first list to rename and delete that item. You can then check that it did not alter the second list

Use Copy to clear the second list and copy all the first list in it

have fun !
unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls;



type

  TForm1 = class(TForm)

    btnAdd: TButton;

    lst1: TListBox;

    lst2: TListBox;

    btnDel: TButton;

    btnCopy: TButton;

    btnRen: TButton;

    procedure btnAddClick(Sender: TObject);

    procedure btnDelClick(Sender: TObject);

    procedure btnRenClick(Sender: TObject);

    procedure btnCopyClick(Sender: TObject);

  private

    { Déclarations privées }

    _NewID:Integer;

  public

    { Déclarations publiques }

  end;



var

  Form1: TForm1;



implementation



{$R *.DFM}



Type

  TRec=Record

        ID:Integer;

        Name:String;

       end;

  pRec=^TRec;



Var

 L1,L2:TList;



function ItemString( p:pRec ):String;

Var

 Name:String;

begin

 try

  Name:=p^.Name;

 except

  Name:='Err';

 end;

 Result:=Format('%8.8x %d %s', [Integer(p), p^.ID, Name]);

end;



function CopyRec(p:pRec):pRec;

begin

 New(Result);

 Result^:=p^;

// Move(p^,Result^,SizeOf(Result^)); do not use Move if you have strings

end;



procedure ShowItems(lb:TListBox;L:TList);

Var

 i:integer;

begin

 lb.Clear;

 for i:=0 to L.Count-1 do lb.Items.Add(ItemString(pRec(L[i])));

end;



procedure DeleteItem(L:TList;i:integer);

begin

 if (i<0) Or (i>=L.Count) Then Exit;

 try

  Dispose(pRec(L[i]));

 except

  ShowMessage('Error while deleting item '+IntToStr(i));

 end;

 L.Delete(i);

end;



procedure ClearList(L:TList);

begin

 while L.Count>0 do DeleteItem(L,L.Count-1);

end;



function RandomName:String;

Var i:integer;

begin

 Result:='';

 for i:=0 to 3 do Result:=Result+Char(Random(26)+65);

end;



procedure TForm1.btnAddClick(Sender: TObject);

Var

 NewItem:pRec;

begin

 New(NewItem);

 NewItem^.ID:=_NewID;

 Inc(_NewID);

 NewItem^.Name:=RandomName;

 L1.Add(NewItem);

 ShowItems(lst1,L1);

end;



procedure TForm1.btnDelClick(Sender: TObject);

begin

 if lst1.ItemIndex>=0 Then

  begin

   DeleteItem(L1,lst1.ItemIndex);

   ShowItems(lst1,L1);

   ShowItems(lst2,L2);

  end;

end;



procedure TForm1.btnRenClick(Sender: TObject);

begin

 if lst1.ItemIndex>=0 Then

  begin

   pRec(L1[lst1.ItemIndex])^.Name:=RandomName;

   ShowItems(lst1,L1);

   ShowItems(lst2,L2);

  end;

end;



procedure TForm1.btnCopyClick(Sender: TObject);

Var i:integer;

begin

 ClearList(L2);

 for i:=0 to L1.Count-1 do L2.Add(CopyRec(pRec(L1[i])));

 ShowItems(lst1,L1);

 ShowItems(lst2,L2);

end;



initialization

 L1:=TList.Create;

 L2:=TList.Create;

finalization

 ClearList(L1);

 ClearList(L2);

 L1.Free;

 L2.Free;

end.





// DFM



object Form1: TForm1

  Left = 412

  Top = 122

  Width = 428

  Height = 384

  Caption = 'Form1'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch = 96

  TextHeight = 13

  object btnAdd: TButton

    Left = 8

    Top = 8

    Width = 60

    Height = 25

    Caption = 'Add'

    TabOrder = 0

    OnClick = btnAddClick

  end

  object lst1: TListBox

    Left = 8

    Top = 40

    Width = 185

    Height = 297

    ItemHeight = 13

    TabOrder = 1

  end

  object lst2: TListBox

    Left = 208

    Top = 40

    Width = 185

    Height = 297

    ItemHeight = 13

    TabOrder = 2

  end

  object btnDel: TButton

    Left = 72

    Top = 8

    Width = 60

    Height = 25

    Caption = 'Del'

    TabOrder = 3

    OnClick = btnDelClick

  end

  object btnCopy: TButton

    Left = 208

    Top = 8

    Width = 60

    Height = 25

    Caption = 'Copy'

    TabOrder = 4

    OnClick = btnCopyClick

  end

  object btnRen: TButton

    Left = 136

    Top = 8

    Width = 60

    Height = 25

    Caption = 'Ren'

    TabOrder = 5

    OnClick = btnRenClick

  end

end

Open in new window

0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 8

Author Comment

by:BdLm
ID: 33752762
:-)   excactly what I have been looking for !!!
0
 
LVL 25

Expert Comment

by:epasquier
ID: 33752770
If you like it much, you can raise points for this question :o) I did it just for you
0
 
LVL 8

Author Comment

by:BdLm
ID: 33759589
you helped bvery fast .....
0
 
LVL 8

Author Closing Comment

by:BdLm
ID: 33759593
very very fast response this time by ee forum ....  below 1 minute !!!!
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now