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

Вниз

Сохранение и загрузка динамического массива   Найти похожие ветки 

 
Dr.Andrew   (2010-05-06 00:29) [0]

Добрый день!

Сохранение и загрузка динамического массива. Массив представляет собой пять матриц 24х24. Я делаю так:

Код:

type
 TExDynaMatrix = array of array of array of Integer;

private
   // Load & save
   procedure LoadDynArray(AFileName : WideString; DynArr : TExDynaMatrix); // загрузка
   procedure SaveDynArray(AFileName : WideString; DynArr : TExDynaMatrix); // сохранение

procedure TMainForm.LoadDynArray(AFileName : WideString; DynArr : TExDynaMatrix);
var
 // Counters
 i, j : Integer;
 // Read classes
 RStr : TFileStream;
 Reader : TReader;
 // Metrics
 ARow, ACol : Integer;
begin
 RStr := TFileStream.Create(AFileName+".dat", fmOpenRead, fmShareExclusive);
 try
   Reader := TReader.Create(RStr, 8096);
   try
     ARow := Reader.ReadInteger;
     SetLength(DynArr, ARow);
     ACol := Reader.ReadInteger;
     for i := 0 to ARow-1 do
     begin
       SetLength(DynArr[i], ACol, ACol);
       for j := 0 to ACol-1 do
         Reader.Read(DynArr[i, j], Length(DynArr[i])*SizeOf(Integer));
     end;
   finally
     FreeAndNil(Reader);
   end;
 finally
   FreeAndNil(RStr);
 end;
 ProcessOutput;
end;

procedure TMainForm.SaveDynArray(AFileName : WideString; DynArr : TExDynaMatrix);
var
 // Counters
 i, j : Integer;
 // Read classes
 WStr : TFileStream;
 Writer : TWriter;
begin
 WStr := TFileStream.Create(AFileName+".dat", fmCreate, fmShareExclusive);
 try
   Writer := TWriter.Create(WStr, 8096);
   try
     Writer.WriteInteger(Length(DynArr));
     for i := 0 to Length(DynArr)-1 do
     begin
       Writer.WriteInteger(Length(DynArr[i]));
       for j := 0 to Length(DynArr[i])-1 do
         Writer.Write(DynArr[i, j], Length(DynArr[i])*SizeOf(Integer));
     end;
   finally
     FreeAndNil(Writer);
   end;
 finally
   FreeAndNil(WStr);
 end;
end;

Код не работает, подскажите где в процедурах сохранения и загрузки ошибки.

Спасибо


 
Игорь Шевченко ©   (2010-05-06 00:32) [1]


> Код не работает


больно слышать


> подскажите где в процедурах сохранения и загрузки ошибки


предлагаешь поработать за тебя отладчиком ?


 
Dr.Andrew   (2010-05-06 01:33) [2]

Спасибо за ответ, нет не предлагаю работать отладчиком. Просто прошу профессионального совета в чем ошибка. Еще раз спасибо за помощь, реальную помощь, Мастера.


 
turbouser ©   (2010-05-06 01:42) [3]

array of array of array of Integer;


 
Dr.Andrew   (2010-05-06 01:52) [4]

Извините, не понял Вашего ответа. Что значит повтор моей строки - array of array of array of Integer; Да, это такая матрица. Спасибо за ответ.


 
turbouser ©   (2010-05-06 02:02) [5]


> Dr.Andrew   (06.05.10 01:52) [4]


> Что значит

трехмерный массив. а ты пишешь и читаешь как двумерный.


 
Германн ©   (2010-05-06 02:10) [6]


> Dr.Andrew   (06.05.10 01:33) [2]
>
> Спасибо за ответ, нет не предлагаю работать отладчиком.

Именно предлагаешь.
"Код не работает" - должно подтверждаться документально и конкретно.


 
Юрий Зотов ©   (2010-05-06 07:54) [7]

> Dr.Andrew

Все это совсем несложно, нужны просто аккуратность и внимательность.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

type
 TArray = array of array of array of integer;

procedure FinalizeArray(var Arr: TArray);
var
 i, j: integer;
begin
 for i := Low(Arr) to High(Arr) do
 begin
   for j := Low(Arr[i]) to High(Arr[i]) do
     Finalize(Arr[i, j]);
   Finalize(Arr[i])
 end;
 Finalize(Arr);
 Arr := nil
end;

procedure InitArray(var Arr: TArray);
var
 i, j, k: integer;
begin
 FinalizeArray(Arr);
 SetLength(Arr, 5);
 for i := Low(Arr) to High(Arr) do
 begin
   SetLength(Arr[i], 24);
   for j := Low(Arr[i]) to High(Arr[i]) do
   begin
     SetLength(Arr[i, j], 24);
     for k := Low(Arr[i, j]) to High(Arr[i, j]) do
       Arr[i, j, k] := Random(10000)
   end
 end
end;

procedure WriteArrayToStream(const Arr: TArray; const Stream: TMemoryStream);
var
 Len, i, j, k: integer;
begin
 Stream.Clear;
 Len := Length(Arr);
 Stream.Write(Len, SizeOf(Len));
 for i := Low(Arr) to High(Arr) do
 begin
   Len := Length(Arr[i]);
   Stream.Write(Len, SizeOf(Len));
   for j := Low(Arr[i]) to High(Arr[i]) do
   begin
     Len := Length(Arr[i, j]);
     Stream.Write(Len, SizeOf(Len));
     for k := Low(Arr[i, j]) to High(Arr[i, j]) do
       Stream.Write(Arr[i, j, k], SizeOf(Arr[i, j, k]))
   end
 end
end;

procedure ReadArrayFromStream(var Arr: TArray; const Stream: TMemoryStream);
var
 Len, i, j, k: integer;
begin
 FinalizeArray(Arr);
 Stream.Position := 0;
 Stream.Read(Len, SizeOf(Len));
 SetLength(Arr, Len);
 for i := Low(Arr) to High(Arr) do
 begin
   Stream.Read(Len, SizeOf(Len));
   SetLength(Arr[i], Len);
   for j := Low(Arr[i]) to High(Arr[i]) do
   begin
     Stream.Read(Len, SizeOf(Len));
     SetLength(Arr[i, j], Len);
     for k := Low(Arr[i, j]) to High(Arr[i, j]) do
       Stream.Read(Arr[i, j, k], SizeOf(Arr[i, j, k]))
   end
 end
end;

function CompareArrays(const Arr1, Arr2: TArray): boolean;
var
 i, j, k: integer;
begin
 Result := False;
 if Length(Arr1) <> Length(Arr2) then
   Exit;
 for i := Low(Arr1) to High(Arr1) do
 begin
   if Length(Arr1[i]) <> Length(Arr2[i]) then
     Exit;
   for j := Low(Arr1[i]) to High(Arr1[i]) do
   begin
     if Length(Arr1[i, j]) <> Length(Arr2[i, j]) then
       Exit;
     for k := Low(Arr1[i, j]) to High(Arr1[i, j]) do
       if Arr1[i, j, k] <> Arr2[i, j, k] then
         Exit;
   end
 end;
 Result := True
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 Arr1, Arr2: TArray;
 Stream: TMemoryStream;
begin
 InitArray(Arr1);
 try
   Stream := TMemoryStream.Create;
   try
     WriteArrayToStream(Arr1, Stream);
     ReadArrayFromStream(Arr2, Stream);
     try
       if CompareArrays(Arr1, Arr2) then
         Caption := "OK"
       else
         Caption := "Invalid programmer detected"
     finally
       FinalizeArray(Arr2)
     end
   finally
     Stream.Free
   end
 finally
   FinalizeArray(Arr1)
 end
end;

end.


 
oxffff ©   (2010-05-06 09:05) [8]


> Юрий Зотов ©   (06.05.10 07:54) [7]


>
> procedure FinalizeArray(var Arr: TArray);
> var
>  i, j: integer;
> begin
>  for i := Low(Arr) to High(Arr) do
>  begin
>    for j := Low(Arr[i]) to High(Arr[i]) do
>      Finalize(Arr[i, j]);
>    Finalize(Arr[i])
>  end;
>  Finalize(Arr);
>  Arr := nil
> end;


procedure FinalizeArray(var Arr: TArray);
var
Arr := nil;
end;

?


 
brother ©   (2010-05-06 09:14) [9]

> procedure FinalizeArray(var Arr: TArray);
> var
> Arr := nil;
> end;
>
> ?

правило хорошего тона?


 
oxffff ©   (2010-05-06 09:21) [10]


> brother ©   (06.05.10 09:14) [9]
> > procedure FinalizeArray(var Arr: TArray);
> > var
> > Arr := nil;
> > end;
> >
> > ?
>
> правило хорошего тона?


Это ты о чем?
Зачем городить такой огород, если достаточно написать
Finalize(Arr) или  Arr := nil


 
Palladin ©   (2010-05-06 09:22) [11]

скорее привет из java )


 
oxffff ©   (2010-05-06 09:23) [12]


> Palladin ©   (06.05.10 09:22) [11]
> скорее привет из java )


Да вы что все сговорились чтоль? ;)
Какая JAVA?


 
brother ©   (2010-05-06 09:27) [13]

> Да вы что все сговорились чтоль? ;)

нет)))))))))))


 
Palladin ©   (2010-05-06 09:28) [14]

да я про Юру, а не про тебя )


 
Юрий Зотов ©   (2010-05-06 13:37) [15]

> привет из java

Проверка на двоичность. Сработала.
:o)



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

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

Наверх





Память: 0.5 MB
Время: 0.068 c
15-1265578203
Юрий
2010-02-08 00:30
2010.08.27
С днем рождения ! 8 февраля 2010 понедельник


2-1274332322
03111978
2010-05-20 09:12
2010.08.27
Работа с датами


15-1268688602
Юрий
2010-03-16 00:30
2010.08.27
С днем рождения ! 16 марта 2010 вторник


15-1271845238
bss
2010-04-21 14:20
2010.08.27
XMLSpy, построение расширения (extension)


9-1185035010
Evgraf
2007-07-21 20:23
2010.08.27
Подскажите





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