Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Разное
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 23.09.2022, 21:55
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Создание точки восстановления программы написанной на Delphi

Вопрос знатокам. Возможно ли создать точку восстановления программы написанной на Delphi.
Т.е. записать в файл полное состояние программы с целью при повторном запуске приложения продолжить работу так, как будто вы не выгружались.
В своём Sapr автоматизированного раскроя я сохраняю в бинаный файл те классы, которые отвечают за раскладку деталей на листе раскроя. Но есть ньюансы при чтении данных из этого бинарного файла после загрузки приложения. Раскрой воспроизводится и можно продолжить дальнейшую раскладку деталей с возможностью изменения положения ранее разложенных деталей. Но нет возможности делать откат назад и возврат, хотя он работает при самом проектировании. Возможно ли сохранить состояние программы каким то другим способом. Исходные коды Sapr мои .
Ответить с цитированием
  #2  
Старый 23.09.2022, 23:03
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,064
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ну так сохраняй в бинарник историю тоже.

Теоретически, можно сохранить весь дамп памяти приложения. Вот только потом будут проблемы с восстановлением, бо как физ адреса съедут. Т.е. в твоем случае заморачиваться смысла нет, просто пиши в бинарник историю, если это действительно нужно при "восстановлении".
Ответить с цитированием
  #3  
Старый 24.09.2022, 11:55
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
Ну так сохраняй в бинарник историю тоже.

Теоретически, можно сохранить весь дамп памяти приложения. Вот только потом будут проблемы с восстановлением, бо как физ адреса съедут. Т.е. в твоем случае заморачиваться смысла нет, просто пиши в бинарник историю, если это действительно нужно при "восстановлении".

Торопился и не совсем правильно выразился.
"я сохраняю в бинаный файл те классы, которые отвечают за раскладку деталей " имею ввиду конечно не сами классы, а записи, ссылки на которые сохраняю в этих классах ( классы TList).

Код:
type
 	PNewElement=^TNewElement;
	TNewElement=record
           NumberFigures:integer; // порядковый номер фигуры раскроя 1,2,3...
           Begin_Figures:integer; // начальный индекс фигуры в списке  List
           End_Figures:integer;   // конечный индекс фигуры в списке  List
           Nach_Point:TPointM;
           End_Point:TPointM;
           Angle_Rotate    :double;
           MRect:TMainRect;
           STR_Coment:string[80];
	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;

 	PChetchik=^TChetchik_;
	TChetchik_=record
       NumberFigures:integer; // порядковый номер детали в StringList -  1,4,2,2,3,3,5.
       end;
...


var
FiguresElem:PNewElement;
FigureList_Elem_:TList; // список который заполняется адресами элементов детали
Chetchik:PChetchik;
FLE_Chetchik:TList;

...
procedure TFormSapr.SaveFigure_NEW;   // ïèñàòü
var
   i,j:integer;
   f:file;
   filename: string;
   FigureIndex_:integer;
begin
      if FigureList_Elem_.Count<>0 then   // ñàìè ôèãóðû
      begin
       FigureIndex:=FigureList_Elem_.Count-1;
       filename:=ExtractFilePath(ParamStr(0))+'RaskFigMem\FigureList_Elem.figN';
       system.assign(f,filename);
       system.rewrite(f,1);
       system.blockWrite(f,FigureIndex,sizeof(FigureIndex));

       for i:=0 to FigureList_Elem_.Count-1 do
       begin
            FiguresElem:=FigureList_Elem_.Items[i];
            system.blockWrite(f,FiguresElem^,SizeOf(FiguresElem^));
       end;

            system.blockWrite(f,FiguresElem^.Nach_Point.X,SizeOf(FiguresElem^.Nach_Point.X));
            system.blockWrite(f,FiguresElem^.Nach_Point.Y,SizeOf(FiguresElem^.Nach_Point.Y));

            system.blockWrite(f,FiguresElem^.End_Point.X,SizeOf(FiguresElem^.End_Point.X));
            system.blockWrite(f,FiguresElem^.End_Point.Y,SizeOf(FiguresElem^.End_Point.Y));


            system.blockWrite(f,FiguresElem^.MRect.MinX,SizeOf(FiguresElem^.MRect.MinX));
            system.blockWrite(f,FiguresElem^.MRect.MaxX,SizeOf(FiguresElem^.MRect.MaxX));

            system.blockWrite(f,FiguresElem^.MRect.MinY,SizeOf(FiguresElem^.MRect.MinY));
            system.blockWrite(f,FiguresElem^.MRect.MaxY,SizeOf(FiguresElem^.MRect.MaxY));

        system.close(f);
      end; // if FigureList_Elem_.Count<>0 then



      if FLE_Chetchik.Count<>0 then   // ïîðÿäêîâûé íîìåð ôèãóðû ðàñêðîÿ 1,4,2,2,3,3,5... èç StringGrid1
      begin
       FigureIndex_:=FLE_Chetchik.Count-1;
       filename:=ExtractFilePath(ParamStr(0))+'RaskFigMem\FLE_Chetchik.figN';
       system.assign(f,filename);
       system.rewrite(f,1);
       system.blockWrite(f,FigureIndex_,sizeof(FigureIndex_));

       for i:=0 to FLE_Chetchik.Count-1 do
       begin
            Chetchik:=FLE_Chetchik.Items[i];
            system.blockWrite(f,Chetchik^,SizeOf(Chetchik^));
       end;
        system.close(f);

      end;



end;

procedure TFormSapr.LoadRaskroj_NEW; // ÷èòàòü
var
   i,j,nomread:integer;
   f:file;
   S,S1:string;
   k:integer;
   fileName:string;
   FigureIndex_:integer;

begin
       if FigureList_Elem_.Count=0 then
       begin
             filename:=ChangeFileExt(ExtractFilePath(ParamStr(0))+'RaskFigMem\FigureList_Elem.figN','.figN');
             if not FileExists(filename) then
                Exit;
             LMDLabel7.Caption:='ÑÈÑÒÅÌÀ SAPR ×ÏÓ. ÐÀÑÊÐÎÉ :  '+ExtractShortPathName(filename);

             system.assign(f,Filename);
             system.Reset(f,1);
             system.blockRead(f,FigureIndex,sizeof(FigureIndex),nomread);

             for i:=0 to FigureIndex do // èçì
             begin
                  new(FiguresElem);
                  system.blockRead(f,FiguresElem^,SizeOf(FiguresElem^),nomread);
                  if (i=FigureIndex) then
                      Index_Figure:=FiguresElem.NumberFigures;
                  FigureList_Elem_.Add(FiguresElem);
             end;

Nach_Point_X := FiguresElem^.Nach_Point.X;
Nach_Point_Y := FiguresElem^.Nach_Point.Y;
End_Point_X  := FiguresElem^.End_Point.X;
End_Point_Y  := FiguresElem^.End_Point.Y;

MRect_MinX   := FiguresElem^.MRect.MinX;
MRect_MaxX   := FiguresElem^.MRect.MaxX;
MRect_MinY   := FiguresElem^.MRect.MinY;
MRect_MaxY   := FiguresElem^.MRect.MaxY;


             Inc(Index_Figure);
             system.close(f);
       end;


       if FLE_Chetchik.Count=0 then
       begin
             filename:=ChangeFileExt(ExtractFilePath(ParamStr(0))+'RaskFigMem\FLE_Chetchik.figN','.figN');
             if not FileExists(filename) then
                Exit;

             system.assign(f,Filename);
             system.Reset(f,1);
             system.blockRead(f,FigureIndex_,sizeof(FigureIndex_),nomread);

             for i:=0 to FigureIndex_ do
             begin
                  new(Chetchik);
                  system.blockRead(f,Chetchik^,SizeOf(Chetchik^),nomread);
                  FigureList_Elem_.Add(Chetchik);
             end;
             system.close(f);

       end;

    if FormSapr.Panel_Visual_Raskroj1<>nil then
      Panel_Visual_Raskroj1.WMPaint(Msg1)
    else
      Panel_Visual_Raskroj2.WMPaint(Msg1);


end;
В чём состоит проблема. Читается всё правильно, но в FigureList_Elem_ в последнем элементе впоследствии, когда начинаю выводить следующую деталь значения в FiguresElem^ ответственные за привязку следующей детали к предыдущей обнуляются, хотя при прочтении были верные. Пришлось пойти на хитрость и сразу после прочтения файла записать теряемые значения в
Код:
Nach_Point_X := FiguresElem^.Nach_Point.X;
Nach_Point_Y := FiguresElem^.Nach_Point.Y;
End_Point_X  := FiguresElem^.End_Point.X;
End_Point_Y  := FiguresElem^.End_Point.Y;

MRect_MinX   := FiguresElem^.MRect.MinX;
MRect_MaxX   := FiguresElem^.MRect.MaxX;
MRect_MinY   := FiguresElem^.MRect.MinY;
MRect_MaxY   := FiguresElem^.MRect.MaxY;
И потом в том месте где они нужны заменять все FiguresElem^.End_Point.X и т.д. на End_Point_X и т.д.:
Код:
           if (Index_Figure>1) and (i=1) then
           begin

{Line}          new(FiguresElem);
                FiguresElem^.Element:=elLine;
if Flag_Vosstanovlen then
begin
                FiguresElem^.Pln.X:=End_Point_X;
                FiguresElem^.Pln.Y:=End_Point_Y;

                FiguresElem^.Plk.X:=MRect_MinX;
                FiguresElem^.Plk.Y:=MRect_MaxY+5;
                Flag_Vosstanovlen:=false;
end
else
begin
                FiguresElem^.Pln:=PNewElement(FigureList_Elem_.Items[BeginFig-1]).End_Point;
                FiguresElem^.Plk.X:=PNewElement(FigureList_Elem_.Items[BeginFig-1]).MRect.MinX;
                FiguresElem^.Plk.Y:=PNewElement(FigureList_Elem_.Items[BeginFig-1]).MRect.MaxY+5;

end;




//                FiguresElem^.Pln:=PNewElement(FigureList_Elem_.Items[BeginFig-1]).End_Point;
//                FiguresElem^.Plk.X:=PNewElement(FigureList_Elem_.Items[BeginFig-1]).MRect.MinX;
//                FiguresElem^.Plk.Y:=PNewElement(FigureList_Elem_.Items[BeginFig-1]).MRect.MaxY+5;
                FiguresElem^.Begin_Figures:=BeginFig;
                FiguresElem^.End_Figures:=BeginFig+FigureIndex+1;
                FiguresElem^.NumberFigures:=Index_Figure;
                Nach_Point_:=FiguresElem^.Plk;

                Xmin_:=FiguresElem^.Pln.X;
                Xmax_:=FiguresElem^.Pln.Y;
                Ymin_:=FiguresElem^.Pln.X;
                Ymax_:=FiguresElem^.Pln.Y;

                FiguresElem^.MRect.MinX:=Xmin_;
                FiguresElem^.MRect.MaxX:=Xmax_;
                FiguresElem^.MRect.MinY:=Ymin_;
                FiguresElem^.MRect.MaxY:=Ymax_;

                FigureList_Elem_.Add(FiguresElem);

           end
Чего хотелось не делать. Т.к. при выводе новой фигуры и попытке её перемещать вылетает трудно обнаруживаемая ошибка. Видимо какие то переменные не пишу и потом не читаю. Буду искать, но пока что ...
Потому что приходится стирать всё и читать второй раз, тогда всё работает нормально.[/code]

Последний раз редактировалось lmikle, 26.09.2022 в 04:23.
Ответить с цитированием
  #4  
Старый 26.09.2022, 04:30
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,064
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Значит что-то не пишешь или не читаешь. Кстати, что такое TPointM? Указатель на структуру? Если да, то вот тут и есть ошибка, бо, как видимо, там сохраняется адрес, а не содержимое полей. Кстати, там вообще можно тогда на Access Violation налететь только так.

Вообще, это у тебя кошмар какой-то.
Нет что бы сделать нормальную иерархию классов. В каждом классе есть метод его записи и чтения (например, в поток, так лучше, чем использовать нетипизированный файл). И, соответсвенно, просто вызывается соотв. метод.
Посмотри, я вот тут:
https://delphisources.ru/forum/showt...029#post158029
постил пример модели. Там всего 2 уровня, но идея должна быть понятна. Да, кода придется написать чуточку больше, но зато будет красиво и читабельно.
Ну и вообще, поправишь модель. А то есть у меня подозрение, что у тебя там что-то лишнее есть...
Ответить с цитированием
  #5  
Старый 27.09.2022, 04:38
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
Значит что-то не пишешь или не читаешь. Кстати, что такое TPointM? Указатель на структуру? Если да, то вот тут и есть ошибка, бо, как видимо, там сохраняется адрес, а не содержимое полей. Кстати, там вообще можно тогда на Access Violation налететь только так.

Вообще, это у тебя кошмар какой-то.
Нет что бы сделать нормальную иерархию классов. В каждом классе есть метод его записи и чтения (например, в поток, так лучше, чем использовать нетипизированный файл). И, соответсвенно, просто вызывается соотв. метод.
Посмотри, я вот тут:
https://delphisources.ru/forum/showt...029#post158029
постил пример модели. Там всего 2 уровня, но идея должна быть понятна. Да, кода придется написать чуточку больше, но зато будет красиво и читабельно.
Ну и вообще, поправишь модель. А то есть у меня подозрение, что у тебя там что-то лишнее есть...

Код:
PPointM=^TPointM;
	TPointM=record
		X,Y:real;
Спасибо за ответ. Посмотрю обязательно.

Последний раз редактировалось lmikle, 27.09.2022 в 04:54.
Ответить с цитированием
  #6  
Старый 27.09.2022, 04:57
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,064
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Да нет, судя по описанию записи должно быть нормально.
Но, как я уже сказал, код у тебя получается очень путанный, неудобно отлаживать. Вообще, наверное лучше переписать сохранение на алгоритм "честной" сереализации. А еще лучше, как я говорил, переделай на иерархию классов. Там код будет очень простой и прозрачный, вероятность ошибки будет минимальная.
Если не знаешь как - пиши, подскажу.
Ответить с цитированием
  #7  
Старый 27.09.2022, 05:57
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
Злость

Цитата:
Сообщение от lmikle
Да нет, судя по описанию записи должно быть нормально.
Но, как я уже сказал, код у тебя получается очень путанный, неудобно отлаживать. Вообще, наверное лучше переписать сохранение на алгоритм "честной" сереализации. А еще лучше, как я говорил, переделай на иерархию классов. Там код будет очень простой и прозрачный, вероятность ошибки будет минимальная.
Если не знаешь как - пиши, подскажу.

Писалось всё это в 2000 году, когда только самообучался и переходил с другого языка на Delphi. Теперь не хочется всё переписывать, мужики просили добавить функционал и сделать "точку восстановления программы", чтение dxf и автоматизировать построение фигур (деталей) с них и читать dxf с "Autodesk AutoCAD 2004" и "SolidWorks 2001 FINAL" или КОМПАС v9-15). Это видео её работы: https://www.youtube.com/watch?v=DU_i7sLcd0A . Это рабочая программа: https://ru.files.fm/f/amcrxbtds она немного отличается от видео но полностью функционирует.

Посмотрел. Но без ModelBase как то трудновато въехать. Может дадите хоть dcu шку. У меня Embarcadero® RAD Studio 10.4 Version 27.0.40680.4203 , но SAPR написан на Delphi 7. Портировать в 10.4 пока не удалось.
И вы пишете, что: " Пришлось удалить пару методов, что бы влезть в ограничение длинны сообщения". Нельзя ли их дать.
За алгоритм "честной" сереализации что то читал, освежу.
Ответить с цитированием
  #8  
Старый 27.09.2022, 19:55
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,064
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Да там не принципиальные методы удалены - полечение данных с web-сервера (просто чтение и парсинг web-странички). Для обсуждаемого вопроса это не важно.
Теперь по поводу TModelBase. Там просто реализованы записи/чтения базовых типов в/из потока. Все вида:
Код:
function TModelItemBase.ReadInt(AStream: TStream): Integer;
begin
  AStream.ReadBuffer(Result,SizeOf(Integer));
end;

procedure TModelItemBase.WriteInt(AStream: TStream; AValue: Integer);
begin
  AStream.WriteBuffer(AValue,SizeOf(Integer));
end;

Ну, если нет возможности переделать модель, то тогда надо написать соотв. процедуры сериализации/десериализации, где прописать запись/чтение всех полей, что бы не надеяться на поведение по умаолчанию, особенно, если есть указатели.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
basilcat (27.09.2022)
  #9  
Старый 27.09.2022, 22:31
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
Да там не принципиальные методы удалены - полечение данных с web-сервера (просто чтение и парсинг web-странички). Для обсуждаемого вопроса это не важно.
Теперь по поводу TModelBase. Там просто реализованы записи/чтения базовых типов в/из потока. Все вида:
Код:
function TModelItemBase.ReadInt(AStream: TStream): Integer;
begin
  AStream.ReadBuffer(Result,SizeOf(Integer));
end;

procedure TModelItemBase.WriteInt(AStream: TStream; AValue: Integer);
begin
  AStream.WriteBuffer(AValue,SizeOf(Integer));
end;

Ну, если нет возможности переделать модель, то тогда надо написать соотв. процедуры сериализации/десериализации, где прописать запись/чтение всех полей, что бы не надеяться на поведение по умаолчанию, особенно, если есть указатели.

Спасибо вам за участие.
Ответить с цитированием
  #10  
Старый 29.09.2022, 08:47
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Ну, если нет возможности переделать модель, то тогда надо написать соотв. процедуры сериализации/десериализации, где прописать запись/чтение всех полей, что бы не надеяться на поведение по умаолчанию, особенно, если есть указатели.[/quote]

Пока всё так:
https://www.youtube.com/watch?v=p7dPxwGuvbA - Sapr1
https://www.youtube.com/watch?v=KJ7daEnma9k - Sapr2
Видео.
Потом посмотрим
Ответить с цитированием
  #11  
Старый 29.09.2022, 21:04
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,064
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ну, выглядит достаточно неплохо (в общем).
Хотя местами просто ужас и боль.
Как с точки зрения интерфейса (ну тут, конечно на вкус и цвет, но все-таки алаповато как-то, все-таки не зря МС публикует гайды по дизайну интерфейса), так и с точки зрения явных косяков (почему "квадрат" детали отрисовывается мимо самой детали? отрисовка превью детали тоже хромает, хотя может я чего не знаю и так задуманно...).

Короче, все-равно, по хорошему, там надо много чего переделывать. Но это только если есть желание и бюджет. Была в свое время история на одном из моих предыдущих мест работы. Написали систему, писали под заказчика и писали достаточно долго, требования менялись, менялись разработчики. Ну, написали, запустили. Потом сделали клон этой системы для другого заказчика. Потом посмотрели по результатам и на основании полученного опыта появилась идея сделать чуть более универсальную систему, более гибкую, которую можно было бы конфигурировать под разных заказчиков. Но начальство сказало, что если будет заказчик, готовый купить решение, то можео будет сделать, а так внутри компании бюджета нет. И на этом все закончилось... А идея была достаточно интересная...
Ответить с цитированием
  #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
Распространение приветствуется. В помощь начинающим предпринимателям, которые не потянут фирменные программы типа Интех Раскрой.
Ответить с цитированием
  #13  
Старый 08.10.2022, 17:32
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
... c точки зрения явных косяков (почему "квадрат" детали отрисовывается мимо самой детали? отрисовка превью детали тоже хромает, хотя может я чего не знаю ...

Просьба о каком квадрате детали отрисовки идёт речь. Вы на видио видимо что то заметили. Назовите пожалуйста название видио (1 или 2) и минуту начала отрисовки этого квадрата.
Если это вверху слева, то это ЛУПА. Для более точной фиксации на линиях и окружностях. Это видио с новой версией SAPR: https://www.youtube.com/watch?v=Y2c9Otlu_to

Последний раз редактировалось basilcat, 09.10.2022 в 10:22.
Ответить с цитированием
  #14  
Старый 10.10.2022, 03:47
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,064
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Не, квадрат отрисовывается на макетном поле. Выглядит как апроксимированная граница деталли, но отрисовывается неточно, в стороне от проекции самой детали. Вроде, на первом видео это видел.
Ответить с цитированием
  #15  
Старый 10.10.2022, 07:55
basilcat basilcat вне форума
Прохожий
 
Регистрация: 27.04.2017
Сообщения: 16
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
Не, квадрат отрисовывается на макетном поле. Выглядит как апроксимированная граница деталли, но отрисовывается неточно, в стороне от проекции самой детали. Вроде, на первом видео это видел.

Спасибо. Это следующая выводимая деталь. Она должна быть со смещением от уже лежащей на поле такой же и всегда будет со смещением, чтобы её можно было выбрать по линии выше. Пока не удаётся брать по телу детали. Есть свои заморочки в определении какая ниже и какая выше. Пошёл по пути выбора линии принадлежащей детали. Так всегда точно идентифицируется именно та, что выбирается курсором мыши.

Последние видео, https://youtu.be/Y2c9Otlu_to , https://youtu.be/Z7UoYce6rdI , https://youtu.be/NFur2cD4Z0o , https://youtu.be/HLdFOeQbdL8 , https://youtu.be/sAgcv_VSopw , https://youtu.be/ZJsRgQzjfgM , https://youtu.be/Hq11ZsUJ9SA , https://www.youtube.com/watch?v=Dw1-QF7KP5E , https://youtu.be/kezLunXfSec, https://youtu.be/Lvvxe_vNlek .
Последняя версия системы: https://files.fm/u/s8me92cne и https://archive.org/details/sapr_20221208 - работает перевод наработанных ранее предприятием ESI файлов в формат FIG, с последующей их раскладкой на раскрой. Исправлены баги для деталей с наружным контуром полной окружностью. Инструкция в папке DOC: Manual_sapr_NEW.docx в конце.

Последний раз редактировалось basilcat, 09.12.2022 в 08:34.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 08:53.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter