проблемы с использованием TList

[coyot.rush]

Сделал "обертку" к записи по примеру http://www.excode.ru/art5623p6.html
но возникла проблема при получение поля значения типа msestring, значение получаются "левые".

Код: Выделить всё

{ TV }
type tvnorm=(NTSC,NTSC_M,NTSC_M_JP,NTSC_M_KR,PAL,PAL_BG,
PAL_H,PAL_I,PAL_DK,PAL_M,PAL_N,PAL_Nc,PAL_60,SECAM,SECAM_B,
SECAM_G,SECAM_H,SECAM_DK,SECAM_L,SECAM_Lc);
const
TvStr : array [tvnorm] of String [20] =('NTSC','NTSC-M','NTSC-M-JP','NTSC-M-KR','PAL','PAL-BG',
'PAL-H','PAL-I','PAL-DK','PAL-M','PAL-N','PAL-Nc','PAL-60','SECAM','SECAM-B',
'SECAM-G','SECAM-H','SECAM-DK','SECAM-L','SECAM-Lc'); 


type
 tmainfo = class(tmainform)
   l_Name: tlabel;
   l_freq: tlabel;
   l_norm: tlabel;
   e_Name: tstringedit;
   e_norm: tstringedit;
   tlabel1: tlabel;
   e_count: tstringedit;
   tbutton1: tbutton;
   tbutton2: tbutton;
   tdatabutton1: tdatabutton;
   e_freq: tstringedit;
   procedure _init(const sender: TObject);
   procedure _prev(const sender: TObject);
   procedure _next(const sender: TObject);
 end;
 
 type
PTVData = ^TTVData;
TTVData = record
Name:msestring;
Norm:tvnorm;
Freq: integer;
end;

{ TTVDataList }

TTVDataList = class
private
FTVList: TList; // хранилище данных
public
constructor Create;
destructor Destroy; override;
function AddItem(Item: TTVData): Integer;
procedure RemoveItem(ItemIndex: Integer);
function GetData(Idx: integer): TTVData;
function Count: integer;
procedure Exchange(idx1, idx2: integer);
end;
 
var
 mainfo: tmainfo;
 Count:integer;
 data:ttvdatalist;
implementation
uses
 main_mfm,sysutils;
 
function TTVDataList.AddItem(Item: TTVData): Integer;
var p: PTVData;
begin
GetMem(p, SizeOf(Item{TTVData})); // выделением памяти занимаемся самостоятельно
Move(Item, p^, SizeOf(Item{TTVData}));
Result := FTVList.Add(p); // просто перенаправляем вызов
end;

function TTVDataList.Count: integer;
begin
Result := FTVList.Count; // просто перенаправляем вызов
end;

constructor TTVDataList.Create;
begin
inherited Create;
FTVList := TList.Create; // не забываем создать объект
end;

destructor TTVDataList.Destroy;
begin
FTVList.Free; // уничтожаем объект
inherited Destroy;
end;

procedure TTVDataList.Exchange(idx1, idx2: integer);
begin
FTVList.Exchange(idx1, idx2); // просто перенаправляем вызов
end;

function TTVDataList.GetData(Idx: integer): TTVData;
begin
//FillChar(Result, SizeOf(TTVData), #0);
Result := TTVData(FTVList.Items[Idx]^); // перенаправляем вызов и приводим к TTVData
end;



procedure TTVDataList.RemoveItem(ItemIndex: Integer);
begin
FreeMem(FTVList[ItemIndex]); // освобождаем память тоже сами
FTVList.Delete(ItemIndex);
end;       


procedure showitem(Idx:integer);
var
tmp:Ttvdata;
begin
tmp:=data.GetData(Count);
mainfo.e_name.value:=tmp.Name;
mainfo.e_freq.value:=inttostr(tmp.Freq);
mainfo.e_norm.value:=tvstr[tmp.norm];
mainfo.e_count.value:=inttostr(Count);
end;

 
procedure tmainfo._init(const sender: TObject);
var
i:integer;
tmp:Ttvdata;
begin
data:=ttvdatalist.create;
for i:=0 to 10 do
begin
tmp.name:='name='+inttostr(i);
tmp.freq:=i*5;
tmp.norm:=secam;
data.additem(tmp);
end;

