PMG

interface

Uses Windows, SysUtils, Classes, UProcessData;

Type
  PTreeDB = ^TTreeDB; { .................... Указатель на поле с данными............ }

  BOOTSECTOR = Record { .................... Загрузочный сектор потока задачи....... }
    ROOT: SIDCODE; { ....................... Идентификационный код объекта.......... }
    TASK: Int32; { ......................... Установленное значение идентификатора.. }
    TREE: PTreeDB; { ....................... Указатель на блок данных всех объектов. }
    DATA: Pointer; { ....................... Указатель на блок результирующих данных }
  End;

  TFlowVisualizer = class(TObject) { ....... Визуализатор потока данных............. }
    { FlowVisualizer - это модуль информационной системы с динамическим обновлением и
      модификацией функционала технологических процессов визуализации потоков данных с
      ядра управления. Главной полезной функцией является прием данных заданной формы,
      обработка, вывод графического изображения на поле визуализации и запись отчета о
      выполнении действий с объектами управления, именуемый алгоритмом визуализации. }
  Strict private
    FincSource: BOOTSECTOR; { .............. Загрузочный сектор приемника данных.... }
    FoutSource: BOOTSECTOR; { .............. Загрузочный сектор источника данных.... }
    FputSource: BOOTSECTOR;
  private
    function GetObjectResultBLOB( { ........ Получить отчет о выполненной задаче.... }
      index: Int32): { ..................... Индекс адресата данных................. }
    Pointer; { ............................. Указатель блока результирующих данных.. }
    procedure SetObjectIdentificationCode( { Задать идентификационный код объекта... }
      ID: SIDCODE; { ....................... Идентификатор обращения к полю данных.. }
      index: Int32; { ...................... Индекс получателя данных............... }
      NewID: Int32); { ..................... Устанавливаемое значение идентификатора }
  public
    { Группа свойств отвечает за выбор идентификационного кода объекта. Под выбором...
      подразумевается два типа операций. Выбор источника и получателя или дубликат.. }
    property incSource[ID: SIDCODE]: Int32 index 1 write SetObjectIdentificationCode;
    property outSource[ID: SIDCODE]: Int32 index 2 write SetObjectIdentificationCode;
    property putSource[ID: SIDCODE]: Int32 index 3 write SetObjectIdentificationCode;
    { Группа свойств отвечает за выбор результирующего поля с данными для чтения.... }
    property incResult: Pointer index 1 read GetObjectResultBLOB;
    property outResult: Pointer index 2 read GetObjectResultBLOB;
    property putResult: Pointer index 3 read GetObjectResultBLOB;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TIncomeData = packed record { ............ Входные данные (чтение файла блоками) . }
    ROOT: SIDCODE; { ....................... Идентификационный код объекта.......... }
    GATE: Word; { .......................... Тип оператора (свойства)............... }
    TASK: Int32; { ......................... Установленное значение идентификатора.. }
  end;

  TResultData = record { ................... Результирующие данные.................. }
    GATE: Word; { .......................... Тип оператора (свойства)............... }
    Arrow: Pointer; { ...................... Указатель на результат задачи.......... }
  end;

  TParentProcessIncomeParameter = Record { . Входные данные процесса визуализации... }
    TotalTime: Double; { ................... Время выполнения команды (интервал) ... }
    TimerFlag: LongBool; { ................. Флаг включения счетчика времени........ }
    FinalFlag: LongBool; { ................. Флаг выключения потока................. }
    ThreadHID: THandle; { .................. Дескриптор потока для управления им.... }
    ThreadSUS: Cardinal; { ................. Счетчик состояний потока............... }
    CallBackS: TProc<Cardinal>; { .......... Процедура с одним параметром (успешно). }
    CallBackE: TFunc<Cardinal, BOOL>; { .... Процедура с одним параметром (ошибка).. }
    CallBackC: TProc<Pointer, Pointer>;
    { ... Заполнение текстового массива данными.. }
    IncomeData: TIncomeData; { ............. Входные данные с субъекта управления... }
    ResultData: TResultData; { ............. Результирующие данные с объекта........ }
  End;

  { Функция для работы с визуализатором потока данных. }
function ParentProcessThreadFunction(Parameter: Pointer): Integer;

implementation

var
  Messages: Array of PWideChar; { .......... Массив сообщений класса................ }
  FlowVisualizer: TFlowVisualizer; { ....... Визуализатор потока данных............. }
  TreeDB: TTreeDB; { ....................... Массив с данными визуализатора......... }

function ParentProcessThreadFunction(Parameter: Pointer): Integer;
Label Restart; { ........................... Метка перезагрузки класса при ошибках.. }
Label DoAgain; { ........................... Метка новой задачи..................... }
var
  Frequency: Int64; { ...................... Тактовая частота процессора............ }
  StartTime: Int64; { ...................... Время получения команды (счетчик) ..... }
  FinalTime: Int64; { ...................... Время выполнения команды (счетчик) .... }
  DoRestart: LongBool; { ................... Флаг выполнения перезагрузки класса.... }
  Iteration: Cardinal; { ................... Номер выполненной задачи............... }
  Optimized: Double; { ..................... Множитель счетчика времени............. }

  { Процедура для работы со свойствами визуализатора потока.......... }
  procedure ExecuteProperty(ExchangeData: Pointer; OpenType: LongBool);
  begin
    if OpenType then
      With TIncomeData(ExchangeData^) do
        case GATE of
          1:
            FlowVisualizer.incSource[ROOT] := TASK;
          2:
            FlowVisualizer.outSource[ROOT] := TASK;
          3:
            FlowVisualizer.putSource[ROOT] := TASK;
        end
      else
        With TResultData(ExchangeData^) do
          case GATE of
            1:
              Arrow := FlowVisualizer.incResult;
            2:
              Arrow := FlowVisualizer.outResult;
            3:
              Arrow := FlowVisualizer.putResult;
          end
  end;

begin
Restart : { Метка для перезагрузка визуализатора потока }
  Iteration := 0;

  QueryPerformanceFrequency(Frequency);
  if Frequency = 0 then
    RunError(1); { 998 Ошибка определения частоты на многоядерных процессорах }
  Optimized := 1000 / Frequency;
  DoRestart := False;

  try
    With TParentProcessIncomeParameter(Parameter^) do
    begin

      FlowVisualizer := TFlowVisualizer.Create;
      CallBackC(@Messages, @TreeDB);

      try
      DoAgain : { Метка возврата к началу защищенного блока }

        ResultData.Arrow := nil;
        TotalTime := 0.0;

        if TimerFlag then
        begin { Если нужно произвести операцию связанную с таймером }
          QueryPerformanceCounter(StartTime);
          ExecuteProperty(@IncomeData, True);
          QueryPerformanceCounter(FinalTime);
          FinalTime := FinalTime - StartTime;
          TotalTime := FinalTime * Optimized;
        end
        else { Выполнить действия без учета времени выполнения }
        begin
          ExecuteProperty(@IncomeData, True);
        end;

        { Получение результата, вызов внешней процедуры и заморозка }
        ExecuteProperty(@ResultData, False);
        CallBackS(Iteration);
        ThreadSUS := SuspendThread(ThreadHID);
        Inc(Iteration);

        if not FinalFlag then { Если флаг пуст повторям действие заново }
          goto DoAgain;

      except
        on E: Exception do { Вызываем внешний обработчик ошибок }
          DoRestart := CallBackE(Iteration);
      end;
    end;

  finally
    FlowVisualizer.Free;
  end;

  if DoRestart then { Если произошла критическая ошибка, пробуем начать заново }
    goto Restart;
  Result := 0;
end;

  case SIDCODE of
    0:;
    1:;
    n-1;
    n:;
  else
    ;
  end;