kami-Code

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables, Grids, ComCtrls, CheckLst, Math,
ExtCtrls, Buttons, Menus, DBGrids;

type
TProtectedPanel = class(TPanel); // <— ВСТАВЬТЕ ЭТУ СТРОЧКУ СТРОГО СЮДА!

TForm1 = class(TForm)
Table1: TTable;
Button1: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
GridFocus: TDrawGrid;
BtnAddFirstTask: TButton;
BtnStageOK: TButton;
LblKRealiz: TLabel;
GridDirector: TDrawGrid;
BtnClearDB: TButton;
BtnNewTask: TButton;
BtnDeleteTask: TButton;
BtnIndent: TButton;
BtnOutdent: TButton;
Button2: TButton;
EditCell: TEdit;
BtnMoveUp: TButton;
BtnMoveDown: TButton;
GridMonths: TDrawGrid;
GroupProps: TPanel;
Label2: TLabel;
EditDeltaT: TEdit;
Label3: TLabel;
ComboWorker: TComboBox;
Label4: TLabel;
MemoQuality: TMemo;
CheckListDone: TCheckListBox;
Label5: TLabel;
BtnFillWorkers: TButton;
BtnSaveProps: TBitBtn;
ComboDays: TComboBox;
ComboHours: TComboBox;
Label6: TLabel;
Label7: TLabel;
EditItemText: TEdit;
Label8: TLabel;
Label9: TLabel;
EditItemWeight: TEdit;
BtnAddCheck: TSpeedButton;
BtnDelCheck: TSpeedButton;
LabelProgress: TLabel;
BitBtn1: TBitBtn;
LabelTaskName: TLabel;
Label1: TLabel;
EditDateStart: TEdit;
Label10: TLabel;
EditLinkID: TEdit;
BtnLinkMode: TSpeedButton;
BtnUnlink: TSpeedButton;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
Label11: TLabel;
DBGrid1: TDBGrid;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
DataSource1: TDataSource;
PopupMenu1: TPopupMenu;
N4: TMenuItem;
Panel2: TPanel;
SpeedButton2: TSpeedButton;
Label12: TLabel;
SG01: TStringGrid; // Исправлено на чистый холст
procedure BtnSavePropsClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GridFocusDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure BtnAddFirstTaskClick(Sender: TObject);
procedure GridFocusDblClick(Sender: TObject);
procedure BtnStageOKClick(Sender: TObject);
procedure GridDirectorDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure BtnClearDBClick(Sender: TObject);
procedure GridDirectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BtnNewTaskClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure BtnIndentClick(Sender: TObject);
procedure BtnOutdentClick(Sender: TObject);
procedure BtnDeleteTaskClick(Sender: TObject);
procedure EditCellKeyPress(Sender: TObject; var Key: Char);
procedure EditCellExit(Sender: TObject);
procedure BtnMoveUpClick(Sender: TObject);
procedure BtnMoveDownClick(Sender: TObject);
procedure GridMonthsDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure BtnFillWorkersClick(Sender: TObject);
procedure BtnAddCheckClick(Sender: TObject);
procedure BtnDelCheckClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure CheckListDoneClick(Sender: TObject);
procedure BtnUnlinkClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedButton2Click(Sender: TObject);
procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N4Click(Sender: TObject);
private
{ Private declarations }
EditingTaskID: Integer; // Хранитель ключа редактируемой задачи
IsWeekScale: Boolean; // ГЛОБАЛЬНЫЙ ТУМБЛЕР МАСШТАБА: True – Неделя, False – День
iF4, I_link : Integer;
St : String;
public
{ Public declarations }
procedure CalculateKRealiz;
procedure UpdateTreeVisibility;
function GetSelectedTaskID: Integer;
procedure RecalculateParentIDs;
procedure LoadTaskProperties;
procedure RecalculateLinkedDates(ParentTaskID: Integer);
procedure SgSize(aSg : TStringGrid; aPn : TPanel);

end;

var
Form1: TForm1;

var
I1,I2,I3,I4,I5,I6,I7 : Integer;
ArIn: array [0..100] of Integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
// 1. Принудительно гасим активный поток перед перестройкой структуры
Table1.Close;
Table1.Active := False;

with Table1 do
begin
Active := False;
DatabaseName := ‘C:\NP\Data’;
TableName := ‘Tasks.db’;
TableType := ttParadox;

// Стираем старые определения полей, если они были
FieldDefs.Clear;

// Базовая матрица параметров
FieldDefs.Add(‘TaskID’, ftAutoInc, 0, False);
FieldDefs.Add(‘WorkerID’, ftInteger, 0, False);
FieldDefs.Add(‘ProjectName’, ftString, 30, False);
FieldDefs.Add(‘TaskName’, ftString, 60, False);
FieldDefs.Add(‘SlotType’, ftString, 5, False);
FieldDefs.Add(‘IsActive’, ftBoolean, 0, False);
FieldDefs.Add(‘DateStart’, ftDateTime, 0, False);
FieldDefs.Add(‘DatePlan’, ftDateTime, 0, False);
FieldDefs.Add(‘DateFact’, ftDateTime, 0, False);
FieldDefs.Add(‘DeltaT’, ftInteger, 0, False);
FieldDefs.Add(‘FreezeDays’, ftInteger, 0, False);
FieldDefs.Add(‘ShiftCount’, ftInteger, 0, False);

// Поля WBS-иерархии
FieldDefs.Add(‘ParentID’, ftInteger, 0, False);
FieldDefs.Add(‘TaskLevel’, ftInteger, 0, False);
// … (предыдущие поля от TaskID до IsExpanded остаются без изменений)
FieldDefs.Add(‘IsExpanded’, ftBoolean, 0, False);

// — СВОЙСТВА И МОНИТОРИНГ ЛИСТЬЕВ (ВАРИАНТ МЕГА-ЭРГОНОМИКА) —
FieldDefs.Add(‘LinkID’, ftInteger, 0, False); // ID предшественника
FieldDefs.Add(‘WorkerName’, ftString, 30, False); // Имя исполнителя (Иванов, Петров, Сидоров)

// Метрика прогресса: 1 – Галки (Строки Типа А), 2 – Объемы (Тип Б), 3 – Время
FieldDefs.Add(‘ProgressType’, ftInteger, 0, False);

FieldDefs.Add(‘VolumeTarget’, ftFloat, 0, False); // Сколько нужно сделать по факту (для типа 2)
FieldDefs.Add(‘VolumeDone’, ftFloat, 0, False); // Сколько сделано по факту (для типа 2)

// ИНТЕЛЛЕКТУАЛЬНЫЙ КОНТЕЙНЕР ДЛЯ СТРОК ТИПА А И В:
FieldDefs.Add(‘TaskDetails’, ftMemo, 240, False); // Наше единое универсальное Memo-поле!

CreateTable;

end;

// 2. ВОЗВРАЩАЕМ БАЗУ В ШТАТНЫЙ РЕЖИМ ПАМЯТИ ПОСЛЕ СОЗДАНИЯ
Table1.Exclusive := False;
Table1.Active := True; // Прогреваем созданную структуру в памяти!

UpdateTreeVisibility;
GridDirector.Repaint;
GridMonths.Repaint;

// ShowMessage(‘Эталонная реляционная структура базы данных успешно создана на диске!’);
// — КОНТУР СОЗДАНИЯ НЕЗАВИСИМОЙ БАЗЫ РЕСУРСОВ (ЛЮДЕЙ) —
with Table1 do
begin
Active := False;
TableName := ‘Workers.db’; // Новый файл справочника исполнителей на диске
FieldDefs.Clear;

// Описываем 4 жесткие оси координат сотрудника:
FieldDefs.Add(‘WorkerID’, ftAutoInc, 0, False); // Уникальный ID (1, 2, 3…)
FieldDefs.Add(‘WorkerName’, ftString, 30, False); // ФИО или номер (Иванов, Сотрудник №1)
FieldDefs.Add(‘WorkerRole’, ftString, 30, False); // Профессия/Роль (Вводится свободно)
FieldDefs.Add(‘IsActive’, ftBoolean, 0, False); // Флаг статуса: True (В штате) / False (Вне штата)

CreateTable; // Физически создаем файл Workers.db на диске C:\NP\Data\
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// — ЮВЕЛИРНАЯ ДИСЛОКАЦИЯ ОКНА НА ЭКРАНЕ —
Form1.Left := 0;
Form1.Top := 0;

GridDirector.ColWidths[0] := 120; // Исправлено на квадратные скобки!
// GridDirector.RowHeights[0] := 36; // Делаем шапку двухэтажной (24px на месяцы + 12px на даты)
GridDirector.Options := GridDirector.Options + [goVertLine, goHorzLine];

GridDirector.ColCount := 45; // 30 дней + 1 текстовый столбец
GridDirector.DefaultColWidth := 22; // Компактная ширина дня

// Включаем двойную буферизацию для тотального безмигания
GridDirector.DoubleBuffered := True;
IsWeekScale := False; // Инициализируем глобальный тумблер

// — ДЕТЕРМИНИРОВАННЫЙ ЗАПУСК БАЗЫ В ПАМЯТИ —
Table1.Active := False;
Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;
Table1.Active := True; // Включаем прогрев таблицы в оперативной памяти!

// Вызываем первичный расчет видимости
UpdateTreeVisibility;
// PanelMonths.Visible:=True;
// PanelMonths.BringToFront;
// — КОНТУР АВТОЗАПОЛНЕНИЯ СПРАВОЧНИКА ИСПОЛНИТЕЛЕЙ —
// Временно закрываем основную таблицу задач и открываем базу людей
Table1.Close;
Table1.Active := False;
Table1.TableName := ‘Workers.db’;
Table1.Active := True;
Table1.First;

ComboWorker.Items.Clear;
ComboWorker.Items.Add(‘Не назначен’); // Нулевой вариант по умолчанию

// Сканируем базу сотрудников сверху вниз и заносим их в выпадающий список
while not Table1.Eof do
begin
if Table1.FieldByName(‘IsActive’).AsBoolean then
ComboWorker.Items.Add(Table1.FieldByName(‘WorkerName’).AsString);
Table1.Next;
end;

// Возвращаем BDE в штатный скоростной режим работы с основной таблицей задач
Table1.Close;
Table1.Active := False;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True; // Прогреваем задачи обратно в оперативной памяти

// Принудительно вызываем расчет видимости, чтобы чертеж обновился
UpdateTreeVisibility;

end;

procedure TForm1.GridFocusDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
CellDate: TDateTime;
DateStr: string;
TaskStart, TaskPlan, TaskEndWithDelta: TDateTime;
TaskDelta: Integer;
IsTaskInCell: Boolean;
begin
// — КОНТУР 1: Названия слотов —
if ACol = 0 then
begin
GridFocus.Canvas.Brush.Color := clBtnFace;
GridFocus.Canvas.FillRect(Rect);
GridFocus.Canvas.Font.Style := [fsBold];
if ARow = 1 then
GridFocus.Canvas.TextOut(Rect.Left + 5, Rect.Top + 22, ‘Слот А: Развитие’)
else if ARow = 2 then
GridFocus.Canvas.TextOut(Rect.Left + 5, Rect.Top + 22, ‘Слот Б: Пожар’);
Exit;
end;

// Расчет даты для текущего столбца
CellDate := Date + (ACol – 1);

// — КОНТУР 2: Шкала дат —
if ARow = 0 then
begin
GridFocus.Canvas.Brush.Color := clBtnFace;
if ACol = 1 then
begin
GridFocus.Canvas.Brush.Color := $00E1FFFA;
GridFocus.Canvas.Font.Style := [fsBold];
end else
GridFocus.Canvas.Font.Style := [];
GridFocus.Canvas.FillRect(Rect);
DateStr := FormatDateTime(‘dd.mm’, CellDate);
GridFocus.Canvas.TextOut(Rect.Left + 5, Rect.Top + 22, DateStr);
Exit;
end;

// — КОНТУР 3: Отрисовка чертежа проекта (Рабочая зона) —
// По умолчанию красим ячейку в белый цвет
GridFocus.Canvas.Brush.Color := clWindow;
GridFocus.Canvas.FillRect(Rect);

Table1.Active := False; // Сначала принудительно закрываем

// НАСТРОЙКА ПУТИ ДЛЯ ЧЕРТЕЖА:
Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;

Table1.Active := True; // Открываем по верному адресу
Table1.First; // Встаем на первую запись

// Бежим по таблице и ищем задачу для текущего инженера (WorkerID = 1) и текущего слота
while not Table1.Eof do
begin
if (Table1.FieldByName(‘WorkerID’).AsInteger = 1) and
(((ARow = 1) and (Table1.FieldByName(‘SlotType’).AsString = ‘A’)) or
((ARow = 2) and (Table1.FieldByName(‘SlotType’).AsString = ‘B’))) then
begin
// Считываем физические координаты времени из БД
TaskStart := Table1.FieldByName(‘DateStart’).AsDateTime;
TaskPlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
TaskDelta := Table1.FieldByName(‘DeltaT’).AsInteger;

// Вычисляем крайнюю границу с учетом допуска и заморозок
TaskEndWithDelta := TaskPlan + TaskDelta + Table1.FieldByName(‘FreezeDays’).AsInteger;

// 1. Проверяем: попадает ли текущий день сетки в ИДЕАЛЬНЫЙ ПЛАН?
if (CellDate >= TaskStart) and (CellDate <= TaskPlan) then
begin
GridFocus.Canvas.Brush.Color := $00C2F0C2; // Мягкий зеленый цвет (Идеальный размер)
GridFocus.Canvas.FillRect(Rect);

// В самой первой ячейке задачи пишем её название
if Trunc(CellDate) = Trunc(TaskStart) then
begin
GridFocus.Canvas.Font.Style := [fsItalic];
GridFocus.Canvas.Font.Color := clGray;
GridFocus.Canvas.TextOut(Rect.Left + 4, Rect.Top + 4, Table1.FieldByName(‘ProjectName’).AsString);
end;
end
// 2. Проверяем: попадает ли текущий день в ЗОНУ ДОПУСКА (? t)?
else if (CellDate > TaskPlan) and (CellDate <= TaskEndWithDelta) then
begin
GridFocus.Canvas.Brush.Color := $00E0E0E0; // Серый цвет допуска (Резерв на хаос)
GridFocus.Canvas.FillRect(Rect);
end;
end;

Table1.Next; // Переходим к следующей задаче в базе
end;

Table1.Active := False; // Закрываем таблицу
end;

procedure TForm1.BtnAddFirstTaskClick(Sender: TObject);
begin
if not Table1.Active then
begin
Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;
Table1.Active := True;
end;

Table1.First;
while not Table1.IsEmpty do Table1.Delete;

// ===========================================================================
// СТРОКА 1 (Lvl 0): ГЛОБАЛЬНЫЙ КОНТЕЙНЕР ПРОЕКТА
// ===========================================================================
Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘РАЗРАБОТКА КАМИНА “МОДЕРН”‘;
Table1.FieldByName(‘DateStart’).AsDateTime := Date; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 35;
Table1.FieldByName(‘TaskLevel’).AsInteger := 0; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘ProgressType’).AsInteger := 3; Table1.Post;

// ===========================================================================
// БЛОК 1 (Lvl 1): КОНСТРУКТОРСКИЙ ЭТАП (КБ)
// ===========================================================================
Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ Этап 1: Конструкторское КБ’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 10;
Table1.FieldByName(‘TaskLevel’).AsInteger := 1; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘ProgressType’).AsInteger := 3; Table1.Post;

// Подзадачи КБ (Листья)
Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ 1.1 Расчет гибки топка’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 3;
Table1.FieldByName(‘TaskLevel’).AsInteger := 2; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘WorkerName’).AsString := ‘Иванов И.И.’; Table1.FieldByName(‘ProgressType’).AsInteger := 1;
Table1.FieldByName(‘TaskDetails’).AsString := ‘[X]{50} Создать мат. модель’ + #13#10 + ‘[ ]{50} Выгрузить КД’; Table1.Post;

Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ 1.2 3D-проектирование облицовки’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 3; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 7;
Table1.FieldByName(‘TaskLevel’).AsInteger := 2; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘WorkerName’).AsString := ‘Сидоров С.С.’; Table1.FieldByName(‘ProgressType’).AsInteger := 1;
Table1.FieldByName(‘TaskDetails’).AsString := ‘[ ]{100} Одобрить дизайн’; Table1.Post;

Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ 1.3 Выгрузка PDF в архив КБ’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 7; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 10;
Table1.FieldByName(‘TaskLevel’).AsInteger := 2; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘WorkerName’).AsString := ‘Иванов И.И.’; Table1.FieldByName(‘ProgressType’).AsInteger := 1;
Table1.FieldByName(‘TaskDetails’).AsString := ‘[ ]{100} Проверить штампы’; Table1.Post;

// ===========================================================================
// БЛОК 2 (Lvl 1): ТЕХНОЛОГИЧЕСКИЙ ЭТАП (ПОДГОТОВКА СЕРИИ)
// ===========================================================================
Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ Этап 2: Технологическая подготовка’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 10; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 17;
Table1.FieldByName(‘TaskLevel’).AsInteger := 1; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘ProgressType’).AsInteger := 3; Table1.Post;

// Подзадачи технолога (Листья)
Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ 2.1 Карта раскроя лазера’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 10; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 14;
Table1.FieldByName(‘TaskLevel’).AsInteger := 2; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘WorkerName’).AsString := ‘Петров П.П.’; Table1.FieldByName(‘ProgressType’).AsInteger := 1;
Table1.FieldByName(‘TaskDetails’).AsString := ‘[ ]{100} Настил листа СТ3’; Table1.Post;

Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ 2.2 Расчет спецификации крепежа’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 14; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 17;
Table1.FieldByName(‘TaskLevel’).AsInteger := 2; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘WorkerName’).AsString := ‘Петров П.П.’; Table1.FieldByName(‘ProgressType’).AsInteger := 1;
Table1.FieldByName(‘TaskDetails’).AsString := ‘[ ]{100} Заявка в снабжение’; Table1.Post;

// ===========================================================================
// БЛОК 3 (Lvl 1): ПРОИЗВОДСТВЕННЫЙ ЭТАП (ЦЕХ)
// ===========================================================================
Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ Этап 3: Производство в цеху’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 17; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 30;
Table1.FieldByName(‘TaskLevel’).AsInteger := 1; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘ProgressType’).AsInteger := 3; Table1.Post;

// Подзадачи цеха (Листья)
Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ 3.1 Лазерная резка деталей’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 17; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 22;
Table1.FieldByName(‘TaskLevel’).AsInteger := 2; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘WorkerName’).AsString := ‘Сотрудник №1’; Table1.FieldByName(‘ProgressType’).AsInteger := 1;
Table1.FieldByName(‘TaskDetails’).AsString := ‘[ ]{100} Порезать 14 листов’; Table1.Post;

Table1.Append; Table1.FieldByName(‘ProjectName’).AsString := ‘Камин Модерн’; Table1.FieldByName(‘TaskName’).AsString := ‘ 3.2 Сварка и сборка топки’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date + 22; Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 30;
Table1.FieldByName(‘TaskLevel’).AsInteger := 2; Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.FieldByName(‘WorkerName’).AsString := ‘Сотрудник №4’; Table1.FieldByName(‘ProgressType’).AsInteger := 1;
Table1.FieldByName(‘TaskDetails’).AsString := ‘[ ]{100} Контрольная ТТ топка’; Table1.Post;

// — БЕЗОПАСНЫЙ СБРОС И ОБНОВЛЕНИЕ ГРАФИЧЕСКОГО КОНВЕЙЕРА —
Table1.Close; Table1.Active := False;
RecalculateParentIDs;
Table1.Active := True;

UpdateTreeVisibility;
GridDirector.Repaint; GridMonths.Repaint;

GridDirector.Row := 3; // Встаем на первую задачу КБ
LoadTaskProperties;
end;

procedure TForm1.GridFocusDblClick(Sender: TObject);
var
SelectedRow: Integer;
begin
// Узнаем, по какой строке дважды кликнул пользователь
SelectedRow := GridFocus.Row;

// Нас интересует только клик по рабочим строкам (1 – Слот А, 2 – Слот Б)
if SelectedRow = 2 then
begin
// Открываем нашу базу данных
Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;
Table1.Active := True;

Table1.First;
// Ищем нашу активную задачу развития (WorkerID = 1, SlotType = ‘A’)
while not Table1.Eof do
begin
if (Table1.FieldByName(‘WorkerID’).AsInteger = 1) and
(Table1.FieldByName(‘SlotType’).AsString = ‘A’) then
begin
// Включаем режим редактирования строки
Table1.Edit;

// МОДЕЛИРУЕМ УДАР ХАОСА:
// Цех забрал инженера. Мы принудительно начисляем +1 день к FreezeDays
// и временно выключаем активность Слота А
Table1.FieldByName(‘FreezeDays’).AsInteger := Table1.FieldByName(‘FreezeDays’).AsInteger + 1;
Table1.FieldByName(‘IsActive’).AsBoolean := False;

// Физически записываем изменения на диск
Table1.Post;
Break; // Выходим из цикла поиска
end;
Table1.Next;
end;
Table1.Active := False;

// Принудительно перерисовываем холст, чтобы увидеть изменения размеров
GridFocus.Repaint;
GridDirector.Repaint;

ShowMessage(‘Внимание! Зафиксировано прерывание из цеха. Слот А заморожен на 1 день. Допуск автоматически расширен.’);
end;
end;

procedure TForm1.BtnStageOKClick(Sender: TObject);
var
TaskStart, TaskPlan, TaskEndWithDelta: TDateTime;
TaskDelta, TaskFreeze: Integer;
FactDate: TDateTime;
ProjectName: string;
i: Integer; // Добавили переменную для цикла
begin
// — КОНТУР БЛОКИРОВКИ: Проверка Definition of Done —
for i := 0 to CheckListDone.Items.Count – 1 do
begin
if not CheckListDone.Checked[i] then
begin
// Если нашли хотя бы один неотмеченный пункт — стопорим процесс
ShowMessage(‘Физический брак сдачи! Проект не доделан.’#13#10 +
‘Не выполнен пункт: ‘ + CheckListDone.Items[i] + #13#10 +
‘Система заблокировала перевод в статус ЭтапОК.’);
Exit; // Экстренный выход из процедуры, база данных не изменится!
end;
end;

// — ДАЛЬШЕ ИДЕТ ВАШ СТАРЫЙ РАБОЧИЙ КОД КНОПКИ (БЕЗ ИЗМЕНЕНИЙ) —
// Наш прибор фиксирует текущую ФИЗИЧЕСКУЮ дату сдачи (Сегодня)
FactDate := Date;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;
Table1.Active := True;

Table1.First;
// Ищем нашу активную задачу развития
while not Table1.Eof do
begin
if (Table1.FieldByName(‘WorkerID’).AsInteger = 1) and
(Table1.FieldByName(‘SlotType’).AsString = ‘A’) and
(Table1.FieldByName(‘DateFact’).IsNull) then // Ищем еще незакрытую задачу
begin
Table1.Edit;

// Фиксируем дату сдачи в базе данных
Table1.FieldByName(‘DateFact’).AsDateTime := FactDate;
Table1.FieldByName(‘IsActive’).AsBoolean := False; // Задача больше не активна

// Считываем метрики для проведения математической экспертизы
ProjectName := Table1.FieldByName(‘ProjectName’).AsString;
TaskPlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
TaskDelta := Table1.FieldByName(‘DeltaT’).AsInteger;
TaskFreeze := Table1.FieldByName(‘FreezeDays’).AsInteger;

// Вычисляем крайнюю разрешенную границу с учетом допуска и заморозок
TaskEndWithDelta := TaskPlan + TaskDelta + TaskFreeze;

Table1.Post; // Сохраняем физически на диск

// — ГЛАВНОЕ БИНАРНОЕ ИЗМЕРЕНИЕ МОДЕЛИ —
if FactDate <= TaskEndWithDelta then
begin
// Результат ДА: Инженер уложился в чертежный допуск
ShowMessage(‘Результат: ДА!’#13#10 +
‘Проект “‘ + ProjectName + ‘” успешно сдан.’#13#10 +
‘Исполнитель уложился в рамки допусков.’);
end
else
begin
// Результат НЕТ: Брак планирования или реализации
ShowMessage(‘Результат: НЕТ (Брак по срокам)!’#13#10 +
‘Проект “‘ + ProjectName + ‘” просрочен.’#13#10 +
‘Фактическая дата сдачи вышла за пределы допуска.’);
end;

Break; // Задача найдена и обработана, выходим
end;
Table1.Next;
end;

Table1.Active := False;

// Перерисовываем холст, чтобы убрать задачу из активного потока или перекрасить её
GridFocus.Repaint;
GridDirector.Repaint;
CalculateKRealiz; // Автопересчет директорского коэффициента
end;

procedure TForm1.CalculateKRealiz;
var
TotalClosed: Integer;
SuccessfulClosed: Integer;
TaskPlan, TaskEndWithDelta: TDateTime;
TaskDelta, TaskFreeze: Integer;
FactDate: TDateTime;
KRealiz: Double;
begin
TotalClosed := 0;
SuccessfulClosed := 0;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;
Table1.Active := True;
Table1.First;

// Сканируем базу данных
while not Table1.Eof do
begin
// Нас интересуют только ЗАВЕРШЕННЫЕ задачи (где DateFact не пустое)
if not Table1.FieldByName(‘DateFact’).IsNull then
begin
TotalClosed := TotalClosed + 1;

// Считываем физические параметры для проверки допуска
FactDate := Table1.FieldByName(‘DateFact’).AsDateTime;
TaskPlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
TaskDelta := Table1.FieldByName(‘DeltaT’).AsInteger;
TaskFreeze := Table1.FieldByName(‘FreezeDays’).AsInteger;

TaskEndWithDelta := TaskPlan + TaskDelta + TaskFreeze;

// Если уложились в допуск — это успех
if FactDate <= TaskEndWithDelta then
SuccessfulClosed := SuccessfulClosed + 1;
end;
Table1.Next;
end;
Table1.Active := False;

// Расчет безразмерного коэффициента
if TotalClosed > 0 then
begin
KRealiz := SuccessfulClosed / TotalClosed;
// Выводим результат на директорский экран с точностью до двух знаков
LblKRealiz.Caption := Format(‘Коэффициент Реализации (K_реализ): %2.2f (Сдано: %d из %d)’,
[KRealiz, SuccessfulClosed, TotalClosed]);
end
else
LblKRealiz.Caption := ‘Коэффициент Реализации (K_реализ): Нет закрытых этапов’;
end;
procedure TForm1.GridDirectorDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
CellDate: TDateTime;
DateStr: string;
CurrentRow, VisibleRow: Integer;
TaskStart, TaskPlan, TaskEndWithDelta, TaskFact: TDateTime;
TaskDelta, TaskFreeze: Integer;
ProjectName: string;
CurrentID: Integer;
HasChildren: Boolean;
Bookmark: TBookmark;
BoxSize, BoxLeft, BoxTop: Integer;
PrevLvl: Integer;
ParentStatus: array[0..20] of Boolean;
i: Integer;
WeekNum: string;
begin
// — КОНТУР МАСШТАБНОЙ КООРДИНАТЫ —
if IsWeekScale then
CellDate := Date + ((ACol – 1) * 7) // Шаг времени — ровно 7 дней (Неделя)
else
CellDate := Date + (ACol – 1); // Шаг времени — 1 день (День)