Count:=0;
showitem(Count);

end;

procedure tmainfo._prev(const sender: TObject);
begin
if Count>0 then dec(count);
showitem(Count);
end;

procedure tmainfo._next(const sender: TObject);
begin
if Count<data.count-1 then inc(Count);
showitem(Count);
end;

PS:просто хотел добавить к alsmplayer хранение название канала в списке
ОС:linux 32, fpc 2.4.2

[Sergei I. Gorelkin]

Не проблемы с TList, а неправильная работа с записями, имеющими поля управляемых типов. GetMem, FreeMem и Move использовать нельзя, вместо них нужны New, Dispose и оператор присваивания соответственно. В исходниках класса TStringList в общем-то, можно подсмотреть, как это делается.

[coyot.rush]

Не проблемы с TList, а неправильная работа с записями, имеющими поля управляемых типов. GetMem, FreeMem и Move использовать нельзя, вместо них нужны New, Dispose и оператор присваивания соответственно. В исходниках класса TStringList в общем-то, можно подсмотреть, как это делается.

Смотрел только там move, но из System

Код: Выделить всё

Function TStringList.Add(const S: string): Integer;

begin
  If Not Sorted then
    Result:=FCount
  else
    If Find (S,Result) then
      Case DUplicates of
        DupIgnore : Exit;
        DupError : Error(SDuplicateString,0)
      end;
   InsertItem (Result,S);
end; 

Procedure TStringList.InsertItem(Index: Integer; const S: string);
begin
  Changing;
  If FCount=Fcapacity then Grow;
  If Index<FCount then
    System.Move (FList^[Index],FList^[Index+1],
                 (FCount-Index)*SizeOf(TStringItem));
  Pointer(Flist^[Index].Fstring):=Nil;  // Needed to initialize...
  Flist^[Index].FString:=S;
  Flist^[Index].Fobject:=Nil;
  Inc(FCount);
  Changed;
end; 

Добавлено спустя 8 минут 40 секунд:

поля управляемых типов

т.е. динамические массивы данных? Просто такого термина не знаю

[Sergei I. Gorelkin]

Смотрел только там move, но из System

Там все чуть-чуть оптимизировано... Видишь строчкой ниже присвоение nil? В сочетании с Move получается, что указатель на строку не копируется, а переносится на новое место (удаляется со старого). Без этого последующее присвоение S освободит память, которую занимала бывшая на этом месте (и которая теперь на месте index+1) строка, и чтение index+1 даст мусор и просто упадет. Как-то так.

т.е. динамические массивы данных? Просто такого термина не знаю

Строки типа AnsiString, WideString, UnicodeString, COM-интерфейсы, динамические массивы, Variant.

[coyot.rush]

System.Move не только копирует но и распределяет память

Видишь строчкой ниже присвоение nil?

старые "грабли" от Delphi, зачем в режиме objfpc оставили?
http://www.delphisources.ru/pages/faq/faq_delphi_basics/Move.php.html

Код: Выделить всё

Примечания
Первоначальные данные всегда сохраняются, если перемещая из и в текущюю строку - то название Move не очень информативно.
Нет никакого проверки области памяти, на которые ссылаются - будте внимательны во всех операциях в напрямую с памятью таких как эта. 

[Sergei I. Gorelkin]

System.Move не только копирует но и распределяет память

Нет, не распределяет

старые "грабли" от Delphi, зачем в режиме objfpc оставили?

Код RTL один и тот же для всех режимов

[coyot.rush]

Код: Выделить всё

System.Move (FList^[Index],FList^[Index+1],
                 (FCount-Index)*SizeOf(TStringItem));

FList^[Index+1] откуда берется?

[Sergei I. Gorelkin]

Нужно вставить элемент на место index - значит все элементы начиная с index нужно сдвинуть на место index+1.
Это при вставке, при добавлении этот код не исполняется.

[coyot.rush]

Это при вставке, при добавлении этот код не исполняется.

не заметил условие
Но не ясно как все таки выделяется память при добавление нового элемента

Код: Выделить всё

If FCount=Fcapacity then Grow;

?

[Sergei I. Gorelkin]

If FCount=Fcapacity then Grow;

Выделяется именно так, причем выделяется по несколько элементов сразу.

[coyot.rush]

Код: Выделить всё

Procedure TStringList.SetCapacity(NewCapacity: Integer);

Var NewList : Pointer;
    MSize : Longint;

begin
  If (NewCapacity<0) then
     Error (SListCapacityError,NewCapacity);
  If NewCapacity>FCapacity then
    begin
    GetMem (NewList,NewCapacity*SizeOf(TStringItem));
    If NewList=Nil then
      Error (SListCapacityError,NewCapacity);
    If Assigned(FList) then
      begin
      MSize:=FCapacity*Sizeof(TStringItem);
      System.Move (FList^,NewList^,MSize);
      FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
      FreeMem (Flist,MSize);
      end;
    Flist:=NewList;
    FCapacity:=NewCapacity;
    end
  else if NewCapacity<FCapacity then
    begin
    if NewCapacity = 0 then
    begin
      FreeMem(FList);
      FList := nil;
    end else
    begin
      GetMem(NewList, NewCapacity * SizeOf(TStringItem));
      System.Move(FList^, NewList^, NewCapacity * SizeOf(TStringItem));
      FreeMem(FList);
      FList := NewList;
    end;
    FCapacity:=NewCapacity;
    end;
end; 

GetMem, FreeMem и Move использовать нельзя, вместо них нужны New, Dispose и оператор присваивания соответственно

Так все таки как правильно распределять память для записи содержащей строку ?

Код: Выделить всё

function TTVDataList.AddItem(Item: TTVData): Integer;
var p: PTVData;
begin
New(p);
p:=@Item;
Result := FTVList.Add(p); // просто перенаправляем вызов
end;

Код: Выделить всё

function TTVDataList.GetData(Idx: integer): TTVData;
var
tmp:TTVData;
begin
FillChar(Result, SizeOf(TTVData), #0);
tmp:=TTVData(FTVList.Items[Idx]^);
Result :=tmp; // перенаправляем вызов и приводим к TTVData
end;

[zub]

Код: Выделить всё

function TTVDataList.AddItem(Item: TTVData): Integer;
var p: PTVData;
begin
New(p);
p^:=Item;
Result := FTVList.Add(p);
end;

Sergei I. Gorelkin
В делфи new и dispose - deprecated. В fpc такого не случится?
млжно ли какнибудь изловчиться чтобы использовать чтот типа new и dispose из RTL для типов не определенных при компиляции, определенных в рантайме, для подобия скриптового движка?

[coyot.rush]

zub thx

Код: Выделить всё

p:=@Item;

присвоение указателя @Item указателю p указателя TTVDATA

[Sergei I. Gorelkin]

Мдя, походу я зря привел в пример TStringList. Откуда-то было подсознательное ощущение, что там нормальная работа с записями, содержащими строки, а там можно только запутаться с непривычки... Впрочем, работает оно вроде бы правильно.

В делфи new и dispose - deprecated. В fpc такого не случится?

Не случится. И про Дельфи для меня новость, вроде records with methods у них недавно появилось, как их предполагается создавать-то?

млжно ли какнибудь изловчиться чтобы использовать чтот типа new и dispose из RTL для типов не определенных при компиляции, определенных в рантайме, для подобия скриптового движка?

Вряд ли

[zub]

>>И про Дельфи для меня новость
точно, не deprecated... чето я напутал