Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.04.25;
Скачать: [xml.tar.bz2];

Вниз

сохранение/загрузка ListView в/из файл.   Найти похожие ветки 

 
Klopan   (2004-04-11 00:54) [0]

Пример сохранения и загрузки ListView в файл.


 
Yanis ©   (2004-04-11 01:38) [1]

Не моё. Взыто из FAQ.
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, comctrls,  

StdCtrls;  

 

type
TForm1 = class(TForm)  

ListView1: TListView;  

Button1: TButton;  

Button2: TButton;  

procedure Button1Click(Sender: TObject);  

procedure Button2Click(Sender: TObject);  

private  

procedure SaveListViewToFile(AListView: TListView; sFileName: string);  

procedure LoadListViewToFile(AListView: TListView; sFileName: string);  

 
public
end;

const
Msg1 = "File "%s" does not exist!";  

Msg2 = ""%s" is not a ListView file!";  

 

var
Form1: TForm1;  

 

implementation

{$R *.DFM}

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
//Initialization  

with AListView do  

 
begin  

 
ItemCount := 0;  

SubCount := 0;  

//****  

MySignature := "LVF";  

// ListViewFile  

F := TFileStream.Create(sFileName, fmCreate or fmOpenWrite);  

F.Write(MySignature, SizeOf(MySignature));  

if Items.Count = 0 then  

 
// List is empty  

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  

//Save subitems count  

if SubItems.Count = 0 then SubCount := 0 else SubCount := Subitems.Count;  

F.Write(SubCount, SizeOf(SubCount));  

//Save ImageIndex  

IdxImage := ImageIndex;  

F.Write(IdxImage, SizeOf(IdxImage));  

//Save Caption  

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  

 
//Save Item"s subitems  

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;

procedure TForm1.LoadListViewToFile(AListView: TListView; sFileName: string);
var
F: TFileStream;  

IdxItem, IdxSubItem, IdxImage: Integer;  

W, ItemCount, SubCount: Word;  

pText: PChar;  

PTemp: PChar;  

MySignature: array [0..2] of Char;  

sExeName: string;  

 
begin
with AListView do  

 
begin  

 
ItemCount := 0;  

SubCount := 0;  

sExeName := ExtractFileName(sFileName);  

if not FileExists(sFileName) then  

 
begin  

 
MessageBox(Handle, PChar(Format(Msg1, [sExeName])), "I/O Error", MB_ICONERROR);  

Exit;  

 
end;  

 
F := TFileStream.Create(sFileName, fmOpenRead);  

F.Read(MySignature, SizeOf(MySignature));  

if MySignature <> "LVF" then  

 
begin  

 
MessageBox(Handle, PChar(Format(Msg2, [sExeName])), "I/O Error", MB_ICONERROR);  

Exit;  

 
end;  

 
F.Read(ItemCount, SizeOf(ItemCount));  

Items.Clear;  

for idxItem := 1 to ItemCount do  

 
begin  

 
with Items.Add do  

 
begin  

 
//Read imageindex  

F.Read(SubCount, SizeOf(SubCount));  

//Read imageindex  

F.Read(IdxImage, SizeOf(IdxImage));  

ImageIndex := IdxImage;  

//Read the Caption  

F.Read(w, SizeOf(w));  

pText := StrAlloc(w + 1);  

pTemp := StrAlloc(w + 1);  

F.Read(pTemp^, W);  

StrLCopy(pText, pTemp, W);  

Caption := StrPas(pText);  

StrDispose(pTemp);  

StrDispose(pText);  

if SubCount > 0 then  

 
begin  

 
for idxSubItem := 1 to SubCount do  

 
begin  

 
F.Read(w, SizeOf(w));  

pText := StrAlloc(w + 1);  

pTemp := StrAlloc(w + 1);  

F.Read(pTemp^, W);  

StrLCopy(pText, pTemp, W);  

Items[idxItem - 1].SubItems.Add(StrPas(pText));  

StrDispose(pTemp);  

StrDispose(pText);  

 
end;  

 
end;  

 
end;  

 
end;  

 
F.Free;  

 
end;  

 
end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);
begin
// Save Items and Clear the ListView  

SaveListViewToFile(ListView1, "MyListView.sav");  

ListView1.Items.Clear;  

 
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
// Load Items  

LoadListViewToFile(ListView1, "MyListView.sav");  

 
end;


 
$tranger ©   (2004-04-11 06:45) [2]

А как насчет того, чтобы юзать ListView1.Items.SaveToFile и ListView1.Items.LoadFromFile


 
Maxud ©   (2004-04-11 11:10) [3]


> $tranger ©   (11.04.04 06:45) [2]

Это в какой версии Дельфи появилось?



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.04.25;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.03 c
6-1077909579
Russu
2004-02-27 22:19
2004.04.25
SMTP сервер


1-1081419182
ctrannik
2004-04-08 14:13
2004.04.25
Работа со звуком


9-1067193863
dn
2003-10-26 21:44
2004.04.25
Движки


6-1078079135
LAndreyL
2004-02-29 21:25
2004.04.25
есть ли в Delphi7 аналог TNMHttp из Delphi5?


4-1071588254
Vasiliy
2003-12-16 18:24
2004.04.25
Как на время отключить только клавиатуру





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский