Thursday, March 08, 2007

const
Msg1 = 'Soubor "%s" neexistuje !';
Msg2 = '"%s" není soubor s ListView daty !';

procedure TForm1.SaveListViewToFile(AListView: TListView; sFileName: string);
var
idxItem, idxSub, IdxImage : integer;
F : TFileStream;
pText : PChar;
sText : string;
W, ItemCount, SubCount : word;
MySignature : array [0..2] of char;
begin
with AListView do
begin
ItemCount := 0;
SubCount := 0;
MySignature := 'LVF';
F := TFileStream.Create(sFileName, fmCreate or fmOpenWrite);
F.Write(MySignature, sizeof(MySignature));
if Items.Count = 0 then ItemCount := 0
else ItemCount := Items.Count;
F.Write(ItemCount, Sizeof(ItemCount));
if Items.Count > 0 then
begin
for idxItem := 1 to ItemCount do
begin
with items[idxItem - 1] do
begin
if SubItems.Count = 0 then SubCount := 0
else SubCount := Subitems.Count;
F.Write(SubCount, Sizeof(SubCount));
IdxImage := ImageIndex;
F.Write(IdxImage, Sizeof(IdxImage));
sText := Caption;
w := length(sText);
pText := StrAlloc(Length(sText) + 1);
StrPLCopy(pText, sText, Length(sText));
F.Write(w, sizeof(w));
F.Write(pText^, w);
StrDispose(pText);
if SubCount > 0 then
begin
for idxSub := 0 to SubItems.Count - 1 do
begin
sText := SubItems[idxSub];
w := length(sText);
pText := StrAlloc(Length(sText) + 1);
StrPLCopy(pText, sText, Length(sText));
F.Write(w, sizeof(w));
F.Write(pText^, w);
StrDispose(pText);
end;
end;
end;
end;
end;
F.Free;
end;
end;

Labels: