VPF::потоков в Turbo Vision - Форум программистов

bobsvt

Дата 2.9.2008, 08:06 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 53
Регистрация: 2.9.2008

Репутация: нет
Всего: нет

Задача сотоит в следующем, при использовании библиотеки Turbo Vision в pascal нужно создать коллекцию, привезат ее к потоку, и при выходе из пограммы поток должен сохраняться в указаный файл, при згрузке загружал сохраненый поток в коллекцию.

Ниже код не работает не могу понять почему....

Код


uses app,objects, views, drivers, menus, msgbox, TextView, Dialogs;

   type

   {Основные поля и методы}
       Tproject=object(Tapplication)
       procedure InitstatusLine; Virtual;
       procedure InitmenuBar; Virtual;
       constructor init;
       destructor done; Virtual;
   end;

   {Создание коллекции}
       PMeloman = ^TMeloman;
       TMeloman = object(Tobject)
       Ispolnitel: Pstring;
       Albom: Pstring;
       God: Pstring;
       Constructor Init(I,A,G: String);
       constructork`kbr,jkbr Load(S: TDosStream);
       procedure store(S: TdosStream);
       Destructor Done; Virtual;
   end;

   TsreamRec = record
   ObjType: Word;
   VmtLink: Word;
   load: Pointer;
   Store: Pointer;
   Next: Word;
   end;


  {Объявление переменных}
   Var f: string;
   Var AlbomL: Pcollection;
   Var dialvvod: Tdatavvod;
   Var fi: text;
   Var SaveFile :TDosStream;

{Объявления констант}
const cmViewA=101;
cmADD=102;
cm1=103;
RMeloman: TstreamRec=(
ObjType: 2000;
VmtLink: Ofs(TypeOF(Tmeloman)^);
Load: @Tmeloman.load;
Store: @Tmeloman.Store);

   {Конструктор коллекции}
   Constructor TMeloman.init(I,A,G: String);
   begin
     Ispolnitel:=Newstr(i);
     Albom:=Newstr(A);
     God:=Newstr(G);
   end;

   {Деструктор коллекции}
   destructor Tmeloman.Done;
   begin
     dispose(Ispolnitel);
     dispose(Albom);
     dispose(God);
   end;



   constructor TMeloman.load(S:TDosstream);
   begin
   Ispolnitel:=s.readstr;
   Albom:=s.readstr;
   god:=s.readstr;
   end;


   Procedure TMeloman.store(s: TDosstream);
   begin
   S.writeStr(Ispolnitel);
   S.writeStr(Albom);
   S.writeStr(God);
   end;



   constructor Tproject.init;

   begin
     inherited init;

     {Задаем размерность коллекции, и шаг увелечения}
     AlbomL:=New(Pcollection, init(10,5));

     {добавляю элементы коллекции}
   AlbomL^.Insert(New(PMeloman, Init('Depeche','Exciter','2008')));
   AlbomL^.Insert(New(PMeloman, Init('DDD', 'DDDD','2007')));

    RegisterType(RMeloman); {Регистрирую объект с потоком}
    {Зугружаю ранее сохранеые элементы} -  НЕ РАБОТАЕТ
[color=red]    Savefile.init('C:\albom.res',stOpenRead);
    AlbomL:=Pcollection(SaveFile.Get);
    savefile.done; [/color]    

   end;

   destructor TProject.done; 
   begin
{НЕ РАБОТАЕТ}
[color=red]   SaveFile.init('c:\albom.res',stOpenWrite);
   SaveFile.Put(AlbomL);
   SaveFile.done;[/color]
   end;


   var proj: Tproject;
    begin
    proj.init;
    proj.run;
    proj.done;
    end.

Alexeis

Дата 2.9.2008, 09:15 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: нет
Всего: 459

M
Alexeis

Перенесено из раздела Дельфи

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

volvo877

Дата 2.9.2008, 10:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

bobsvt, смотри:

Код


uses app,objects, views, drivers, menus, msgbox, TextView, Dialogs;

type
  PMeloman = ^TMeloman;
  TMeloman = object(Tobject)
    Ispolnitel: Pstring;
    Albom: Pstring;
    God: Pstring;

    Constructor Init(I,A,G: String);
    constructor Load(S: TDosStream);
    procedure store(S: TdosStream);
    Destructor Done; Virtual;

    procedure print;
  end;

  { Это коллекция для хранения твоих записей !!! }
  PMelomancoll = ^TMelomancoll;
  TMelomanColl = object(TCollection)
  end;

const
  { регистрировать будем обе коллекции }
  RMeloman: TstreamRec=(
    ObjType: 55001;
    VmtLink: Ofs(TypeOF(Tmeloman)^);
    Load: @Tmeloman.load;
    Store: @Tmeloman.Store
  );

  RMelomanColl: TStreamRec=(
    ObjType: 55002;
    VmtLink: Ofs(TypeOF(TmelomanColl)^);
    Load: @Tmelomancoll.load;
    Store: @Tmelomancoll.Store
  );

Constructor TMeloman.init(I,A,G: String);
begin
  inherited init;
  Ispolnitel:=Newstr(i);
  Albom:=Newstr(A);
  God:=Newstr(G);
end;

destructor Tmeloman.Done;
begin
  dispose(Ispolnitel);
  dispose(Albom);
  dispose(God);
end;

constructor TMeloman.load(S:TDosstream);
begin
  Ispolnitel:=s.readstr;
  Albom:=s.readstr;
  god:=s.readstr;
end;

Procedure TMeloman.store(s: TDosstream);
begin
  S.writeStr(Ispolnitel);
  S.writeStr(Albom);
  S.writeStr(God);
end;

{ это - для теста, лень было возиться с TV-стилем, сделал по простому }
procedure tmeloman.print;
begin
  writeln(ispolnitel^, ' ', albom^, ' ', god^);
end;

{ процедура просто печатает содержимое коллекции на экран }
procedure ViewCollection (C: PmelomanColl);
  procedure CallPrint (P : Pmeloman); far;
  begin
    P^.Print;
  end;
begin { Print }
  Writeln;
  Writeln ('List:');
  C^.ForEach (@CallPrint);
  readln;
end;

{ теперь твой главный объект: }
type
  Tproject=object(Tapplication) { main project }
    {procedure InitstatusLine; Virtual;}
    {procedure InitmenuBar; Virtual;}
    constructor init;
    destructor done; Virtual;

    procedure run; virtual;
  end;

var
  AlbomL: PMelomanColl;
  SaveFile :TdosStream;
   {Var dialvvod: Tdatavvod;}
   {Var fi: text;}

const
  cmViewA = 101;
  cmADD   = 102;
  cm1     = 103;

constructor Tproject.init;
begin
  inherited init;
end;

{
  я при первом запуске добавлял записи в коллекцию,
  а чтение из потока комментировал, при последующих - наоборот...
}
procedure tproject.run;
var P: PMeloman;
begin
  AlbomL:=New(Pmelomancoll, init(10,5));
  (*
     P := New(PMeloman, Init('Depeche','Exciter','2008'));
     albomL^.insert(p);
     P := New(PMeloman, Init('DDD', 'DDDD','2007'));
     AlbomL^.Insert(p);
  *)

  Savefile.init('G:\albom.res',stOpenRead); { <--- файл открывается для чтения !!! }
  AlbomL:=Pmelomancoll(SaveFile.Get);
  savefile.done;
  if savefile.status <> stOk then begin
    writeln('error: ', savefile.status);
  end;
  viewcollection(alboml);

end;

destructor TProject.done;
begin
  SaveFile.init('g:\albom.res',stCreate); { чтобы создать файл - stCreate !!! }
  { SaveFile.init('g:\albom.res',stOpenWrite); }
  SaveFile.Put(AlbomL);
  SaveFile.done;

  inherited done;
end;

var
  proj: Tproject;
begin
  RegisterType(RMeloman); { регистрируем типы в самом начале }
  RegisterType(RMelomancoll);

  proj.init;
  proj.run;
  proj.done;
end.

Добавляй проверку, если файл RES уже существует, то открывай его для записи, но для создания ты обязан делать stCreate... И обрабатывай ошибки, они могут о многом рассказать (как это делается, я показал) smile

bobsvt

Дата 3.9.2008, 06:39 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 53
Регистрация: 2.9.2008

Репутация: нет
Всего: нет

Спасибо огромное!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »