Показать сообщение отдельно
  #12  
Старый 08.10.2022, 14:48
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
Радость Сериализация в Delphi 7

Цитата:
Сообщение от lmikle
Ну, выглядит достаточно неплохо (в общем)...

Сериализацию данных c TList (FigureList_Elem_) сделал так:
Данные по геометрии детали, в отдельной юнити:

Код:
	PNewElement=^TNewElement;
	TNewElement=record
           NumberFigures:integer; 
           Begin_Figures:integer; 
           End_Figures:integer;   
           Nach_Point:TPointM;
           End_Point:TPointM;
           Angle_Rotate    :double;
           MRect:TMainRect;
           STR_Coment:string[80];
//           SizeOfFile: Integer;
	case Element  :TMElement of
            elLine 	:(Pln,Plk:TPointM);
            elCircle    :(Pn,Pk,Pc:TPointM;Direct:TPrisnak);
            elBKL       :(BKL:integer);
            elBIKL      :(BIKL:integer);
            elKORLeft   :(KORLeft:integer);
            elKORRight  :(KORRight:integer);
            elKORKK     :(KORKK	:integer);
            elHP        :(HP:boolean);
            elKP        :(KP:integer);
            elBX	:(BX:integer);
            elBBX	:(BBX:integer);
            elHPP       :(HPP:integer); // 1001,1002
            elKPP       :(KPP:integer);
            elBPP       :(BPP,BPPN:integer;BPPAngle:real);
            elSpeed     :(Speed	:boolean);
            elNul	:(NUL:boolean);
            elABC	:(ABC:boolean);
            elPrisnak   :(Prisn:TPrisnak);
            elName      :(Name:string[80]);
            elComent    :(Comment:boolean);
       	end;

TFileRecords = array of TNewElement;

...
 В самом приложении в FormSapr:
... 
private
..
  Files: TFileRecords;
  FigureList_Elem_:TList;
  FiguresElem:PNewElement;
  
    function CreateArchiveHeader(FiguresElem:PNewElement): TFileRecords;
    procedure SAVE_FIGURE;
    procedure Load_Figure;
...

function TFormSapr.CreateArchiveHeader(FiguresElem:PNewElement): TFileRecords; //фигуры
var
  i: Integer;
begin
       for i:=0 to FigureList_Elem_.Count-1 do
       begin
            FiguresElem:=FigureList_Elem_.Items[i];
            SetLength(Result, i + 1);
            Result[i]:=FiguresElem^;
       end;
end;

procedure TFormSapr.SAVE_FIGURE; // Запись всех фигур
var
i, j: Integer;
S: String;
begin
if MainMessageDlg('Да - Запись раскроя? Нет - Выйти',mtConfirmation,[mbYes,mbNo])=mrYes then
if FigureList_Elem_.Count<>0 then   // сами фигуры
BEGIN
 Files := CreateArchiveHeader(FiguresElem);
 with TFileStream.Create(ExtractFilePath(ParamStr(0))+'RaskFigMem\test.figure', fmCreate) do try
  j := Length(Files);
  WriteBuffer(j, SizeOf(Integer));
  for i := 0 to j-1 do begin
    WriteBuffer(Files[i], SizeOf(Files[i]));
  end;
finally
  Free;
end;
END;
end;


procedure TFormSapr.Load_Figure;
var
 i, FilesCount: Integer;
begin
with TFileStream.Create(ExtractFilePath(ParamStr(0))+'RaskFigMem\test.figure', fmOpenRead) do
try
  ReadBuffer(FilesCount, SizeOf(Integer));
  SetLength(Files, FilesCount);
  for i := 0 to FilesCount-1 do
  begin
     ReadBuffer(Files[i], SizeOf(Files[i]));
     new(FiguresElem);
     FiguresElem^:=Files[i]; //
     if (i=FilesCount-1) then
        Index_Figure:=FiguresElem.NumberFigures;
     FigureList_Elem_.Add(FiguresElem);

  end;
  Inc(Index_Figure);
finally
  Free;
end;
end;

Всё. Пишет в файловый поток и читает после перезагрузки, без вопросов и обходных зехер поворотов...
Не нужно писать и читать отдельно каждое поле записи. Пишем и читаем сразу всю запись. Идею взял из инета. Это мне в ней и понравилось.
Продолжаю как будто и не выходил из приложения.
Стало похоже, как будто работает в Oracle VM VirtualBox.
Сама система: https://files.fm/f/twgvg7r84
Распространение приветствуется. В помощь начинающим предпринимателям, которые не потянут фирменные программы типа Интех Раскрой.
Ответить с цитированием