Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Сохранение файлов в одном

Автор: pushok 30.7.2010, 09:38

Здравствуйте.

Пытаюсь в один файл (поток TFileStream) запихнуть информацию разного рода.

Для начала запихнул строку и число - получилось.

Далее попытался добавить картинку, но здесь у меня возникла проблема:

мне в программе надо в переменной (или в объекте, наверное лучше будет сделать объект) иметь текстовые, числовые данные, а также изображения. Строки и числа будут статическими переменными и здесь проблем не возникает.

Пытался сохранять из компонентов (использовал TImage): оказалось там есть TBitmap и TGraphic и, как я понимаю, отображается один из двух.
1. Что мне нужно использовать??
2. Какой из них сможет хранить и загружать изображения разного формата?

3. А главное как их сохранять?

Правильно ли я пытаюсь сохранить?

Код


procedure TForm1.Button1Click(Sender: TObject);
var
i,k:integer;
k1:Int64;
s1:string;
fs:TFileStream;
fs2:TMemoryStream;
begin
i:=59;
s1:='Fifty Nine';
fs:=TFileStream.Create('1.myt',fmCreate);
fs.Write(i,SizeOf(Integer));
k:=Length(s1);
fs.Write(k,SizeOf(Integer));
fs.Write(s1[1],Length(s1)*SizeOf(Char));
fs2:=TMemoryStream.Create;
form1.Image1.Picture.Bitmap.SaveToStream(fs2);
k1:=fs2.Size;
fs.Write(k1,SizeOf(Int64));
fs.CopyFrom(fs2,k1);
fs.Free;
fs2.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i,k:integer;
k1:Int64;
s1:string;
fs:TFileStream;
fs2:TMemoryStream;
begin
fs:=TFileStream.Create('1.myt',fmOpenRead);
fs.Read(i,SizeOf(Integer));
fs.Read(k,SizeOf(Integer));
SetLength(s1,k);
fs.Read(s1[1],k*SizeOf(Char));
fs.Read(k1,SizeOf(Int64));
fs2:=TMemoryStream.Create;
fs.Read(fs2,k1);
fs.Free;
form1.Image1.Picture.Bitmap.LoadFromStream(fs2);
fs2.Free;
end;

Ситуация такая: загружаю картинку в Image1. Сохраняю в файл (при этом выводя сообщение о размере потока fs2 при сохранении получаю какое-то не нулевое число). После сохранения изображение из Image 1 исчезает. Пытаюсь открыть: число и строка считываются нормально, ошибок не появляется, но и в Image1 также ничего не появляется...

Ничего не понятно.

4. И еще вопрос. Если в последствии мне понадобиться сохранять и отображать форматированный текст (например формат .doc). Это реально? Как мне его хранить (TStringList вроде не подходит) ? Какие компоненты использовать для отображения?

Заранее благодарю за прояснение обстановки = )

Автор: Amphiluke 30.7.2010, 11:41

Попробуйте использовать временный буфер для чтения из одного потока в другой.

Код


procedure TForm1.Button2Click(Sender: TObject);
var
  i,k:integer;
  k1:Int64;
  s1:string;
  fs:TFileStream;
  fs2:TMemoryStream;
  p: Pointer;
begin
  fs:=TFileStream.Create('1.myt',fmOpenRead);
  try
    fs.Read(i,SizeOf(Integer));
    fs.Read(k,SizeOf(Integer));
    SetLength(s1,k);
    fs.Read(s1[1],k*SizeOf(Char));
    fs.Read(k1,SizeOf(Int64));
    fs2:=TMemoryStream.Create;
    try
      GetMem(p, k1);
      try
        fs.Read(p^,k1);
        fs2.Write(p^, k1);
      finally
        FreeMem(p, k1);
      end;
      fs2.Seek(0, soFromBeginning);
      form1.Image1.Picture.Bitmap.LoadFromStream(fs2);
    finally
      fs2.Free;
    end;
  finally
    fs.Free;
  end;
end;

Добавлено через 2 минуты и 48 секунд
А, еще. В процедуре сохранения можно заменить

Цитата(pushok @ 30.7.2010, 13:38

)

fs.CopyFrom(fs2,k1);

на

Код


fs.CopyFrom(fs2,0);

Все равно копируете всё содержимое.

Автор: Akella 30.7.2010, 12:52

А если создать запись Record с разными полями и сохранять её в поток?

Автор: Snowy 30.7.2010, 13:22

Код