// GridDirector.Canvas.Font.Name := ‘Arial Narrow’;
GridDirector.Canvas.Font.Size := 8;

// ===========================================================================
// КОНТУР 1: ЮВЕЛИРНАЯ ОТРИСОВКА ЧИСТОЙ ШКАЛЫ ДАТ (Строка 0)
// ===========================================================================
if ARow = 0 then
begin
GridDirector.Canvas.Brush.Color := clBtnFace;

if ACol = 1 then
begin
GridDirector.Canvas.Brush.Color := $00E1FFFA; // Подсветка “Сегодня”
GridDirector.Canvas.Font.Style := [fsBold];
end else
GridDirector.Canvas.Font.Style := [];

if (not IsWeekScale) and (ACol > 0) and (DayOfWeek(CellDate) = 1) then
GridDirector.Canvas.Font.Color := clRed
else
GridDirector.Canvas.Font.Color := clWindowText;

GridDirector.Canvas.FillRect(Rect);

if ACol > 0 then
begin
DateStr := FormatDateTime(‘dd’, CellDate);
// Идеальное центрирование чисел дат по вертикали и горизонтали в шапке высотой 20
GridDirector.Canvas.TextOut(
Rect.Left + ((Rect.Right – Rect.Left – GridDirector.Canvas.TextWidth(DateStr)) div 2),
Rect.Top + 4,
DateStr
);
end;
Exit;
end;

// ===========================================================================
// КОНТУР 2: ОЧИСТКА ФОНА КАЛЕНДАРНОЙ ЗОНЫ С ПОДСВЕТКОЙ ПЕРВЫХ НЕДЕЛЬ
// ===========================================================================
if ACol > 0 then
begin
// УСЛОВИЕ ПОДСВЕТКИ ВЕХ В ТЕЛЕ ГАНТА:
// Мы красим столбец в мягкий розовый цвет, ЕСЛИ это Воскресенье в детальном режиме дней,
// ЛИБО если это САМАЯ ПЕРВАЯ неделя нового месяца в масштабном режиме недель!
if (not IsWeekScale) and (DayOfWeek(CellDate) = 1) then
GridDirector.Canvas.Brush.Color := $00F0F0FF // Розовый фон для воскресений
else if IsWeekScale and ((ACol = 1) or (FormatDateTime(‘mm’, CellDate) <> FormatDateTime(‘mm’, CellDate – 7))) then
GridDirector.Canvas.Brush.Color := $00F0F0FF // Мягкий розовый маркер СТАРТА НОВОГО МЕСЯЦА для недель!
else
GridDirector.Canvas.Brush.Color := clWindow; // Чистый белый рабочий фон

GridDirector.Canvas.FillRect(Rect);
end;

// ===========================================================================
// КОНТУР 3: Реляционное сканирование базы данных Paradox (в оперативной памяти)
// ===========================================================================
// ВАЖНО: Мы НЕ закрываем и НЕ открываем таблицу заново!
// Мы просто проверяем, чтобы она была активна, и прыгаем на старт.
if not Table1.Active then Table1.Active := True;
Table1.First;

for i := 0 to 20 do ParentStatus[i] := True;
CurrentRow := 0;
VisibleRow := 0;

while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;
TaskDelta := Table1.FieldByName(‘TaskLevel’).AsInteger;

if (TaskDelta = 0) or ParentStatus[TaskDelta] then
begin
VisibleRow := VisibleRow + 1;
ParentStatus[TaskDelta + 1] := Table1.FieldByName(‘IsExpanded’).AsBoolean;

if ARow = VisibleRow then
begin
ProjectName := Table1.FieldByName(‘TaskName’).AsString;
CurrentID := Table1.FieldByName(‘TaskID’).AsInteger;

// ———————————————————————
// ПОДКОНТУР 3.1: ТЕКСТОВАЯ ПАНЕЛЬ ДЕРЕВА (СТОЛБЕЦ 0)
// ———————————————————————
if ACol = 0 then
begin
GridDirector.Canvas.Brush.Color := clBtnFace;
GridDirector.Canvas.FillRect(Rect);

// Проверяем наличие подзадач
HasChildren := False; Bookmark := Table1.GetBookmark;
try
Table1.First;
while not Table1.Eof do begin if Table1.FieldByName(‘ParentID’).AsInteger = CurrentID then begin HasChildren := True; Break; end; Table1.Next; end;
finally Table1.GotoBookmark(Bookmark); Table1.FreeBookmark(Bookmark); end;

// Контур логического аудита аномалий (Курсив)
PrevLvl := 0; Bookmark := Table1.GetBookmark;
try
Table1.First; i := 0;
while not Table1.Eof do begin
i := i + 1;
if i = (CurrentRow – 1) then begin PrevLvl := Table1.FieldByName(‘TaskLevel’).AsInteger; Break; end;
Table1.Next;
end;
finally Table1.GotoBookmark(Bookmark); Table1.FreeBookmark(Bookmark); end;

GridDirector.Canvas.Font.Color := clWindowText;
if (CurrentRow > 1) and (TaskDelta > (PrevLvl + 1)) then
begin
if TaskDelta = 0 then GridDirector.Canvas.Font.Style := [fsBold, fsItalic] else GridDirector.Canvas.Font.Style := [fsItalic];
GridDirector.Canvas.Font.Color := clRed;
end
else
begin
if TaskDelta = 0 then GridDirector.Canvas.Font.Style := [fsBold] else GridDirector.Canvas.Font.Style := [];
end;

if HasChildren then
begin
BoxSize := 11; BoxLeft := Rect.Left + (TaskDelta * 14) + 4; BoxTop := Rect.Top + ((Rect.Bottom – Rect.Top – BoxSize) div 2);
GridDirector.Canvas.Pen.Color := clGray; GridDirector.Canvas.Brush.Color := clBtnFace;
GridDirector.Canvas.Rectangle(BoxLeft, BoxTop, BoxLeft + BoxSize, BoxTop + BoxSize);
GridDirector.Canvas.MoveTo(BoxLeft + 2, BoxTop + (BoxSize div 2)); GridDirector.Canvas.LineTo(BoxLeft + BoxSize – 2, BoxTop + (BoxSize div 2));
if not Table1.FieldByName(‘IsExpanded’).AsBoolean then begin
GridDirector.Canvas.MoveTo(BoxLeft + (BoxSize div 2), BoxTop + 2); GridDirector.Canvas.LineTo(BoxLeft + (BoxSize div 2), BoxTop + BoxSize – 2);
end;
end;
// if Table1.FieldByName(‘LinkID’).AsString<>” then St:=’ &’ else St:=”;
if Table1.FieldByName(‘LinkID’).AsInteger<>0 then St:=’ &’ else St:=”;
if I_link=Arow then GridDirector.Canvas.Font.Color := clBlue;
GridDirector.Canvas.TextOut(Rect.Left + (TaskDelta * 14) + 18, Rect.Top + 3, ProjectName+St);
end
// ———————————————————————
// ПОДКОНТУР 3.2: АНТИМИГАЛЬНЫЕ КВАНТЫ ГАНТА (СТОЛБЦЫ > 0)
// ———————————————————————
else
begin
if ACol > 0 then
begin
TaskStart := Table1.FieldByName(‘DateStart’).AsDateTime;
TaskPlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
TaskDelta := Table1.FieldByName(‘DeltaT’).AsInteger;
TaskFreeze := Table1.FieldByName(‘FreezeDays’).AsInteger;
TaskEndWithDelta := Trunc(TaskPlan) + TaskDelta + TaskFreeze;

if not Table1.FieldByName(‘DateFact’).IsNull then
begin
TaskFact := Table1.FieldByName(‘DateFact’).AsDateTime;
if (Trunc(CellDate) >= Trunc(TaskStart)) and (Trunc(CellDate) <= Trunc(TaskFact)) then
begin
GridDirector.Canvas.Brush.Color := $00FFE6CC; GridDirector.Canvas.FillRect(Rect);
if Trunc(CellDate) = Trunc(TaskStart) then begin
GridDirector.Canvas.Font.Style := [fsUnderline]; GridDirector.Canvas.Font.Color := clNavy;
GridDirector.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, ‘[ОК]’);
end;
end;
end
else
begin
if (Trunc(CellDate) >= Trunc(TaskStart)) and (Trunc(CellDate) <= Trunc(TaskPlan)) then
begin
GridDirector.Canvas.Brush.Color := $00C2F0C2; GridDirector.Canvas.FillRect(Rect);
end
else if (TaskFreeze > 0) and (Trunc(CellDate) > Trunc(TaskPlan) + TaskDelta) and (Trunc(CellDate) <= TaskEndWithDelta) then
begin
GridDirector.Canvas.Brush.Color := $00D0D0FF; GridDirector.Canvas.FillRect(Rect);
end
else if (Trunc(CellDate) > Trunc(TaskPlan)) and (Trunc(CellDate) <= TaskEndWithDelta) then
begin
GridDirector.Canvas.Brush.Color := $00E0E0E0; GridDirector.Canvas.FillRect(Rect);
end;
end;
end;
end;

// — Монолитная черная рамка выделения активной строки —
if ARow = GridDirector.Row then
begin
GridDirector.Canvas.Pen.Color := clBlack; GridDirector.Canvas.Pen.Style := psSolid;
GridDirector.Canvas.MoveTo(Rect.Left, Rect.Top); GridDirector.Canvas.LineTo(Rect.Right, Rect.Top);
GridDirector.Canvas.MoveTo(Rect.Left, Rect.Bottom – 1); GridDirector.Canvas.LineTo(Rect.Right, Rect.Bottom – 1);
end;
Break;
end;
end
else
begin
ParentStatus[TaskDelta + 1] := False;
end;
Table1.Next;
end;
// Обратите внимание: ТАБЛИЦУ МЫ НЕ ЗАКРЫВАЕМ (Удалено Table1.Active := False)
end;

procedure TForm1.BtnClearDBClick(Sender: TObject);
begin
// 1. Закрываем активный поток в памяти
Table1.Close;
Table1.Active := False;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;

// 2. Включаем монопольный режим для физического стирания файла
Table1.Exclusive := True;
try
Table1.Open;
Table1.EmptyTable;
finally
Table1.Close;
Table1.Exclusive := False;
end;

// 3. Возвращаем чистую базу в штатный скоростной режим оперативной памяти
Table1.Active := True;

// Синхронно обнуляем и перерисовываем все приборы экрана
UpdateTreeVisibility;
GridDirector.Repaint;
GridMonths.Repaint;

// Очищаем нижнюю панель свойств, так как задач больше нет
LoadTaskProperties;

// ShowMessage(‘База данных успешно очищена и перезапущена в памяти с нуля!’);
end;

procedure TForm1.GridDirectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
CurrentRow, VisibleRow: Integer;
TaskLevel: Integer;
ClickMinX, ClickMaxX: Integer;
BoxSize: Integer;
R: TRect;
IsIconClicked: Boolean;
HasChildren: Boolean;
CurrentID: Integer;
Bookmark: TBookmark;
TextLeftOffset, ClickedTaskID,Days: Integer;
ParentStatus: array[0..20] of Boolean;
i: Integer;
begin //GridDirector.TopRow:=1; // GridMonths.Refresh;
GridDirector.MouseToCell(X, Y, ACol, ARow);

// — ЖЕСТКАЯ КОРРЕКЦИЯ ДЛЯ ЗОНЫ ХАОСА (-1, -1) —
// Если VCL-движок Delphi испугался широкой текстовой границы и выдал ошибку диапазона,
// мы вручную вычисляем координаты в пикселях со 100% точностью!
if (ARow = -1) and (Y > 24) then // Если кликнули ниже шапки дат (которая 24px)
begin
ACol := 0; // Мы железно знаем, что директор кликает по текстовому полю WBS-дерева

// Математика ручного расчета строки: из координаты Y вычитаем высоту шапки (24)
// и делим на высоту наших компактных рабочих строк (20 пикселей)
ARow := ((Y – 24) div 20) + 1;

// Защита от клика ниже последней задачи
if ARow >= GridDirector.RowCount then
ARow := GridDirector.RowCount – 1;
end;

// ===========================================================================
// БРОНИРОВАННЫЙ ПЕРЕХВАТЧИК: РЕЖИМ СВЯЗЫВАНИЯ ЗАДАЧ МЫШКОЙ (ЛИНКОВЩИК)
// ===========================================================================
if BtnLinkMode.Down and (ARow > 0) then
begin
// Намертво фиксируем текущую строку, на которой стоял зам перед кликом линковки
i := GridDirector.Row;

// — ЗАЩИТНЫЙ ШЛЮЗ А: КАТЕГОРИЧЕСКИЙ ЗАПРЕТ СВЯЗИ С КОРНЕМ (СТРОКА 1) —
if ARow = 1 then
begin
ShowMessage(‘Брак связи: Запрещено привязывать задачу к главному корню проекта!’);
BtnLinkMode.Down := False; // Отжимаем кнопку-тумблер
GridDirector.Row := i; // Жестко удерживаем черную рамку на исходной задаче
GridDirector.Repaint;
Exit; // Экстренно выходим из мыши, полностью блокируя сдвиг фокуса!
end;

