|
|
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
 |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
23.09.2022, 21:55
|
|||
|
|||
Создание точки восстановления программы написанной на Delphi
Вопрос знатокам. Возможно ли создать точку восстановления программы написанной на Delphi.
Т.е. записать в файл полное состояние программы с целью при повторном запуске приложения продолжить работу так, как будто вы не выгружались. В своём Sapr автоматизированного раскроя я сохраняю в бинаный файл те классы, которые отвечают за раскладку деталей на листе раскроя. Но есть ньюансы при чтении данных из этого бинарного файла после загрузки приложения. Раскрой воспроизводится и можно продолжить дальнейшую раскладку деталей с возможностью изменения положения ранее разложенных деталей. Но нет возможности делать откат назад и возврат, хотя он работает при самом проектировании. Возможно ли сохранить состояние программы каким то другим способом. Исходные коды Sapr мои . |
|
#2
23.09.2022, 23:03
|
|||
|
|||
|
Ну так сохраняй в бинарник историю тоже.
Теоретически, можно сохранить весь дамп памяти приложения. Вот только потом будут проблемы с восстановлением, бо как физ адреса съедут. Т.е. в твоем случае заморачиваться смысла нет, просто пиши в бинарник историю, если это действительно нужно при "восстановлении". |
|
#3
24.09.2022, 11:55
|
|||
|
|||
|
Цитата:
Торопился и не совсем правильно выразился. "я сохраняю в бинаный файл те классы, которые отвечают за раскладку деталей " имею ввиду конечно не сами классы, а записи, ссылки на которые сохраняю в этих классах ( классы 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;Код:
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; Код:
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
|
|||
|
|||
|
Значит что-то не пишешь или не читаешь. Кстати, что такое TPointM? Указатель на структуру? Если да, то вот тут и есть ошибка, бо, как видимо, там сохраняется адрес, а не содержимое полей. Кстати, там вообще можно тогда на Access Violation налететь только так.
Вообще, это у тебя кошмар какой-то. Нет что бы сделать нормальную иерархию классов. В каждом классе есть метод его записи и чтения (например, в поток, так лучше, чем использовать нетипизированный файл). И, соответсвенно, просто вызывается соотв. метод. Посмотри, я вот тут: https://delphisources.ru/forum/showt...029#post158029 постил пример модели. Там всего 2 уровня, но идея должна быть понятна. Да, кода придется написать чуточку больше, но зато будет красиво и читабельно. Ну и вообще, поправишь модель. А то есть у меня подозрение, что у тебя там что-то лишнее есть... |
|
#5
27.09.2022, 04:38
|
|||
|
|||
|
Цитата:
Код:
PPointM=^TPointM; TPointM=record X,Y:real; Последний раз редактировалось lmikle, 27.09.2022 в 04:54. |
|
#6
27.09.2022, 04:57
|
|||
|
|||
|
Да нет, судя по описанию записи должно быть нормально.
Но, как я уже сказал, код у тебя получается очень путанный, неудобно отлаживать. Вообще, наверное лучше переписать сохранение на алгоритм "честной" сереализации. А еще лучше, как я говорил, переделай на иерархию классов. Там код будет очень простой и прозрачный, вероятность ошибки будет минимальная. Если не знаешь как - пиши, подскажу. |
|
#7
27.09.2022, 05:57
|
|||
|
|||
Цитата:
Писалось всё это в 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
|
|||
|
|||
|
Да там не принципиальные методы удалены - полечение данных с 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
|
|||
|
|||
|
Цитата:
Спасибо вам за участие. |
|
#10
29.09.2022, 08:47
|
|||
|
|||
|
Ну, если нет возможности переделать модель, то тогда надо написать соотв. процедуры сериализации/десериализации, где прописать запись/чтение всех полей, что бы не надеяться на поведение по умаолчанию, особенно, если есть указатели.[/quote]
Пока всё так: https://www.youtube.com/watch?v=p7dPxwGuvbA - Sapr1 https://www.youtube.com/watch?v=KJ7daEnma9k - Sapr2 Видео. Потом посмотрим  |
|
#11
29.09.2022, 21:04
|
|||
|
|||
|
Ну, выглядит достаточно неплохо (в общем).
Хотя местами просто ужас и боль. Как с точки зрения интерфейса (ну тут, конечно на вкус и цвет, но все-таки алаповато как-то, все-таки не зря МС публикует гайды по дизайну интерфейса), так и с точки зрения явных косяков (почему "квадрат" детали отрисовывается мимо самой детали? отрисовка превью детали тоже хромает, хотя может я чего не знаю и так задуманно...). Короче, все-равно, по хорошему, там надо много чего переделывать. Но это только если есть желание и бюджет. Была в свое время история на одном из моих предыдущих мест работы. Написали систему, писали под заказчика и писали достаточно долго, требования менялись, менялись разработчики. Ну, написали, запустили. Потом сделали клон этой системы для другого заказчика. Потом посмотрели по результатам и на основании полученного опыта появилась идея сделать чуть более универсальную систему, более гибкую, которую можно было бы конфигурировать под разных заказчиков. Но начальство сказало, что если будет заказчик, готовый купить решение, то можео будет сделать, а так внутри компании бюджета нет. И на этом все закончилось... А идея была достаточно интересная... |
|
#12
08.10.2022, 14:48
|
|||
|
|||
Сериализация в Delphi 7
Цитата:
Сериализацию данных 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
|
|||
|
|||
|
Цитата:
Просьба о каком квадрате детали отрисовки идёт речь. Вы на видио видимо что то заметили. Назовите пожалуйста название видио (1 или 2) и минуту начала отрисовки этого квадрата. Если это вверху слева, то это ЛУПА. Для более точной фиксации на линиях и окружностях. Это видио с новой версией SAPR: https://www.youtube.com/watch?v=Y2c9Otlu_to Последний раз редактировалось basilcat, 09.10.2022 в 10:22. |
|
#14
10.10.2022, 03:47
|
|||
|
|||
|
Не, квадрат отрисовывается на макетном поле. Выглядит как апроксимированная граница деталли, но отрисовывается неточно, в стороне от проекции самой детали. Вроде, на первом видео это видел.
|
|
#15
10.10.2022, 07:55
|
|||
|
|||
|
Цитата:
Спасибо. Это следующая выводимая деталь. Она должна быть со смещением от уже лежащей на поле такой же и всегда будет со смещением, чтобы её можно было выбрать по линии выше. Пока не удаётся брать по телу детали. Есть свои заморочки в определении какая ниже и какая выше. Пошёл по пути выбора линии принадлежащей детали. Так всегда точно идентифицируется именно та, что выбирается курсором мыши.  Последние видео, 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. |
Линейный вид