type
  TObjWriter = class(TWriter) // писалка
  public
    procedure WriteObject(obj: TPersistent);
  end;
  TObjReader = class(TReader)
    procedure ReadObject(obj: TPersistent);
  end;

procedure TObjWriter.WriteObject(obj: TPersistent); // читалка
begin
    WriteListBegin;
    WriteProperties(obj);
    WriteListEnd;
end;

// теперь тест

procedure TObjReader.ReadObject(obj: TPersistent);
begin
  ReadListBegin;
  while not EndOfList do ReadProperty(obj);
  ReadListEnd;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  p:  TJpegImage;
  fs: TFileStream;
begin
  p := TJPEGImage.Create;
  p.LoadFromFile('C:\cat1.jpg'); // берём картинку
  try
    fs := TFileStream.Create('C:\qqq.qqq', fmCreate or fmOpenWrite); // мегафайлик
    with TObjWriter.Create(fs, 1) do
    try
      WriteObject(p); // пишем картинку
      WriteString('Test String'); // пишем строку
      WriteDate(now); // пишем дату
      WriteSingle(300); // пишем число
    finally
      Free;
    end;
    fs.Free;
    except end;
  p.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  p:  TJpegImage;
  fs: TFileStream;
begin
  try
    fs := TFileStream.Create('C:\qqq.qqq', fmOpenRead);
    p := TJPEGImage.Create;
    with TObjReader.Create(fs, 1) do
    try
      ReadObject(p); // читаем картинку
      Image1.Picture.Assign(p); // показываем её на Image1
      Memo1.Lines.Add(ReadString); // читаем строку
      Memo1.Lines.Add(DateToStr(ReadDate)); // читаем дату
      Memo1.Lines.Add(FloatToStr(ReadSingle)); // читаем число
    finally
      p.Free;
      Free;
    end;
    fs.Free;
  except end;
end;

Добавлено через 45 секунд

Цитата(Akella @ 30.7.2010, 12:52

)

А если создать запись Record с разными полями и сохранять её в поток?

тогда уж лучше объект и целиком скормить его в TObjWriter

Автор: Amphiluke 30.7.2010, 13:32

Akella, а картянка (TBitmap) и строка (string) — это же указатели по сути. Так что, вроде, все равно придется каждое поле структуры по отдельности вписывать, чтобы сохранить в файл. Нет?

Автор: Akella 30.7.2010, 13:54

А может лучше использовать базу данных? Можно использовать таблицы в памяти и т.д.

Автор: pushok 30.7.2010, 14:02

Подумал, вот такие объекты написал:

Код


TInformation=record
  author,lvl,predmet,razdel:string;
  end;

  TQuestion=class
  public
  quest,rule,cheat:TStringList;
  tip,ordnum,rans:Integer;
  answers1,answers2:TStringList;
  img:TJpegImage;
  inf:TInformation;
  end;

  TTest=class
  public
  ready,qcnt,bcnt:Integer;
  title,theme:String;
  instruction,description:TStringList;
  inf:TInformation;
  questions:array of TQuestion;
  procedure Load(FileName:string);
  end;

  procedure TTest.Load(FileName:string);
  begin
Вот здесь должна быть загрузка
  end;

* прийду домой вечером - буду загрузку делать

Вопрос следующий: TQuestion стоит ли делать объектом или сделать его записью лучше?

Автор: Fighter 31.7.2010, 01:39

Тааааааааакс, слушай-ка, TQuestion. Я так понял задача у тебя такая: Создать программу по созданию тестов, причем тесты у пользователя должна быть возможность создавать, также этот созданный тест должна быть возможность пройти. Причем в вопросах и ответах необходимо добавить возможность задания картинок. В общем, если это так то у меня есть готовое решение. ТАм в файл пишется все, вопросы, ответы, картинки если необходимо, также теория в формате Word. Если что, попробую поднять исходники.
Единственный там минус (который ты возможно устранишь) - там долго идет загрузка. Но долго она идет потому что мне лень было думать как считать размер последнего загружаемого буфера, поэтому подгрузка из файла идет в буфер размером в 1 байт smile

. ))))

Автор: pushok 31.7.2010, 09:00

Буду рад посмотреть твои коды = ))
Надеюсь разберусь...

Автор: pushok 31.7.2010, 10:25

Написал, вот что у меня получилось (в коде оставил только, то, что нужно оценить) (пояснения ниже):

Код


uses
  Jpeg;

type