// 1. Узнаем TaskID и параметры той задачи, ПО КОТОРОЙ КЛИКНУЛИ МЫШКОЙ
ClickedTaskID := -1;
if not Table1.Active then Table1.Active := True;
Table1.First;
CurrentRow := 0; VisibleRow := 0;
for Days := 0 to 20 do ParentStatus[Days] := True;

while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;
TaskLevel := Table1.FieldByName(‘TaskLevel’).AsInteger;
if (TaskLevel = 0) or ParentStatus[TaskLevel] then
begin
VisibleRow := VisibleRow + 1;
ParentStatus[TaskLevel + 1] := Table1.FieldByName(‘IsExpanded’).AsBoolean;
if ARow = VisibleRow then
begin
ClickedTaskID := Table1.FieldByName(‘TaskID’).AsInteger;
Break;
end;
end else ParentStatus[TaskLevel + 1] := False;
Table1.Next;
end;

// 2. ЗАЩИТНЫЙ ШЛЮЗ Б: Задача не может быть предшественником самой себе
if ClickedTaskID = EditingTaskID then
begin
ShowMessage(‘Брак связи: Нельзя связать задачу с самой собой!’);
BtnLinkMode.Down := False;
GridDirector.Row := i;
GridDirector.Repaint;
Exit;
end;

// 3. ЗАЩИТНЫЙ ШЛЮЗ В: Запрет связи со своим родителем-этапом
if Table1.Locate(‘TaskID’, EditingTaskID, []) then
begin
if Table1.FieldByName(‘ParentID’).AsInteger = ClickedTaskID then
begin
ShowMessage(‘Брак связи: Запрещено привязывать задачу к её собственному макроэтапу!’);
BtnLinkMode.Down := False;
GridDirector.Row := i;
GridDirector.Repaint;
Exit;
end;
end;

// 4. РЕЛЯЦИОННОЕ ЗАМЫКАНИЕ ЦЕПИ В ПАМЯТИ
if (ClickedTaskID <> -1) and (EditingTaskID <> -1) then
begin
if Table1.Locate(‘TaskID’, EditingTaskID, []) then
begin
Table1.Edit;
Table1.FieldByName(‘LinkID’).AsInteger := ClickedTaskID;
Table1.Post;
RecalculateLinkedDates(ClickedTaskID);
end;
BtnLinkMode.Down := False;
ShowMessage(‘Связь Finish-to-Start успешно установлена в один клик!’);
end;

// Полное восстановление геометрии без малейшего микроперескока рамки!
UpdateTreeVisibility;
GridDirector.Row := i; // Жесткий прижим фокуса на исходной строке
GridDirector.Repaint;
LoadTaskProperties;
Exit; // Полностью гасим клик для стандартного VCL-движка
end;

// — КОНТУР УПРАВЛЕНИЯ МАСШТАБОМ ВРЕМЕНИ ПО КЛИКУ НА ШАПКУ —
if ARow = 0 then
begin
IsWeekScale := not IsWeekScale; // Меняем масштаб (День <-> Неделя)

// ПРИНУДИТЕЛЬНО ЗАПУСКАЕМ СКВОЗНОЙ ПЕРЕРАСЧЕТ ОБЕИХ СЕТОК В ПАМЯТИ:
UpdateTreeVisibility;

GridDirector.Repaint;
GridMonths.Repaint; // Перерисовываем макропанель месяцев
Exit; // Выходим из процедуры клика
end;

if (ACol = 0) and (ARow > 0) then
begin
// iF4:=GridDirector.TopRow;
GridDirector.Row := ARow;
GridDirector.Repaint; // Сразу прорисовываем черную сквозную рамку выделения всей строки
end;

if (ACol = 0) and (ARow > 0) then
begin
for i := 0 to 20 do ParentStatus[i] := True;

// Чистая работа с оперативной памятью: проверяем, что база активна, и встаем на First
if not Table1.Active then Table1.Active := True;
Table1.First;

CurrentRow := 0;
VisibleRow := 0;
IsIconClicked := False;

while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;
TaskLevel := Table1.FieldByName(‘TaskLevel’).AsInteger;

if (TaskLevel = 0) or ParentStatus[TaskLevel] then
begin
VisibleRow := VisibleRow + 1;
ParentStatus[TaskLevel + 1] := Table1.FieldByName(‘IsExpanded’).AsBoolean;

if ARow = VisibleRow then
begin
CurrentID := Table1.FieldByName(‘TaskID’).AsInteger;
BoxSize := 11;

ClickMinX := (TaskLevel * 14) + 4;
ClickMaxX := ClickMinX + BoxSize;

HasChildren := False; Bookmark := Table1.GetBookmark;
try
Table1.First;
while not Table1.Eof do
begin
if Table1.FieldByName(‘ParentID’).AsInteger = CurrentID then
begin
HasChildren := True;
Break;
end;
Table1.Next;
end;
finally
Table1.GotoBookmark(Bookmark);
Table1.FreeBookmark(Bookmark);
end;

if ssCtrl in Shift then begin Table1.Locate(‘TaskID’,ARow,[]);I_link:=Table1.FieldByName(‘LinkID’).AsInteger;if I_link=0 then I_link:=-1;end else I_link:=-1;
// ===================================================================
// РЕЖИМ 1: Клик БЕЗ Shift — Сворачивание / Разворачивание дерева
// ===================================================================

if not (ssShift in Shift) then
begin
EditCell.Visible := False;

if HasChildren and (X >= ClickMinX) and (X <= ClickMaxX) then
begin
Table1.Edit;
Table1.FieldByName(‘IsExpanded’).AsBoolean := not Table1.FieldByName(‘IsExpanded’).AsBoolean;
Table1.Post;
IsIconClicked := True;
end;
end
// — РЕЖИМ 2: Клик С ЗАЖАТЫМ SHIFT — Ювелирное редактирование текста —
else
begin
EditingTaskID := Table1.FieldByName(‘TaskID’).AsInteger;

R := GridDirector.CellRect(ACol, ARow);
TextLeftOffset := (TaskLevel * 14) + 18;

// ЮВЕЛИРНОЕ ЦЕНТРИРОВАНИЕ ОКНА РЕДАКТИРОВАНИЯ:
// При высоте строки 20 пикселей, TEdit с высотой 14 ложится ровно по центру,
// если мы задаем ему отступ Top + 2 пикселя от верхней границы ячейки!
EditCell.Left := GridDirector.Left + R.Left + TextLeftOffset;
EditCell.Top := GridDirector.Top + R.Top + 6; // Жесткий отступ 2px для идеального выравнивания
EditCell.Width := (R.Right – R.Left) – TextLeftOffset – 4;
EditCell.Height := 14; // Высота самого инпута без рамок под шрифт 8pt

EditCell.Text := Table1.FieldByName(‘TaskName’).AsString;
EditCell.Visible := True;
EditCell.SetFocus;
EditCell.SelectAll;
end;

Break;
end;
end
else
begin
ParentStatus[TaskLevel + 1] := False;
end;

Table1.Next;
end;

if IsIconClicked then
UpdateTreeVisibility;

GridDirector.Repaint;
end;
LoadTaskProperties;
end;

procedure TForm1.UpdateTreeVisibility;
var
CurrentRow, VisibleCount: Integer;
ParentStatus: array[0..20] of Boolean;
Level: Integer;
MaxTextWidth: Integer;
TextWidth: Integer;
TotalGridHeight: Integer;
i: Integer;
CellDate: TDateTime; // <— ДОБАВИТЬ СЮДА
DateStr: string; // <— ДОБАВИТЬ СЮДА
begin
// 1. Инициализация фильтра иерархии
for Level := 0 to 20 do
ParentStatus[Level] := True;

MaxTextWidth := 120;

if not Table1.Active then
begin
Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;
Table1.Active := True;
end;
Table1.First;

CurrentRow := 0;
while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;
Table1.Next;
end;

// Временно расширяем сетку, чтобы избежать ошибки Out of range
GridDirector.RowCount := CurrentRow + 2;

// — ЦИКЛ 1: Расчет идеальной автоширины текста —
Table1.First;
while not Table1.Eof do
begin
Level := Table1.FieldByName(‘TaskLevel’).AsInteger;
TextWidth := GridDirector.Canvas.TextWidth(Table1.FieldByName(‘TaskName’).AsString) + (Level * 14) + 25;
if TextWidth > MaxTextWidth then
MaxTextWidth := TextWidth;
Table1.Next;
end;

// — ЦИКЛ 2: Фильтрация видимости и ювелирный подсчет высот —
Table1.First;
VisibleCount := 0;
TotalGridHeight := 20; // Высота шапки дат (строка 0)

while not Table1.Eof do
begin
Level := Table1.FieldByName(‘TaskLevel’).AsInteger;
// if i = 0 then GridDirector.RowHeights[i] := 20; // Двухэтажная шапка дат и месяцев
// — ПРАВИЛО АБСОЛЮТНОГО ИММУНИТЕТА ДЛЯ ПРОЕКТА (УРОВЕНЬ 0) —
if Level = 0 then
begin
VisibleCount := VisibleCount + 1;
GridDirector.RowHeights[VisibleCount] := 20;
TotalGridHeight := TotalGridHeight + 20;

// ЖЕСТКОЕ ЛЕЧЕНИЕ: Если база из-за клонирования затерла реляционный ноль,
// мы принудительно возвращаем проекту статус главного корневого узла!
if Table1.FieldByName(‘ParentID’).AsInteger <> 0 then
begin
Table1.Edit;
Table1.FieldByName(‘ParentID’).AsInteger := 0;
Table1.Post;
end;

ParentStatus[Level + 1] := Table1.FieldByName(‘IsExpanded’).AsBoolean;
end
else
begin
// Проверяем шлюз раскрытия родительских веток
if ParentStatus[Level] then
begin
VisibleCount := VisibleCount + 1;
GridDirector.RowHeights[VisibleCount] := 20;
TotalGridHeight := TotalGridHeight + 20;
ParentStatus[Level + 1] := Table1.FieldByName(‘IsExpanded’).AsBoolean;
end
else
begin
ParentStatus[Level + 1] := False; // Ветка скрыта
end;
end;

Table1.Next;
end;

// — КОНТУР 3: Фиксация количества РЕАЛЬНО видимых строк —
GridDirector.RowCount := VisibleCount + 1;

// ===========================================================================
// КОНТУР 4: УМНЫЙ РАСЧЕТ ГАБАРИТОВ ПО ЗАКОНУ УЧЕТА ГРАНИЦ ФИЗИКА-ЭКСПЕРИМЕНТАТОРА
// ===========================================================================
// Вычисляем лимит высоты под макет
Level := TabSheet2.Height – 250;
if Level < 100 then Level := 400;

// Математически точный расчет зазора на внутренние Grid Lines:
// Каждая линия съедает по 1 пикселю + 2 пикселя на внешнюю кромку рамки сетки
i := GridDirector.RowCount * 1 + 2;

if (TotalGridHeight + i) <= Level then
begin
// Обрезаем высоту компонента на форме строго по вашей формуле
GridDirector.Height := TotalGridHeight + i+1;
GridDirector.ScrollBars := ssNone; // Убираем скроллбар, всё влезло!
end
else
begin
// Если задач больше лимита — фиксируем высоту и даем только вертикальный скролл
GridDirector.Height := Level;
GridDirector.ScrollBars := ssVertical;
end;
// ===========================================================================
// НАСТРОЙКА СИНХРОНИЗАЦИИ ГЕОМЕТРИИ ПАРЯЩЕЙ ПАНЕЛИ МЕСЯЦЕВ
// ===========================================================================
GridMonths.Left := GridDirector.Left+2;
GridMonths.Width := GridDirector.Width;
GridMonths.ColCount := GridDirector.ColCount;
GridMonths.DefaultColWidth := GridDirector.DefaultColWidth;
GridMonths.ColWidths[0] := MaxTextWidth; // Синхронизируем первый столбец текста WBS

// Выставляем автоширину первого столбца нижней сетки
GridDirector.ColWidths[0] := MaxTextWidth;
Self.Realign;
end;

procedure TForm1.BtnNewTaskClick(Sender: TObject);
type
TTaskRec = record // Структура для временного хранения строк в памяти
WorkerID, ShiftCount, FreezeDays, ParentID, TaskLevel, DeltaT: Integer;
ProjectName, TaskName, SlotType: string;
DateStart, DatePlan, DateFact: TDateTime;
IsActive, IsExpanded: Boolean;
end;
var
Buffer: array of TTaskRec;
SelectedRow, CurrentRow, TotalRecords, i: Integer;
NewLevel: Integer; S:String;
begin
SelectedRow := GridDirector.Row; // Индекс строки, под которую вставляем
if SelectedRow < 0 then SelectedRow := 0;

GridDirector.RowCount := GridDirector.RowCount + 1;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;

// 1. Считываем уровень вложенности текущей выделенной строки
NewLevel := 1;
Table1.First;
CurrentRow := 0;
while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;
if CurrentRow = SelectedRow then
begin
NewLevel := Table1.FieldByName(‘TaskLevel’).AsInteger;
Break;
end;
Table1.Next;
end;

// 2. Считываем все записи из базы в массив памяти
Table1.First;
TotalRecords := 0;
while not Table1.Eof do
begin
SetLength(Buffer, TotalRecords + 1);
Buffer[TotalRecords].WorkerID := Table1.FieldByName(‘WorkerID’).AsInteger;
Buffer[TotalRecords].ProjectName := Table1.FieldByName(‘ProjectName’).AsString;
Buffer[TotalRecords].TaskName := Table1.FieldByName(‘TaskName’).AsString;
Buffer[TotalRecords].SlotType := Table1.FieldByName(‘SlotType’).AsString;
Buffer[TotalRecords].IsActive := Table1.FieldByName(‘IsActive’).AsBoolean;
Buffer[TotalRecords].DateStart := Table1.FieldByName(‘DateStart’).AsDateTime;
Buffer[TotalRecords].DatePlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
Buffer[TotalRecords].DeltaT := Table1.FieldByName(‘DeltaT’).AsInteger;
Buffer[TotalRecords].FreezeDays := Table1.FieldByName(‘FreezeDays’).AsInteger;
Buffer[TotalRecords].ShiftCount := Table1.FieldByName(‘ShiftCount’).AsInteger;
Buffer[TotalRecords].ParentID := Table1.FieldByName(‘ParentID’).AsInteger;
Buffer[TotalRecords].TaskLevel := Table1.FieldByName(‘TaskLevel’).AsInteger;
Buffer[TotalRecords].IsExpanded := Table1.FieldByName(‘IsExpanded’).AsBoolean;
if not Table1.FieldByName(‘DateFact’).IsNull then
Buffer[TotalRecords].DateFact := Table1.FieldByName(‘DateFact’).AsDateTime
else
Buffer[TotalRecords].DateFact := 0;

TotalRecords := TotalRecords + 1;
Table1.Next;
end;

// 3. Очищаем физическую таблицу на диске
Table1.Active := False;
Table1.Exclusive := True;
Table1.Active := True;
Table1.EmptyTable;
Table1.Active := False;
Table1.Exclusive := False;
Table1.Active := True;

// 4. Записываем данные обратно, вклинивая новую строку
for i := 0 to TotalRecords – 1 do
begin
// Записываем старую задачу из буфера
Table1.Append;
Table1.FieldByName(‘WorkerID’).AsInteger := Buffer[i].WorkerID;
Table1.FieldByName(‘ProjectName’).AsString := Buffer[i].ProjectName;
Table1.FieldByName(‘TaskName’).AsString := Buffer[i].TaskName;
Table1.FieldByName(‘SlotType’).AsString := Buffer[i].SlotType;
Table1.FieldByName(‘IsActive’).AsBoolean := Buffer[i].IsActive;
Table1.FieldByName(‘DateStart’).AsDateTime := Buffer[i].DateStart;
Table1.FieldByName(‘DatePlan’).AsDateTime := Buffer[i].DatePlan;
Table1.FieldByName(‘DeltaT’).AsInteger := Buffer[i].DeltaT;
Table1.FieldByName(‘FreezeDays’).AsInteger := Buffer[i].FreezeDays;
Table1.FieldByName(‘ShiftCount’).AsInteger := Buffer[i].ShiftCount;
Table1.FieldByName(‘ParentID’).AsInteger := Buffer[i].ParentID;
Table1.FieldByName(‘TaskLevel’).AsInteger := Buffer[i].TaskLevel;
Table1.FieldByName(‘IsExpanded’).AsBoolean := Buffer[i].IsExpanded;
if Buffer[i].DateFact > 0 then Table1.FieldByName(‘DateFact’).AsDateTime := Buffer[i].DateFact;
Table1.Post;

// Если мы только что записали ту самую выделенную строку —
// немедленно создаем ПОД НЕЙ её точную копию-заготовку!
if (i + 1) = SelectedRow then
begin
Table1.Append;

// КЛОНИРОВАНИЕ ПАРАМЕТРОВ: Копируем данные из выделенной строки
Table1.FieldByName(‘WorkerID’).AsInteger := Buffer[i].WorkerID;
Table1.FieldByName(‘ProjectName’).AsString := Buffer[i].ProjectName;

// К имени добавляем пометку (Копия), чтобы пользователь видел дубликат,
// но мог сразу нажать Shift+Клик и переименовать
// УМНОЕ КЛОНИРОВАНИЕ ИМЕНИ: Если строка уже содержит пометку (Копия),
// мы берем оригинальное имя задачи, не допуская разрастания хвостов на экране!
S := Buffer[i].TaskName;
if Pos(‘ (Копия)’, S) > 0 then
// Отрезаем старый хвост (Копия), если он есть
S := Copy(S, 1, Pos(‘ (Копия)’, S) – 1);

Table1.FieldByName(‘TaskName’).AsString := S + ‘ (Копия)’;

Table1.FieldByName(‘SlotType’).AsString := Buffer[i].SlotType;
Table1.FieldByName(‘IsActive’).AsBoolean := Buffer[i].IsActive;

// Копируем временные масштабы (размер чертежа и допуск)
Table1.FieldByName(‘DateStart’).AsDateTime := Buffer[i].DateStart;
Table1.FieldByName(‘DatePlan’).AsDateTime := Buffer[i].DatePlan;
Table1.FieldByName(‘DeltaT’).AsInteger := Buffer[i].DeltaT;

// Счетчик хаоса для новой задачи сбрасываем в 0 (её цех еще не успел сломать)
Table1.FieldByName(‘FreezeDays’).AsInteger := 0;
Table1.FieldByName(‘ShiftCount’).AsInteger := 0;

// Параметры иерархии: наследуем уровень соседа сверху
Table1.FieldByName(‘ParentID’).AsInteger := 0; // Пересчитается автоматически через секунду
Table1.FieldByName(‘TaskLevel’).AsInteger := Buffer[i].TaskLevel;
Table1.FieldByName(‘IsExpanded’).AsBoolean := True;

Table1.Post;
end;

end;

// Если кликнули на пустое место или база была пуста, добавляем в самый конец
if SelectedRow = 0 then
begin
Table1.Append;
Table1.FieldByName(‘WorkerID’).AsInteger := 1;
Table1.FieldByName(‘ProjectName’).AsString := ‘Новый Камин’;
Table1.FieldByName(‘TaskName’).AsString := ‘Новая задача (введите имя)’;
Table1.FieldByName(‘SlotType’).AsString := ‘A’;
Table1.FieldByName(‘DateStart’).AsDateTime := Date;
Table1.FieldByName(‘DatePlan’).AsDateTime := Date + 3;
Table1.FieldByName(‘DeltaT’).AsInteger := 1;
Table1.FieldByName(‘FreezeDays’).AsInteger := 0;
Table1.FieldByName(‘ShiftCount’).AsInteger := 0;
Table1.FieldByName(‘ParentID’).AsInteger := 0;
Table1.FieldByName(‘TaskLevel’).AsInteger := 0; // На самый верхний уровень
Table1.FieldByName(‘IsExpanded’).AsBoolean := True;
Table1.Post;
end;

Table1.Active := False;
RecalculateParentIDs; // Восстанавливаем пропавшие плюсики
UpdateTreeVisibility;

// Сдвигаем курсор сетки на только что созданную строку, чтобы директор сразу её видел
if SelectedRow > 0 then GridDirector.Row := SelectedRow + 1;

GridDirector.Repaint;
end;

procedure TForm1.Button2Click(Sender: TObject);
// Можно повесить на отдельную кнопку “Переименовать”
var
NewName: string;
CurrentRow, SelectedRow: Integer;
begin
SelectedRow := GridDirector.Row;
if SelectedRow <= 0 then Exit;

Table1.Active := True;
Table1.First;
CurrentRow := 0;
while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;
if CurrentRow = SelectedRow then
begin
NewName := InputBox(‘Редактирование задачи’, ‘Введите новое название:’, Table1.FieldByName(‘TaskName’).AsString);
if NewName <> ” then
begin
Table1.Edit;
Table1.FieldByName(‘TaskName’).AsString := NewName;
Table1.Post;
end;
Break;
end;
Table1.Next;
end;
Table1.Active := False;
UpdateTreeVisibility;
GridDirector.Repaint;
end;

procedure TForm1.BtnIndentClick(Sender: TObject);
var
SelID: Integer;
Lvl, PrevLvl: Integer;
CurrentRow: Integer;
begin
SelID := GetSelectedTaskID;
if SelID = -1 then Exit;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;

// 1. Сначала узнаем уровень вложенности соседа СВЕРХУ
PrevLvl := 0; // Если соседа сверху нет, лимит равен уровню проекта (0)
Table1.First;
CurrentRow := 0;
while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;
// Нашли соседа прямо перед нашей выделенной строкой
if CurrentRow = (GridDirector.Row – 1) then
begin
PrevLvl := Table1.FieldByName(‘TaskLevel’).AsInteger;
Break;
end;
Table1.Next;
end;

// 2. Проверяем нашу выделенную задачу
if Table1.Locate(‘TaskID’, SelID, []) then
begin
Lvl := Table1.FieldByName(‘TaskLevel’).AsInteger;

// ЖЕСТКИЙ ЗАКОН ИЕРАРХИИ: Сдвиг вправо разрешен только если
// наш новый уровень не превысит уровень соседа сверху + 1 (и не более 10)
if (Lvl < 10) and (Lvl < (PrevLvl + 1)) then
begin
Table1.Edit;
Table1.FieldByName(‘TaskLevel’).AsInteger := Lvl + 1;

// Автоматически подвязываем к ID соседа сверху, чтобы прорисовался ПЛЮСИК!
Table1.Post;
end;
end;

Table1.Active := False;

// Автоматически пересчитываем реляционные связи ParentID для всей базы
// (чтобы значки плюсиков всегда знали, у кого появились дети)
RecalculateParentIDs;
UpdateTreeVisibility;
GridDirector.Repaint;
end;

procedure TForm1.BtnOutdentClick(Sender: TObject);
var
SelID: Integer;
Lvl: Integer;
begin
SelID := GetSelectedTaskID;
if SelID = -1 then Exit;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;

if Table1.Locate(‘TaskID’, SelID, []) then
begin
Lvl := Table1.FieldByName(‘TaskLevel’).AsInteger;
if Lvl > 0 then
begin
Table1.Edit;
Table1.FieldByName(‘TaskLevel’).AsInteger := Lvl – 1;
Table1.Post;
end;
end;
Table1.Active := False;
RecalculateParentIDs; // Восстанавливаем пропавшие плюсики
UpdateTreeVisibility;
GridDirector.Repaint;
end;

procedure TForm1.BtnDeleteTaskClick(Sender: TObject);
var
SelID: Integer;
begin
SelID := GetSelectedTaskID;
if SelID = -1 then Exit;

if MessageDlg(‘Удалить выбранную задачу и её подзадачи?’, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;

if Table1.Locate(‘TaskID’, SelID, []) then
begin
Table1.Delete; // Удаляем строго целевую задачу по её ID
end;
Table1.Active := False;

UpdateTreeVisibility;
GridDirector.Repaint;
end;
end;

procedure TForm1.EditCellKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then // ENTER
begin
Key := #0;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;

// НАХОДИМ ЗАПИСЬ В БАЗЕ ПО УНИКАЛЬНОМУ КЛЮЧУ:
// Параметры: имя поля, искомое значение, настройки поиска
if Table1.Locate(‘TaskID’, EditingTaskID, []) then
begin
Table1.Edit;
Table1.FieldByName(‘TaskName’).AsString := EditCell.Text; // Пишем строго в цель
Table1.Post;
end;

Table1.Active := False;

EditCell.Visible := False;
UpdateTreeVisibility;
GridDirector.Repaint;
end;
end;

procedure TForm1.EditCellExit(Sender: TObject);
begin
EditCell.Visible := False; // Просто прячем инпут, если пользователь передумал
end;

function TForm1.GetSelectedTaskID: Integer;
var
CurrentRow, VisibleRow: Integer;
begin
Result := -1; // По умолчанию – не найдено
if GridDirector.Row <= 0 then Exit;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;
Table1.First;

CurrentRow := 0;
VisibleRow := 0;

while not Table1.Eof do
begin
CurrentRow := CurrentRow + 1;

// Если строка физически видна на экране (её высота не равна 0)
if GridDirector.RowHeights[CurrentRow] > 0 then
begin
VisibleRow := VisibleRow + 1;

// Если индекс видимой строки совпал с курсором директора
if VisibleRow = GridDirector.Row then
begin
Result := Table1.FieldByName(‘TaskID’).AsInteger; // Извлекаем точный ключ!
Break;
end;
end;
Table1.Next;
end;
Table1.Active := False;
end;

procedure TForm1.BtnMoveUpClick(Sender: TObject);
type
TTaskRec = record
WorkerID, ShiftCount, FreezeDays, ParentID, TaskLevel, DeltaT: Integer;
ProjectName, TaskName, SlotType: string;
DateStart, DatePlan, DateFact: TDateTime;
IsActive, IsExpanded: Boolean;
end;
var
Buffer: array of TTaskRec;
SelectedRow, CurrentRow, TotalRecords, i: Integer;
Temp: TTaskRec;
begin
SelectedRow := GridDirector.Row;
if SelectedRow <= 1 then Exit; // Первую строку (или заголовок) нельзя двигать вверх

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;

// 1. Выкачиваем базу в буфер
TotalRecords := 0;
Table1.First;
while not Table1.Eof do
begin
SetLength(Buffer, TotalRecords + 1);
Buffer[TotalRecords].WorkerID := Table1.FieldByName(‘WorkerID’).AsInteger;
Buffer[TotalRecords].ProjectName := Table1.FieldByName(‘ProjectName’).AsString;
Buffer[TotalRecords].TaskName := Table1.FieldByName(‘TaskName’).AsString;
Buffer[TotalRecords].SlotType := Table1.FieldByName(‘SlotType’).AsString;
Buffer[TotalRecords].IsActive := Table1.FieldByName(‘IsActive’).AsBoolean;
Buffer[TotalRecords].DateStart := Table1.FieldByName(‘DateStart’).AsDateTime;
Buffer[TotalRecords].DatePlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
Buffer[TotalRecords].DeltaT := Table1.FieldByName(‘DeltaT’).AsInteger;
Buffer[TotalRecords].FreezeDays := Table1.FieldByName(‘FreezeDays’).AsInteger;
Buffer[TotalRecords].ShiftCount := Table1.FieldByName(‘ShiftCount’).AsInteger;
Buffer[TotalRecords].ParentID := Table1.FieldByName(‘ParentID’).AsInteger;
Buffer[TotalRecords].TaskLevel := Table1.FieldByName(‘TaskLevel’).AsInteger;
Buffer[TotalRecords].IsExpanded := Table1.FieldByName(‘IsExpanded’).AsBoolean;
if not Table1.FieldByName(‘DateFact’).IsNull then Buffer[TotalRecords].DateFact := Table1.FieldByName(‘DateFact’).AsDateTime else Buffer[TotalRecords].DateFact := 0;
TotalRecords := TotalRecords + 1;
Table1.Next;
end;

// 2. Перестановка: меняем в массиве местами текущую строку (SelectedRow-1) и верхнюю (SelectedRow-2)
Temp := Buffer[SelectedRow – 1];
Buffer[SelectedRow – 1] := Buffer[SelectedRow – 2];
Buffer[SelectedRow – 2] := Temp;

// 3. Очищаем и перезаписываем Paradox
Table1.Active := False; Table1.Exclusive := True; Table1.Active := True;
Table1.EmptyTable;
Table1.Active := False; Table1.Exclusive := False; Table1.Active := True;

for i := 0 to TotalRecords – 1 do
begin
Table1.Append;
Table1.FieldByName(‘WorkerID’).AsInteger := Buffer[i].WorkerID;
Table1.FieldByName(‘ProjectName’).AsString := Buffer[i].ProjectName;
Table1.FieldByName(‘TaskName’).AsString := Buffer[i].TaskName;
Table1.FieldByName(‘SlotType’).AsString := Buffer[i].SlotType;
Table1.FieldByName(‘IsActive’).AsBoolean := Buffer[i].IsActive;
Table1.FieldByName(‘DateStart’).AsDateTime := Buffer[i].DateStart;
Table1.FieldByName(‘DatePlan’).AsDateTime := Buffer[i].DatePlan;
Table1.FieldByName(‘DeltaT’).AsInteger := Buffer[i].DeltaT;
Table1.FieldByName(‘FreezeDays’).AsInteger := Buffer[i].FreezeDays;
Table1.FieldByName(‘ShiftCount’).AsInteger := Buffer[i].ShiftCount;
Table1.FieldByName(‘ParentID’).AsInteger := Buffer[i].ParentID;
Table1.FieldByName(‘TaskLevel’).AsInteger := Buffer[i].TaskLevel;
Table1.FieldByName(‘IsExpanded’).AsBoolean := Buffer[i].IsExpanded;
if Buffer[i].DateFact > 0 then Table1.FieldByName(‘DateFact’).AsDateTime := Buffer[i].DateFact;
Table1.Post;
end;
Table1.Active := False;

RecalculateParentIDs; // Восстанавливаем пропавшие плюсики
UpdateTreeVisibility;
GridDirector.Row := SelectedRow – 1; // Сдвигаем курсор экрана вслед за уехавшей вверх строкой
GridDirector.Repaint;
end;

procedure TForm1.BtnMoveDownClick(Sender: TObject);
type
TTaskRec = record
WorkerID, ShiftCount, FreezeDays, ParentID, TaskLevel, DeltaT: Integer;
ProjectName, TaskName, SlotType: string;
DateStart, DatePlan, DateFact: TDateTime;
IsActive, IsExpanded: Boolean;
end;
var
Buffer: array of TTaskRec;
SelectedRow, CurrentRow, TotalRecords, i: Integer;
Temp: TTaskRec;
begin
SelectedRow := GridDirector.Row;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True;

TotalRecords := 0;
Table1.First;
while not Table1.Eof do
begin
SetLength(Buffer, TotalRecords + 1);
Buffer[TotalRecords].WorkerID := Table1.FieldByName(‘WorkerID’).AsInteger;
Buffer[TotalRecords].ProjectName := Table1.FieldByName(‘ProjectName’).AsString;
Buffer[TotalRecords].TaskName := Table1.FieldByName(‘TaskName’).AsString;
Buffer[TotalRecords].SlotType := Table1.FieldByName(‘SlotType’).AsString;
Buffer[TotalRecords].IsActive := Table1.FieldByName(‘IsActive’).AsBoolean;
Buffer[TotalRecords].DateStart := Table1.FieldByName(‘DateStart’).AsDateTime;
Buffer[TotalRecords].DatePlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
Buffer[TotalRecords].DeltaT := Table1.FieldByName(‘DeltaT’).AsInteger;
Buffer[TotalRecords].FreezeDays := Table1.FieldByName(‘FreezeDays’).AsInteger;
Buffer[TotalRecords].ShiftCount := Table1.FieldByName(‘ShiftCount’).AsInteger;
Buffer[TotalRecords].ParentID := Table1.FieldByName(‘ParentID’).AsInteger;
Buffer[TotalRecords].TaskLevel := Table1.FieldByName(‘TaskLevel’).AsInteger;
Buffer[TotalRecords].IsExpanded := Table1.FieldByName(‘IsExpanded’).AsBoolean;
if not Table1.FieldByName(‘DateFact’).IsNull then Buffer[TotalRecords].DateFact := Table1.FieldByName(‘DateFact’).AsDateTime else Buffer[TotalRecords].DateFact := 0;
TotalRecords := TotalRecords + 1;
Table1.Next;
end;

if SelectedRow >= TotalRecords then begin Table1.Active := False; Exit; end; // Последнюю строку нельзя двигать вниз

// Меняем местами текущую (SelectedRow-1) и нижнюю (SelectedRow)
Temp := Buffer[SelectedRow – 1];
Buffer[SelectedRow – 1] := Buffer[SelectedRow];
Buffer[SelectedRow] := Temp;

Table1.Active := False; Table1.Exclusive := True; Table1.Active := True;
Table1.EmptyTable;
Table1.Active := False; Table1.Exclusive := False; Table1.Active := True;

RecalculateParentIDs; // Восстанавливаем пропавшие плюсики
UpdateTreeVisibility;
GridDirector.Row := SelectedRow + 1; // Двигаем курсор экрана вниз вслед за строкой
GridDirector.Repaint;
end;

procedure TForm1.RecalculateParentIDs;
var
LastIDAtLevel: array[0..10] of Integer; // Массив для хранения последних ID на каждом уровне
Lvl: Integer;
i: Integer;
begin
for i := 0 to 10 do LastIDAtLevel[i] := 0;

Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Tasks.db’;
Table1.TableType := ttParadox;
Table1.Active := True;
Table1.First;

// Сканируем базу сверху вниз
while not Table1.Eof do
begin
Lvl := Table1.FieldByName(‘TaskLevel’).AsInteger;

// Запоминаем ID текущей задачи для её уровня
LastIDAtLevel[Lvl] := Table1.FieldByName(‘TaskID’).AsInteger;

Table1.Edit;
if Lvl = 0 then
begin
// Если это уровень проекта — у него нет родителя
Table1.FieldByName(‘ParentID’).AsInteger := 0;
end
else
begin
// Реляционная магия: родителем этой задачи является
// последний зафиксированный ID на уровень выше!
Table1.FieldByName(‘ParentID’).AsInteger := LastIDAtLevel[Lvl – 1];
end;
Table1.Post;

Table1.Next;
end;
Table1.First;
end;

procedure TForm1.GridMonthsDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
CellDate, NextDate: TDateTime;
DateStr: string;
i, ScanCol: Integer;
begin
// — КОНТУР МАСШТАБНОЙ КООРДИНАТЫ —
if IsWeekScale then
CellDate := Date + ((ACol – 1) * 7)
else
CellDate := Date + (ACol – 1);

// 1. Очищаем фон ячейки под стандартный серый цвет шапки
GridMonths.Canvas.Brush.Color := clBtnFace;
// GridMonths.Canvas.FillRect(Rect);

// Настройки шрифта
GridMonths.Canvas.Font.Name := ‘Arial Narrow’;
GridMonths.Canvas.Font.Size := 8;
GridMonths.Canvas.Font.Style := [fsBold];
GridMonths.Canvas.Font.Color := clNavy; // Синий цвет месяцев
if ACol=0 then begin Rect.Right:=GridMonths.Width; GridMonths.Canvas.FillRect(Rect);end;

if ACol > 0 then
begin
if IsWeekScale then i := 7 else i := 1;

// ПРОВЕРКА ГРАНИЦЫ: Если это стартовый столбец нового месяца
if (ACol = 1) or (FormatDateTime(‘mm’, CellDate) <> FormatDateTime(‘mm’, CellDate – i)) then
begin
DateStr := FormatDateTime(‘mmmm’, CellDate); // Берем полное имя (“Сентябрь”)
if Length(DateStr) > 0 then
DateStr := UpperCase(Copy(DateStr, 1, 1)) + Copy(DateStr, 2, Length(DateStr));

// — РЕЛЯЦИОННЫЙ ПРОРЫВ МАСКИ ОТСЕЧЕНИЯ (ОБЪЕДИНЕНИЕ ЯЧЕЕК ВУМНУЮ) —
// Пробегаем по следующим столбцам вперед и суммируем их ширину в Rect.Right,
// пока продолжается текущий месяц. Это физически раздвинет границы рисования!
for ScanCol := ACol + 1 to GridMonths.ColCount – 1 do
begin
if IsWeekScale then NextDate := Date + ((ScanCol – 1) * 7) else NextDate := Date + (ScanCol – 1);

// Пока идет тот же самый месяц — прибавляем ширину соседней ячейки к нашему Rect.Right
if FormatDateTime(‘mm’, CellDate) = FormatDateTime(‘mm’, NextDate) then
// iF4:=1 //
Rect.Right := Rect.Right + GridMonths.ColWidths[ScanCol]
else
Break; // Встретили новый месяц — останавливаем расширение
end;

// Рисуем длинный текст месяца на искусственно расширенном пространстве ячейки.
// Теперь буквы никогда не обрежутся, так как Rect.Right ушел далеко вправо!
DrawText(GridMonths.Canvas.Handle, PChar(DateStr), Length(DateStr), Rect,
DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
end;
end;

// 2. Рисуем тонкие серые вертикальные линии границ ячеек строго по сетке,
// чтобы они идеально стыковались с нижними линиями Ганта
GridMonths.Canvas.Pen.Color := clBtnFace;
GridMonths.Canvas.Pen.Width := 3;
GridMonths.Canvas.Pen.Style := psSolid;
GridMonths.Canvas.MoveTo(Rect.Right + 1, Rect.Top);
GridMonths.Canvas.LineTo(Rect.Right + 1, Rect.Bottom);
end;

procedure TForm1.LoadTaskProperties;
var
SelID, DurationHours, Days, Hours, i, TotalProgress, ItemWeight, BraceIdx: Integer;
DetailsList: TStringList;
CurrentLine, CleanText, WeightStr: string;
HasChildren: Boolean;
Bookmark: TBookmark;
begin
// 1. Сброс и полная очистка пульта свойств перед загрузкой
EditDateStart.Text := ”;
EditLinkID.Text := ”;

ComboWorker.ItemIndex := 0;
ComboDays.ItemIndex := 0;
ComboHours.ItemIndex := 0;
EditDeltaT.Text := ‘0’;
MemoQuality.Lines.Clear;
CheckListDone.Items.Clear;
EditItemText.Text := ”;
EditItemWeight.Text := ”;
LabelTaskName.Caption := ‘Задача: [не выбрана]’;
// Переименовываем стартовый сброс старого индикатора в “Выполнение”
LabelProgress.Caption := ‘Выполнение: 0%’;
LabelProgress.Font.Color := clBlack;

SelID := GetSelectedTaskID;
if SelID = -1 then Exit;
// Намертво фиксируем глобальный ключ редактируемой задачи в памяти сессии
EditingTaskID := SelID;

if not Table1.Active then Table1.Active := True;

// 2. Находим задачу в основной таблице Tasks.db
if Table1.Locate(‘TaskID’, SelID, []) then
begin
// Вычисляем плановые часы (1 день = 8 часов)
DurationHours := (Trunc(Table1.FieldByName(‘DatePlan’).AsDateTime) – Trunc(Table1.FieldByName(‘DateStart’).AsDateTime)) * 8;
if DurationHours < 0 then DurationHours := 0;

Days := DurationHours div 8;
Hours := DurationHours mod 8;

if Days <= ComboDays.Items.Count – 1 then ComboDays.ItemIndex := Days else ComboDays.ItemIndex := 0;
if Hours <= ComboHours.Items.Count – 1 then ComboHours.ItemIndex := Hours else ComboHours.ItemIndex := 0;

EditDeltaT.Text := IntToStr(Table1.FieldByName(‘DeltaT’).AsInteger);
// — РАДАР ИМЕНИ: Выводим полное название задачи на нижний пульт —
LabelTaskName.Caption := ‘Задача: ‘ + Trim(Table1.FieldByName(‘TaskName’).AsString);
// — РЕЛАЦИОННЫЕ ИНДИКАТОРЫ: Выводим дату старта и номер связи на пульт —
// Форматируем системную дату в красивый, привычный заму вид “ДД.ММ.ГГГГ”
EditDateStart.Text := FormatDateTime(‘dd.mm.yyyy’, Table1.FieldByName(‘DateStart’).AsDateTime);

// — ДЕКОДЕР СВЯЗЕЙ: Выводим понятное имя предшественника вместо машинного ID —
ItemWeight := Table1.FieldByName(‘LinkID’).AsInteger; // Используем свободный Integer как буфер ID связи

if ItemWeight = 0 then
begin
EditLinkID.Text := ‘Свободный старт (нет связей)’;
end
else
begin
// Сохраняем текущую позицию курсора в базе
Bookmark := Table1.GetBookmark;
try
// Прыгаем по ключу на задачу-предшественник
if Table1.Locate(‘TaskID’, ItemWeight, []) then
// Выводим красивое текстовое имя связи, очищенное от лишних пробелов лесенки WBS
EditLinkID.Text := ‘После “‘ + Trim(Table1.FieldByName(‘TaskName’).AsString) + ‘”‘
else
EditLinkID.Text := ‘Свободный старт (нет связей)’;
finally
// Возвращаем курсор базы обратно на нашу исходную задачу
Table1.GotoBookmark(Bookmark);
Table1.FreeBookmark(Bookmark);
end;
end;

// — РЛ-РАДАР: НАХОДИМ И ПОДДСВЕЧИВАЕМ ИМЯ ИСПОЛНИТЕЛЯ НА ПУЛЬТЕ —
// Ищем точное текстовое имя (например, ‘Петров П.П.’) в элементах списка ComboWorker
ComboWorker.ItemIndex := ComboWorker.Items.IndexOf(Table1.FieldByName(‘WorkerName’).AsString);

// Если поле в базе пустое или имя не найдено — принудительно сбрасываем в “Не назначен”
if ComboWorker.ItemIndex = -1 then
ComboWorker.ItemIndex := 0;

// — БРОНИРОВАННЫЙ NoSQL ПАРСЕР ПОСИМВОЛЬНОГО СКАНИРОВАНИЯ —
TotalProgress := 0;
DetailsList := TStringList.Create;
try
DetailsList.Text := Table1.FieldByName(‘TaskDetails’).AsString;

for i := 0 to DetailsList.Count – 1 do
begin
CurrentLine := Trim(DetailsList[i]);
if CurrentLine = ” then Continue;

// ПРОВЕРКА МАРКЕРА ГАЛКИ: Строка гарантированно является ТИПОМ А,
// если её длина больше 6 символов и она начинается со скобок [ ] или [X]
if (Length(CurrentLine) >= 6) and
(CurrentLine[1] = ‘[‘) and (CurrentLine[3] = ‘]’) and (CurrentLine[4] = ‘{‘) then
begin
// Ищем закрывающую фигурную скобку веса ‘}’
BraceIdx := 5;
while (BraceIdx <= Length(CurrentLine)) and (CurrentLine[BraceIdx] <> ‘}’) do
Inc(BraceIdx);

if (BraceIdx <= Length(CurrentLine)) and (CurrentLine[BraceIdx] = ‘}’) then
begin
// Вырезаем чистый текстовый вес (все символы между ‘{‘ и ‘}’)
WeightStr := Copy(CurrentLine, 5, BraceIdx – 5);
ItemWeight := StrToIntDef(WeightStr, 0);

// Вырезаем чистый текст критерия (всё, что идет ПОСЛЕ закрывающей скобки ‘}’)
CleanText := Trim(Copy(CurrentLine, BraceIdx + 1, Length(CurrentLine) – BraceIdx));
end
else
begin
ItemWeight := 0;
CleanText := Copy(CurrentLine, 4, Length(CurrentLine) – 3);
end;

// Выводим пункт в наш CheckListDone вместе с весом
CheckListDone.Items.Add(CleanText + ‘ (‘ + IntToStr(ItemWeight) + ‘%)’);

// Проверяем бинарный статус шлюза приемки (второй символ строки равен ‘X’)
if CurrentLine[2] = ‘X’ then
begin
CheckListDone.Checked[CheckListDone.Items.Count – 1] := True;
// Суммируем вес взведенной галки в объективный прогресс!
TotalProgress := TotalProgress + ItemWeight;
end
else
CheckListDone.Checked[CheckListDone.Items.Count – 1] := False;
end
// СТРОКА ТИПА В: Свободный текст ТУ и критериев качества
else
begin
MemoQuality.Lines.Add(CurrentLine);
end;
end;
finally
DetailsList.Free;
end;

// =========================================================================
// АДРЕСНЫЙ ИНТЕЛЛЕКТУАЛЬНЫЙ ЗАМОК ПО ЗАКОНУ WBS (ИСПРАВЛЕННЫЙ)
// =========================================================================
// Рамку оставляем ВКЛЮЧЕННОЙ ВСЕГДА, чтобы внутренние кнопки связей дышали!
GroupProps.Enabled := True;
GroupProps.Caption := ‘Панель управления свойствами выделенной задачи’;

if HasChildren or (Table1.FieldByName(‘TaskLevel’).AsInteger = 0) then
begin
// — РЕЖИМ МАКРОЭТАПА (УЗЛА) —
// Адресно блокируем поля времени, ресурсов и качества, так как макроэтап
// рассчитывает их автоматически по формуле крайних точек
ComboDays.Enabled := False;
ComboHours.Enabled := False;
EditDeltaT.Enabled := False;
ComboWorker.Enabled := False;
MemoQuality.Enabled := False;
CheckListDone.Enabled := False;
EditItemText.Enabled := False;
EditItemWeight.Enabled := False;
BtnAddCheck.Enabled := False;
BtnDelCheck.Enabled := False;

// КНОПКИ СВЯЗЕЙ ОСТАЮТСЯ ПОЛНОСТЬЮ АКТИВНЫМИ И ДОСТУПНЫМИ!
BtnLinkMode.Enabled := True;
BtnUnlink.Enabled := True;
EditLinkID.Enabled := True;

LabelProgress.Caption := ‘МАКРОЭТАП’;
LabelProgress.Font.Color := clNavy;
end
else
begin
// — РЕЖИМ РАБОЧЕЙ ЗАДАЧИ (ЛИСТА) —
// Полностью открываем шлюзы управления для элементарных квантов реальности
ComboDays.Enabled := True;
ComboHours.Enabled := True;
EditDeltaT.Enabled := True;
ComboWorker.Enabled := True;
MemoQuality.Enabled := True;
CheckListDone.Enabled := True;
EditItemText.Enabled := True;
EditItemWeight.Enabled := True;
BtnAddCheck.Enabled := True;
BtnDelCheck.Enabled := True;

BtnLinkMode.Enabled := True;
BtnUnlink.Enabled := True;
EditLinkID.Enabled := True;

LabelProgress.Caption := ‘Выполнение: ‘ + IntToStr(TotalProgress) + ‘%’;

if TotalProgress >= 100 then LabelProgress.Font.Color := clGreen
else if TotalProgress > 0 then LabelProgress.Font.Color := $000080FF
else LabelProgress.Font.Color := clRed;
end;
end; // Конец блока Locate
end;

procedure TForm1.BtnFillWorkersClick(Sender: TObject);
var
i: Integer;
begin
// 1. Отключаем активный поток задач и перенаправляем BDE на базу людей
Table1.Close;
Table1.Active := False;
Table1.DatabaseName := ‘C:\NP\Data’;
Table1.TableName := ‘Workers.db’;
Table1.Active := True;

// 2. Очищаем справочник перед заливкой, чтобы не плодить дубликаты
Table1.First;
while not Table1.IsEmpty do
Table1.Delete;

// 3. Заносим ядро КБ — 3 основных инженеров с их профессиями
Table1.Append;
Table1.FieldByName(‘WorkerName’).AsString := ‘Иванов И.И.’;
Table1.FieldByName(‘WorkerRole’).AsString := ‘Конструктор’;
Table1.FieldByName(‘IsActive’).AsBoolean := True;
Table1.Post;

Table1.Append;
Table1.FieldByName(‘WorkerName’).AsString := ‘Петров П.П.’;
Table1.FieldByName(‘WorkerRole’).AsString := ‘Технолог КБ’;
Table1.FieldByName(‘IsActive’).AsBoolean := True;
Table1.Post;

Table1.Append;
Table1.FieldByName(‘WorkerName’).AsString := ‘Сидоров С.С.’;
Table1.FieldByName(‘WorkerRole’).AsString := ‘Расчетчик КБ’;
Table1.FieldByName(‘IsActive’).AsBoolean := True;
Table1.Post;

// 4. Заносим 5 производственных сотрудников цеха через цикл
for i := 1 to 5 do
begin
Table1.Append;
Table1.FieldByName(‘WorkerName’).AsString := ‘Сотрудник №’ + IntToStr(i);
// Выставляем разные тестовые профессии для последующего анализа эффективности отделов
if i <= 3 then
Table1.FieldByName(‘WorkerRole’).AsString := ‘Сварщик цеха’
else
Table1.FieldByName(‘WorkerRole’).AsString := ‘Сборщик каминов’;

Table1.FieldByName(‘IsActive’).AsBoolean := True;
Table1.Post;
end;

// 5. Гасим сессию людей и возвращаем BDE в штатный режим работы с задачами
Table1.Close;
Table1.Active := False;
Table1.TableName := ‘Tasks.db’;
Table1.Active := True; // Возвращаем прогрев задач в оперативную память

// Синхронно обновляем экран
UpdateTreeVisibility;
GridDirector.Repaint;

// ShowMessage(‘Справочник ресурсов (8 сотрудников) успешно развернут и заполнен на диске!’);
end;

procedure TForm1.BtnSavePropsClick(Sender: TObject);
var
SelID, i, CalculatedHours, DeltaT, OpenParen, ItemWeight, BraceIdx: Integer;
DetailsList: TStringList;
Prefix, FullLineText, CleanText: string;
CurrentStart: TDateTime;
Days, Hours: Integer;
begin
SelID := GetSelectedTaskID;
if SelID = -1 then begin ShowMessage(‘Ошибка: Задача не выбрана!’); Exit; end;

if not Table1.Active then Table1.Active := True;

if Table1.Locate(‘TaskID’, SelID, []) then
begin
Table1.Edit;

// — БЛОК А: ЖЕСТКАЯ ФИКСАЦИЯ ИСПОЛНИТЕЛЯ В PARADOX —
// Если на пульте выбран нулевой пункт “Не назначен” — очищаем поле в базе
if ComboWorker.ItemIndex = 0 then
Table1.FieldByName(‘WorkerName’).AsString := ”
else
// Записываем точное текстовое имя сотрудника из черновика на диск
Table1.FieldByName(‘WorkerName’).AsString := ComboWorker.Text;

// — БЛОК Б: БРОНИРОВАННАЯ МАТЕМАТИКА ВНУТРЕННИХ ЧАСОВ И ЗАЩИТА ОТ НУЛЯ —
// Напрямую переводим текст из списков в реальные физические цифры
Days := StrToIntDef(ComboDays.Text, 0);
Hours := StrToIntDef(ComboHours.Text, 0);

CalculatedHours := (Days * 8) + Hours;

// ЖЁСТКИЙ ПРЕДОХРАНИТЕЛЬ: Если на пульте выставлен полный ноль времени,
// система принудительно возвращает задаче стандартный 1 рабочий день (8 часов),
// не позволяя базе данных схлопнуть чертёж Ганта и сломать даты!
if CalculatedHours < 1 then
CalculatedHours := 8;

CurrentStart := Table1.FieldByName(‘DateStart’).AsDateTime;

// Переводим часы в календарные дни для Paradox (Часы / 8)
Table1.FieldByName(‘DatePlan’).AsDateTime := CurrentStart + (CalculatedHours / 8);

// — БЛОК В: ОБРАТНАЯ СБОРКА И КОДИРОВАНИЕ ВЗВЕШЕННЫХ ГАЛОК (ТИП А + ТИП В) —
DetailsList := TStringList.Create;
try
// Собираем пункты взвешенного чек-листа из компонента CheckListDone
for i := 0 to CheckListDone.Items.Count – 1 do
begin
// Если галка стоит — выставляем префикс [X], если снята — [ ]
if CheckListDone.Checked[i] then
Prefix := ‘[X]’
else
Prefix := ‘[ ]’;

FullLineText := CheckListDone.Items[i];

// Посимвольный радар: ищем открывающую круглую скобку веса ” (” с конца строки,
// чтобы вычленить чистый текст и проценты из строки вида “Текст вехи (30%)”
BraceIdx := Length(FullLineText);
while (BraceIdx > 0) and (FullLineText[BraceIdx] <> ‘(‘) do
Dec(BraceIdx);

if BraceIdx > 1 then
begin
// Отрезаем хвост с процентами, оставляя только чистый текст критерия
CleanText := Trim(Copy(FullLineText, 1, BraceIdx – 1));

// Вытаскиваем числовое значение веса из скобок (между ‘(‘ и ‘%)’)
ItemWeight := StrToIntDef(Copy(FullLineText, BraceIdx + 1, Length(FullLineText) – BraceIdx – 2), 0);
end
else
begin
CleanText := FullLineText;
ItemWeight := 0;
end;

// Намертво упаковываем NoSQL-строку в эталонный формат диска: [ ]{30} Текст
DetailsList.Add(Prefix + ‘{‘ + IntToStr(ItemWeight) + ‘} ‘ + CleanText);
end;

// Приклеиваем свободный текст критериев качества (Тип В) из MemoQuality
for i := 0 to MemoQuality.Lines.Count – 1 do
begin
if Trim(MemoQuality.Lines[i]) <> ” then
DetailsList.Add(MemoQuality.Lines[i]);
end;

// Записываем объединенный текстовый блок в Paradox
Table1.FieldByName(‘TaskDetails’).AsString := DetailsList.Text;
finally
DetailsList.Free; // Освобождаем память списка
end;

Table1.Post; // Запечатываем изменения в Paradox
end;
RecalculateLinkedDates(SelID);
UpdateTreeVisibility;
GridDirector.Repaint;
GridMonths.Repaint;
LoadTaskProperties;
ShowMessage(‘Параметры и взвешенные вехи приемки успешно сохранены на диск!’);
end;

procedure TForm1.BtnAddCheckClick(Sender: TObject);
var
Weight, TargetIdx: Integer;
NewText: string;
WasChecked: Boolean;
begin
if Trim(EditItemText.Text) = ” then
begin
ShowMessage(‘Ошибка: Введите текст вехи приемки!’);
Exit;
end;

// Считываем введенный вес, если пусто — ставим 0%
Weight := StrToIntDef(EditItemWeight.Text, 0);

// Формируем красивую эталонную строку отображения
NewText := Trim(EditItemText.Text) + ‘ (‘ + IntToStr(Weight) + ‘%)’;

// — ИНТЕЛЛЕКТУАЛЬНЫЙ ПЕРЕКЛЮЧАТЕЛЬ: РЕДАКТИРОВАНИЕ ИЛИ ДОБАВЛЕНИЕ —
if CheckListDone.ItemIndex >= 0 then
begin
// РЕЖИМ 1: РЕДАКТИРОВАНИЕ СУЩЕСТВУЮЩЕГО ПУНКТА
TargetIdx := CheckListDone.ItemIndex;

// Запоминаем бинарный статус галочки (стояла она или нет), чтобы при изменении текста она не слетела
WasChecked := CheckListDone.Checked[TargetIdx];

// Перезаписываем текст в выделенной строке
CheckListDone.Items[TargetIdx] := NewText;

// Возвращаем галочку на её законное место
CheckListDone.Checked[TargetIdx] := WasChecked;
end
else
begin
// РЕЖИМ 2: ДОБАВЛЕНИЕ НОВОГО ПУНКТА В КОНЕЦ (Если ничего не было выделено)
CheckListDone.Items.Add(NewText);
TargetIdx := CheckListDone.Items.Count – 1;
end;

// Сбрасываем выделение строки (снимаем синее подсвечивание пункта),
// чтобы следующий клик по кнопке “+” снова создавал новую задачу, а не перезаписывал эту
CheckListDone.ItemIndex := -1;

// Очищаем черновики ввода для следующего цикла
EditItemText.Text := ”;
EditItemWeight.Text := ”;
EditItemText.SetFocus;
end;

procedure TForm1.BtnDelCheckClick(Sender: TObject);
begin
// Если зам выделил строку в чек-листе — физически удаляем её из списка
if CheckListDone.ItemIndex >= 0 then
CheckListDone.Items.Delete(CheckListDone.ItemIndex)
else
ShowMessage(‘Выберите пункт в чек-листе, который хотите удалить!’);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
BtnClearDBClick(Sender);
Button1Click(Sender);
BtnFillWorkersClick(Sender);
BtnAddFirstTaskClick(Sender);
end;

procedure TForm1.CheckListDoneClick(Sender: TObject);
var
FullLineText, CleanText, WeightStr: string;
BraceIdx: Integer;
begin
// 1. Проверяем, что зам действительно выделил существующую строчку
if CheckListDone.ItemIndex >= 0 then
begin
FullLineText := CheckListDone.Items[CheckListDone.ItemIndex];

// 2. ПОСИМВОЛЬНЫЙ РАДАР: Ищем открывающую круглую скобку веса ” (” с конца строки,
// чтобы аккуратно разделить фразу вида “Текст критерия (30%)”
BraceIdx := Length(FullLineText);
while (BraceIdx > 0) and (FullLineText[BraceIdx] <> ‘(‘) do
Dec(BraceIdx);

if BraceIdx > 1 then
begin
// Вычленяем чистый текст критерия (всё, что до скобки)
CleanText := Trim(Copy(FullLineText, 1, BraceIdx – 1));

// Вычленяем числовое значение веса (между ‘(‘ и ‘%)’)
WeightStr := Copy(FullLineText, BraceIdx + 1, Length(FullLineText) – BraceIdx – 2);
end
else
begin
CleanText := FullLineText;
WeightStr := ‘0’;
end;

// 3. ВЫБРАСЫВАЕМ ДАННЫЕ В ПОЛЯ ЧЕРНОВИКА ДЛЯ РЕДАКТИРОВАНИЯ
EditItemText.Text := CleanText;
EditItemWeight.Text := WeightStr;
end;
end;

procedure TForm1.BtnUnlinkClick(Sender: TObject);
var
SelID: Integer;
begin
// 1. С помощью нашего радара находим точный TaskID выделенной строки
SelID := GetSelectedTaskID;
if SelID = -1 then
begin
ShowMessage(‘Ошибка: Задача не выбрана!’);
Exit;
end;

if not Table1.Active then Table1.Active := True;

// 2. Находим задачу в основной таблице Tasks.db по уникальному ключу
if Table1.Locate(‘TaskID’, SelID, []) then
begin
// ЗАЩИТА: Если связь уже отсутствует (равна 0), ничего делать не нужно
if Table1.FieldByName(‘LinkID’).AsInteger = 0 then
begin
ShowMessage(‘Связь уже отсутствует!’);
Exit;
end;

// ЖЁСТКОЕ АННУЛИРОВАНИЕ: Стираем реляционный линкер Finish-to-Start в ноль
Table1.Edit;
Table1.FieldByName(‘LinkID’).AsInteger := 0;
Table1.Post;
end;

// 3. Синхронно обновляем чертеж Ганта и переприжимаем пульт свойств
UpdateTreeVisibility;
GridDirector.Repaint;
GridMonths.Repaint;

// Перезагружаем пульт: индикатор EditLinkID мгновенно загорится надписью “Свободный старт”
LoadTaskProperties;

ShowMessage(‘Реляционная связь успешно разорвана. Задача переведена в свободный старт!’);
end;

procedure TForm1.N2Click(Sender: TObject);
begin
Panel1.Visible:=True;Panel1.BringToFront;Panel1.Top:=300;Panel1.left:=2; Panel1.Width:=Form1.Width-25;Panel1.Height:=500; Panel1.Height:=500;
DBGrid1.Height:=Panel1.Height-30;DBGrid1.Width:=Panel1.Width-30; Label11.Caption:=’задачи’;
DBGrid1.DataSource:=DataSource1;DataSource1.DataSet:=Table1;
DBGrid1.Columns[0].Width:=40;DBGrid1.Columns[1].Width:=40;DBGrid1.Columns[3].Width:=200;
DBGrid1.Columns[6].Width:=60;DBGrid1.Columns[7].Width:=60;DBGrid1.Columns[8].Width:=60;DBGrid1.Columns[16].Width:=120;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin Panel1.Visible:=False;end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin ReleaseCapture; Panel1.Perform(WM_SYSCOMMAND, $F012, 0);end;

procedure TForm1.RecalculateLinkedDates(ParentTaskID: Integer);
var
Bookmark: TBookmark;
ParentStart, ParentPlan: TDateTime;
ParentHours, ParentFreeze: Integer;
NewChildStart: TDateTime;
ChildHours: Integer;
ChildList: TStringList;
i, CurrentChildID: Integer;
begin
// Защита: если передали пустой ID, выходим
if ParentTaskID <= 0 then Exit;

// 1. НАХОДИМ ПРЕДШЕСТВЕННИКА И СЧИТЫВАЕМ ЕГО ДАТУ ФИНИША
if Table1.Locate(‘TaskID’, ParentTaskID, []) then
begin
ParentStart := Table1.FieldByName(‘DateStart’).AsDateTime;
ParentPlan := Table1.FieldByName(‘DatePlan’).AsDateTime;
ParentFreeze := Table1.FieldByName(‘FreezeDays’).AsInteger;

// Вычисляем чистые плановые часы предшественника
ParentHours := Trunc(ParentPlan – ParentStart) * 8;
if ParentHours < 8 then ParentHours := 8; // Предохранитель от нуля

// ФОРМУЛА КРАЙНЕЙ ТОЧКИ: Точный день физического окончания предшественника
NewChildStart := ParentStart + (ParentHours / 8) + ParentFreeze;
end
else
Exit; // Если предшественник не найден в базе — глушим контур

// 2. СКАНИРУЕМ БАЗУ И НАХОДИМ ВСЕ СВЯЗАННЫЕ ЗАДАЧИ-ПОСЛЕДОВАТЕЛИ
ChildList := TStringList.Create;
Bookmark := Table1.GetBookmark;
try
Table1.First;
while not Table1.Eof do
begin
// Если LinkID текущей записи совпадает с ID нашего измененного родителя
if Table1.FieldByName(‘LinkID’).AsInteger = ParentTaskID then
ChildList.Add(IntToStr(Table1.FieldByName(‘TaskID’).AsInteger));
Table1.Next;
end;
finally
Table1.GotoBookmark(Bookmark);
Table1.FreeBookmark(Bookmark);
end;

// 3. ЭФФЕКТ ДОМИНО: Сдвигаем найденных последователей и запускаем рекурсию
if ChildList.Count > 0 then
begin
for i := 0 to ChildList.Count – 1 do
begin
CurrentChildID := StrToInt(ChildList[i]);

if Table1.Locate(‘TaskID’, CurrentChildID, []) then
begin
// Считываем исходную трудоемкость последователя в часах
ChildHours := Trunc(Table1.FieldByName(‘DatePlan’).AsDateTime – Table1.FieldByName(‘DateStart’).AsDateTime) * 8;
if ChildHours < 8 then ChildHours := 8;

// СДВИГАЕМ ДАТЫ ПОСЛЕДОВАТЕЛЯ НА ДИСКЕ:
Table1.Edit;
// Его старт — это строго день финиша его предшественника!
Table1.FieldByName(‘DateStart’).AsDateTime := NewChildStart;
// Его план — старт плюс его собственная длительность в часах
Table1.FieldByName(‘DatePlan’).AsDateTime := NewChildStart + (ChildHours / 8);
Table1.Post;

// РЕКУРСИВНЫЙ ПРЫЖОК ЛАВИНЫ:
// Вызываем эту же процедуру для сдвинутого последователя,
// чтобы он толкнул своих собственных “детей” дальше по цепочке времени!
RecalculateLinkedDates(CurrentChildID);
end;
end;
end;

ChildList.Free; // Освобождаем оперативную память
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin Panel2.Visible:=False;end;

procedure TForm1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin ReleaseCapture; Panel2.Perform(WM_SYSCOMMAND, $F012, 0);end;

procedure TForm1.N4Click(Sender: TObject);
label 1;
begin
Panel2.Visible:=True;Panel2.BringToFront;Panel2.Top:=200;Panel2.left:=200;Label12.Caption:=’связи’;SG01.Colcount:=4;SG01.RowCount:=2;SG01.DefaultRowHeight:=16;SG01.DefaultColWidth:=50;
SG01.ColWidths[0]:=-1;SG01.ColWidths[1]:=15;SG01.Cells[1,0]:=’№’;SG01.ColWidths[2]:=200;SG01.Cells[2,0]:=’1-я задача’;SG01.ColWidths[3]:=200;SG01.Cells[3,0]:=’2-я задача’;// if not Table1.Active then Table1.Active := True;
Table1.First; I7:=0;
while not Table1.Eof do
begin
if Table1.FieldByName(‘LinkID’).AsInteger=0 then goto 1;
inc(I7); SG01.RowCount:=I7+1; SG01.Rows[I7].Clear; SG01.Cells[3,I7]:=Table1[‘TaskName’];ArIn[I7]:=Table1[‘LinkID’];
1:Table1.Next;
end;
for I1:=1 to I7 do begin Table1.Locate(‘TaskID’,ArIn[I1],[]);SG01.Cells[1,I1]:=IntToStr(I1);SG01.Cells[2,I1]:=Table1[‘TaskName’]; end; SG01.Col:=0;
SgSize(SG01,Panel2);
end;

procedure TForm1.SgSize(aSg : TStringGrid; aPn : TPanel);
begin
I2:=5; for I1:=0 to aSg.RowCount-1 do I2:=I2+aSg.RowHeights[I1]+1; I3:=5; for I1:=0 to aSg.ColCount-1 do I3:=I3+aSg.ColWidths[I1]+1; aSg.ScrollBars:=ssNone;
if I2>Screen.Height-180 then begin I2:=Screen.Height-180;I3:=I3+20; aSg.ScrollBars:=ssVertical; end;
if I3>{1120}1220 then begin I3:={1120}1220;I2:=I2+18; if aSg.ScrollBars=ssVertical then aSg.ScrollBars:=ssBoth else aSg.ScrollBars:=ssHorizontal; end;
aSg.Height:=I2; aSg.Width:=I3; aPn.Width:=aSg.Width+20; aPn.Height:=aSg.Height+50; aPn.Visible:=True; aPn.BringToFront;
end;

end.

Информация

Магазин

Ателье

Соцсети

Мессенджеры