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

Вниз

Класс для хранения в файле списка списков   Найти похожие ветки 

 
Dmitry_177   (2006-04-25 21:21) [0]

Мне нужно сохранять и загружать из файла список списков, что-то наподобии я сделал, только вот не пойму почему у меня на строке LoadStringsFromStream(TStrings(FSubList.Items[I]), AStream);(в процедуре LoadFromStream) возникает ошибка, при компиляции(выделяется красным)... Подскажите пожалуйста правильно ли я все делаю...

unit MyUtils;

interface
uses Windows, SysUtils, Classes, Contnrs;

type
 TMyClass = class
 private
   FList: TStrings;
   FSubList: TObjectList;
   procedure SetList(const Value: TStrings);
 protected
   procedure SaveToStream(AStream: TStream);
   procedure LoadFromStream(AStream: TStream);
 public
   constructor Create;
   destructor Destroy; override;
   property List: TStrings read FList write SetList;
   property SubList: TObjectList read FSubList write FSubList;
   procedure Clear;
   procedure SaveToFile(AFileName: string);
   procedure LoadFromFile(AFileName: string);
 end;

implementation

{ TMyClass }

constructor TMyClass.Create;
begin
 inherited;
 FList := TStrings.Create;
 FSubList := TObjectList.Create(true);
end;

destructor TMyClass.Destroy;
begin
 Clear;
 FList.Free;
 FSubList.Free;
 inherited;
end;

procedure TMyClass.SetList(const Value: TStrings);
begin
 FList.Assign(Value)
end;

procedure TMyClass.SaveToStream(AStream: TStream);
 procedure SaveStringsToStream(AStrings: TStrings; AStream: TStream);
 var
   Cnt: Int64;
   TempStream: TMemoryStream;
 begin
   if Assigned(AStrings) then
     begin
       TempStream := TMemoryStream.Create;
       try
         AStrings.SaveToStream(TempStream);
         TempStream.Position := 0;
         Cnt := TempStream.Size;
         AStream.Write(Cnt, SizeOf(Cnt));
         AStream.CopyFrom(TempStream, Cnt)
       finally
         TempStream.Free;
       end;
     end;
 end;
var
 I, Cnt: Integer;
begin
 SaveStringsToStream(FList, AStream);

 Cnt := FSubList.Count - 1;
 AStream.Write(Cnt, SizeOf(Integer));
 for I := 0 to Cnt do
   SaveStringsToStream(TStrings(FSubList.Items[I]), AStream);
end;

procedure TMyClass.LoadFromStream(AStream: TStream);
 procedure LoadStringsFromStream(var AStrings: TStrings; AStream: TStream);
 var
   Cnt: Int64;
   TempStream: TMemoryStream;
 begin
   if Assigned(AStrings) then
     begin
       AStream.Read(Cnt, SizeOf(Cnt));
       TempStream := TMemoryStream.Create;
       try
         TempStream.CopyFrom(AStream, Cnt);
         TempStream.Position := 0;
         AStrings.LoadFromStream(TempStream);
       finally
         TempStream.Free;
       end;
     end;
 end;
var
 I, Cnt: Integer;
begin
 Clear;
 LoadStringsFromStream(FList, AStream);

 AStream.Read(Cnt, SizeOf(Cnt));
 for I := 0 to Cnt do
   begin
     FSubList.Add(TStrings.Create);
     LoadStringsFromStream(TStrings(FSubList.Items[I]), AStream);
   end;
end;

procedure TMyClass.Clear;
var
 I, Cnt: Integer;
begin
 FList.Clear;
 Cnt := FSubList.Count - 1;
 for I := Cnt downto 0 do
   TStrings(FSubList.Items[I]).Clear;
 FSubList.Clear;
end;

procedure TMyClass.SaveToFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName, fmCreate);
 try
   SaveToStream(Fs);
 finally
   Fs.Free;
 end;
end;

procedure TMyClass.LoadFromFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName, fmOpenRead);
 try
   LoadFromStream(Fs);
 finally
   Fs.Free;
 end;
end;

end.


 
лшдлуттнсфе   (2006-04-25 21:32) [1]


> begin
>  Clear;
>  LoadStringsFromStream(FList, AStream);
>
>  AStream.Read(Cnt, SizeOf(Cnt));
>  for I := 0 to Cnt do
>    begin
>      FSubList.Add(TStrings.Create);
>      LoadStringsFromStream(TStrings(FSubList.Items[I]),
> AStream);
>    end;
> end;


гениально. Astrim - несильно глобально, а?


 
Гаврила ©   (2006-04-25 23:23) [2]

Потому что у тебя написано