TInformation=record
 author,lvl,predmet,razdel:String;
end;

TAnswer=record
 answer1,answer2:TStringList;
 imgs1,imgs2:array of TJpegImage;
end;

TQuestion=record
  quest,rule,cheat:TStringList;
  ready,ans_num,tip,ordnum,rans:Integer;
  answer:TAnswer;
  img:TJpegImage;
  inf:TInformation;
end;

TTest=class
public
 ready,qcnt,bcnt:Integer;
 title,theme:String;
 instruction,description:TStringList;
 inf:TInformation;
 questions:array of TQuestion;
 procedure DestroyTest;
// procedure LoadFromFile(FileName:string);
end;

var
  Form1: TForm1;
  test:array of TTest;

procedure TTest.DestroyTest;
var
i,e:integer;
begin
for i:=0 to (bcnt-1) do
 begin
 questions[i].answer.answer1.Free;
 questions[i].answer.answer2.Free;
 questions[i].quest.Free;
 questions[i].rule.Free;
 questions[i].cheat.Free;
 questions[i].img.Free;
 end;
instruction.Free;
description.Free;
Free;
end;

procedure LoadTest1;
var
i,e:integer;
begin
SetLength(test,1);
test[0]:=TTest.Create;
test[0].ready:=1;
test[0].qcnt:=2;
test[0].bcnt:=2;
test[0].title:='Тест 1';
test[0].theme:='Тема 1';
test[0].instruction:=TStringList.Create;
test[0].instruction.add('Инструкция');
test[0].description:=TStringList.Create;
test[0].description.add('Описание');
test[0].inf.author:='Автор';
test[0].inf.predmet:='Предмет';
test[0].inf.razdel:='Раздел';
test[0].inf.lvl:='Уровень';
SetLength(test[0].questions,test[0].bcnt);
for i:=0 to (test[0].bcnt-1) do
 begin
 test[0].questions[i].quest:=TStringList.Create;
 test[0].questions[i].quest.Add('Вопрос'+IntToStr(i));
 test[0].questions[i].rule:=TStringList.Create;
 test[0].questions[i].rule.Add('Правило'+IntToStr(i));
 test[0].questions[i].cheat:=TStringList.Create;
 test[0].questions[i].cheat.Add('Подсказка'+IntToStr(i));
 test[0].questions[i].tip:=0;
 test[0].questions[i].ready:=0;
 test[0].questions[i].ans_num:=0;
 test[0].questions[i].ordnum:=0;
 test[0].questions[i].rans:=1;
 test[0].questions[i].inf.author:='Автор';
 test[0].questions[i].inf.lvl:='Уровень';
 test[0].questions[i].inf.predmet:='Предмет';
 test[0].questions[i].inf.razdel:='Раздел';
 test[0].questions[i].answer.answer1:=TStringList.Create;
 test[0].questions[i].answer.answer1.Add('Ответ1');
 test[0].questions[i].answer.answer1.Add('Ответ2');
 test[0].questions[i].answer.answer1.Add('Ответ3');
 test[0].questions[i].answer.answer1.Add('Ответ4');
 end;
end;

Решил сделать тест объектом, т.к. он должен иметь процедуры открытия (создания) и уничтожения.
Остальное решил сделать записями, т.к. все объекты (включенные в записи) будут создаваться в процедуре загрузки теста.
Процедура загрузки теста (LoadTest1) написана как инициализация (без самой загрузки из файла), но планирую её сделать по образу LoadTest1.

Вопросы:

1. Есть какие-нибудь недочеты?
2. Если в вопросе картинки не подразумевается, то я её (объект img) не создаю, чтобы не занимать лишнюю память. При удалении объектов я её всеравно удаляю. Не возникнет ли проблемных ситуаций с этим? (проверял - ошибок не появлялось). Если лучше не удалять, то что не создавал, то как проверить создавал ли я её?

Автор: pushok 31.7.2010, 18:36

И еще возникла проблема...

Написал функции отбора вопросов. При первом вызове всегда все в порядке. Но при последующих может возникнуть ошибка (EInvalidPointer) при этом может возникнуть, а может и не возникнуть...странное дело. Из программы я не выхожу, а просто вызываю повторно функции. Использую динамические массивы. Я так понимаю это из-за них, но дело в том, что они у меня всегда одинаковой длины. На это стоит обращать внимание?

Автор: azion 31.8.2010, 23:18

привет ребята если на трудно выложите полный исходник
интересно как все выглядит