> procedure LoadStringsFromStream(var AStrings:
> TStrings; AStream: TStream);

Убери Var - потому что он тут не нужен.

А вообще, код работать не будет - ошибка на ошибке
вот первая:

>constructor TMyClass.Create;
>begin
> inherited;
>  FList := TStrings.Create;


 
Dmitry_177   (2006-04-26 00:10) [3]

Гаврила, а что тза ошибка: FList := TStrings.Create;??? TStrings не нужно создавать???
TStringList? в FList просто строки (названия списков из FSubLisе)


 
Джо ©   (2006-04-26 00:16) [4]

> TStrings не нужно создавать???

TStrings — это абстрактный класс, у него куча методов абстрактных. Нужно создавать его потомка, реализующего эти методы, например TStringList.


 
Dmitry_177   (2006-04-26 00:21) [5]

А объявлять тоже как TStringList?

private
  FList: TStringList;

а то я видел в некоторых слкчаях объявляют как TStrings а создают TStringList


 
Джо ©   (2006-04-26 00:22) [6]

> А объявлять тоже как TStringList?

Можно и как TStrings.


 
Dmitry_177   (2006-04-26 00:25) [7]

А еще в процедурах в качестве параметра AStrings: TStrings передавать или AStrings: TStringList? Или никакой разницы нету?


 
Джо ©   (2006-04-26 00:31) [8]

Вообще-то, нужно передавать тот тип, который требуется :)
Чаще удобнее передавать TStrings, ибо он базовый и у него много наследников.


 
Dmitry_177   (2006-04-26 00:49) [9]

Сохраняется вроде нормально, но при открытии выскакивает "Abstract Error" =((( Вот использование класса в программе:

var
 MyClass: TMyClass;
...

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyClass := TMyClass.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 MyClass.Free;
end;

// добавление в FList
procedure TForm1.Button1Click(Sender: TObject);
var
 str: string;
begin
 if InputQuery("Warning", "Enter name", str) then
   begin
     MyClass.List.Add(str);
     MyClass.SubList.Add(TStringList.Create);
     ListBox1.Items.Assign(MyClass.List);
   end;
end;

// Удаление из FList
procedure TForm1.Button2Click(Sender: TObject);
begin
 MyClass.List.Delete(ListBox1.ItemIndex);
 MyClass.SubList.Delete(ListBox1.ItemIndex);
 ListBox1.Items.Assign(MyClass.List);
 ListBox2.Clear;
end;

// При выборе строки из ListBox-а загружается нужный по счету список
procedure TForm1.ListBox1Click(Sender: TObject);
begin
 if ListBox1.ItemIndex <> - 1 then
   ListBox2.Items.Assign(TStringList(MyClass.SubList.Items[ListBox1.ItemIndex]));
end;

// добавление строки в один из списков
procedure TForm1.Button3Click(Sender: TObject);
var
 str: string;
begin
 if InputQuery("Warning", "Enter subname", str) then
   begin
     TStringList(MyClass.SubList.Items[ListBox1.ItemIndex]).Add(str);
     ListBox2.Items.Assign(TStringList(MyClass.SubList.Items[ListBox1.ItemIndex]));
   end;
end;

// удаление строки из списка
procedure TForm1.Button4Click(Sender: TObject);
begin
 if (ListBox1.ItemIndex <> - 1) and (ListBox2.ItemIndex <> - 1) then
   begin
     TStringList(MyClass.SubList.Items[ListBox1.ItemIndex]).Delete(ListBox2.ItemIndex );
     ListBox2.Items.Assign(TStringList(MyClass.SubList.Items[ListBox1.ItemIndex]));
   end;
end;

// открытие
procedure TForm1.Openas1Click(Sender: TObject);  // Open
begin
 if OpenDialog1.Execute then
   begin
     ListBox1.Clear;
     ListBox2.Clear;
     MyClass.LoadFromFile(OpenDialog1.FileName);
     ListBox1.Items.Assign(MyClass.List);
   end;
end;

// сохранение
procedure TForm1.Saveas1Click(Sender: TObject);  // Save
begin
 if SaveDialog1.Execute then
   MyClass.SaveToFile(SaveDialog1.FileName);
end;


 
Dmitry_177   (2006-04-26 01:15) [10]

поменял в некоторых местах TString на TStringList вроде заработало =))) Может еще гденибудь надо поменять?

unit MyUtils;

interface
uses Windows, SysUtils, Classes, Contnrs;

type
 TMyClass = class
 private
   FList: TStrings;
   FSubList: TObjectList;
   procedure SetList(const Value: TStrings);
 protected
   procedure SaveToStream(AStream: TStream);
   procedure LoadFromStream(AStream: TStream);
 public
   constructor Create;
   destructor Destroy; override;
   property List: TStrings read FList write SetList;
   property SubList: TObjectList read FSubList write FSubList;
   procedure Clear;
   procedure SaveToFile(AFileName: string);
   procedure LoadFromFile(AFileName: string);
 end;

implementation

{ TMyClass }

constructor TMyClass.Create;
begin
 inherited;
 FList := TStringList.Create;
 FSubList := TObjectList.Create(true);
end;

destructor TMyClass.Destroy;
begin
 Clear;
 FList.Free;
 FSubList.Free;
 inherited;
end;

procedure TMyClass.SetList(const Value: TStrings);
begin
 FList.Assign(Value)
end;

procedure TMyClass.SaveToStream(AStream: TStream);
 procedure SaveStringsToStream(AStrings: TStrings; AStream: TStream);
 var
   Cnt: Int64;
   TempStream: TMemoryStream;
 begin
   if Assigned(AStrings) then
     begin
       TempStream := TMemoryStream.Create;
       try
         AStrings.SaveToStream(TempStream);
         TempStream.Position := 0;
         Cnt := TempStream.Size;
         AStream.Write(Cnt, SizeOf(Cnt));
         AStream.CopyFrom(TempStream, Cnt)
       finally
         TempStream.Free;
       end;
     end;
 end;
var
 I, Cnt: Integer;
begin
 SaveStringsToStream(FList, AStream);

 Cnt := FSubList.Count - 1;
 AStream.Write(Cnt, SizeOf(Integer));
 for I := 0 to Cnt do
   SaveStringsToStream(TStringList(FSubList.Items[I]), AStream);
end;

procedure TMyClass.LoadFromStream(AStream: TStream);
 procedure LoadStringsFromStream(AStrings: TStrings; AStream: TStream);
 var
   Cnt: Int64;
   TempStream: TMemoryStream;
 begin
   if Assigned(AStrings) then
     begin
       AStream.Read(Cnt, SizeOf(Cnt));
       TempStream := TMemoryStream.Create;
       try
         TempStream.CopyFrom(AStream, Cnt);
         TempStream.Position := 0;
         AStrings.LoadFromStream(TempStream);
       finally
         TempStream.Free;
       end;
     end;
 end;
var
 I, Cnt: Integer;
begin
 Clear;
 LoadStringsFromStream(FList, AStream);

 AStream.Read(Cnt, SizeOf(Cnt));
 for I := 0 to Cnt do
   begin
     FSubList.Add(TStringList.Create);
     LoadStringsFromStream(TStringList(FSubList.Items[I]), AStream);
   end;
end;

procedure TMyClass.Clear;
var
 I, Cnt: Integer;
begin
 FList.Clear;
 Cnt := FSubList.Count - 1;
 for I := Cnt downto 0 do
   TStringList(FSubList.Items[I]).Clear;
 FSubList.Clear;
end;

procedure TMyClass.SaveToFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName, fmCreate);
 try
   SaveToStream(Fs);
 finally
   Fs.Free;
 end;
end;

procedure TMyClass.LoadFromFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName, fmOpenRead);
 try
   LoadFromStream(Fs);
 finally
   Fs.Free;
 end;
end;


мне еще интересно вот например TStringList(FSubList.Items[I]).Clear; можно ли вызывать как TStrings?


 
Dmitry_177   (2006-04-26 01:18) [11]

хотя наверно нет... создаем же всетаки TStringList а не TStrings... сори за глупые вопросы, никогда не понимал разницы в них...=(


 
_RusLAN ©   (2006-04-26 10:50) [12]

Dmitry_177   (26.04.06 1:18) [11]
хотя наверно нет... создаем же всетаки TStringList а не TStrings... сори за глупые вопросы, никогда не понимал разницы в них...=(


а вы почитайте про абстрактные классы/методы.
а то как-то несолидно выглядит 8-)

Dmitry_177   (26.04.06 1:15) [10]
поменял в некоторых местах TString на TStringList вроде заработало =))) Может еще гденибудь надо поменять?



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

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

Наверх





Память: 0.5 MB
Время: 0.064 c
9-1130671062
Зм1й
2005-10-30 14:17
2006.06.04
Ошибка при проигрывании Avi


3-1144997749
RomanH
2006-04-14 10:55
2006.06.04
Доступ из БД1 в БД2 одного коннекта


15-1146990913
Gast
2006-05-07 12:35
2006.06.04
День радио


2-1147755522
Daimyo
2006-05-16 08:58
2006.06.04
Erorr


2-1147970308
Freeek
2006-05-18 20:38
2006.06.04
поиск фрагмента текста





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский