ExWaitWindow

CommonUtils/ParamsUtils.pas

@@ -24,6 +24,11 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 }
 
 {
+Данный модуль был разработан при создании примера WaitWindowExample.
+https://github.com/loginov-dmitry/multithread/tree/master/ExWaitWindow
+
+Вы его можете применять в любых проектах!
+
 Основу модуля ParamsUtils составляет структура (record) TParamsRec, которая хранит
 именованный (либо неименованный) список параметров. Данная структура необходима
 для работы функции DoOperationInThread. Однако Вы можете использовать её как
@@ -31,15 +36,27 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 параметров различного типа. Это намного лучше, чем передавать
 параметры в виде вариантного массива (либо массива вариантов), поскольку обеспечивается
 доступ к параметру по имени (а не только по индексу).
-Конечно, возможности TParamsRec намного скромнее, чем SuperObject, которую также
-удобно использовать для передачи произвольного списка параметров в функцию, однако
-вся реализация TParamsRec занимает всего лишь несколько сотен строк кода.
+
+  Что лучше? Классический способ передачи параметров в виде массива с произвольным количеством элементов:
+    MyFunc(VarArrayOf([s, pr, cnt, v, crt, Now]))
+  при этом доступ к элементам массива возможен только по индексу, например:
+  sTovarName := Params[0];
+  sSumma := Params[1] * Params[2]
+
+  или с использованием структуры TParamsRec:
+    MyFunc(TParamsRec.Build(['Tovar', s, 'Price', pr, 'Count', cnt, 'VidOpl', v, 'CardNum', crt, 'SaleTime', Now]))
+  при этом доступ к элементам массива возможен по имени, например:
+  sTovarName := par.S('Tovar');
+  sSumma := par.C('Price') * par.C('Count');
+
+Я считаю, что без сомнения, второй вариант намного более удобный, позволяет упростить
+код программы, сделать его более читабельным и снизить вероятность ошибок.
+
 Не используйте TParamsRec для передачи слишком большого количества параметров, т.к.
 для доступа к значению параметра используется последовательный поиск строки в массиве
 параметров, а это не самый быстрый способ доступа!
-Примеры использования структуры TParamsRec смотрите в примере ExWaitWindow (проект WaitWindowExample).
 }
-  
+
 unit ParamsUtils;
 
 interface
@@ -53,22 +70,73 @@ type
     ParamValue: Variant;
   end;
 
+  TParamsStringArray = array of string;
+  TParamsVariantArray = array of Variant;
+
   PParamsRec = ^TParamsRec;
   TParamsRec = record
     Params: array of TParamDesc;
 
-    procedure AddParams(ParamNamesAndValues: array of Variant);
-    procedure AddParamsNoNames(ParamValues: array of Variant);
-    procedure SetParam(const ParamName: string; Value: Variant);
+    {Устанавливает значение заданного параметра. Если необходимо установить значения
+     нескольких параметров (с именем), то используйте функцию SetParams}
+    procedure SetParam(const ParamName: string; const Value: Variant);
 
+    {Записывает указанные параметры (названия и значения) в массив Params. Каждый
+     чётный элемент - имя параметра, нечётный - значение параметра. Пример:
+     ParamsRec.SetParams(['Name1', Value1, 'Name2', Value2])}
+    procedure SetParams(ParamNamesAndValues: array of Variant);
+
+    {Загружает в Params параметры из вариантного массива. Может быть
+     полезным при взаимодействии между модулями с использованием типа Variant, например:
+        var V: Variant := VarArrayOf(['Name1', Value1, 'Name2', Value2]);
+        ParamsRec.SetParamsFromVariant(V);
+     К сожалению, не получается объявить функцию с тем же именем (SetParams), т.к.
+     Delphi автоматически преобразует массив вариантов в вариантный массив, а затем
+     вызывает версию функции, где параметр объявлен как Variant }
+    procedure SetParamsFromVariant(ParamNamesAndValues: Variant);
+
+    {Добавляет значения параметров (без имени) в массив Params. Для доступа к значениям
+     параметров без имени необходимо обращаться по индексу с помощью соответствующего
+     набора функций}
+    procedure AddParamsNoNames(ParamValues: array of Variant);
+
+    {Очищает массив Params}
     procedure Clear;
 
+    {Проверяет, есть ли параметр с указанным именем}
     function HasParam(const ParamName: string): Boolean;
+    
     function GetParamIndex(const ParamName: string): Integer;
+    // Возвращает тип параметра. Если параметр отсутствует, то возвращает varEmpty
+    // Описание типов см. в System.pas (varEmpty, varInteger, varDouble, varDate, varString и т.д.)
+    function GetParamType(const ParamName: string): TVarType; overload;
 
+    // Если индекс некорректный, то выбрасывает Exception
+    function GetParamType(Idx: Integer): TVarType; overload;
+
+    function ExtractParamNames: TParamsStringArray;
+    function ExtractParamValues: TParamsVariantArray;
+
+    { Возвращает список наименований и значений параметров в виде вариантного массива.
+      По сути, выполняет сериализацию параметров в вариантный массив.
+      Это может быть полезным при организации взаимодействия между модулями.
+      Например, один модуль записывает наименования и значения параметров в TParamsRec,
+      затем извлекает их в виде варианта с помощью метода ExtractAsVarArray,
+      затем передаёт во второй модуль.
+      Второй модуль принимает параметры в виде Variant и выполняет их десериализацию
+      с помощью метода SetParamsFromVariant}
+    function ExtractAsVarArray: Variant;
+
+    function Count: Integer;
+
+    {Возвращает значение параметра (в формате Variant) по его имени.
+     Внимание! Не рекомендуется иметь дело в типом Variant. Вместо этого используйте
+     типизированные методы: I, U, D, C, S, B, DT}
     function GetValue(const ParamName: string): Variant; overload;
+    function GetValue(const ParamName: string; DefValue: Variant): Variant; overload;
 
     // Короткие методы для извлечения значения параметра по его имени
+    // Группа методов без "DefValue". Если параметр отсутствует, то будет выдано исключение
     function I(const ParamName: string): Int64; overload;
     function U(const ParamName: string): Cardinal; overload;
     function D(const ParamName: string): Double; overload;
@@ -77,9 +145,20 @@ type
     function B(const ParamName: string): Boolean; overload;
     function DT(const ParamName: string): TDateTime; overload;
 
+    // Группа методов с "DefValue". Если параметр отсутствует, то вернёт DefValue
+    function I(const ParamName: string; DefValue: Int64): Int64; overload;
+    function U(const ParamName: string; DefValue: Cardinal): Cardinal; overload;
+    function D(const ParamName: string; DefValue: Double): Double; overload;
+    function C(const ParamName: string; DefValue: Currency): Currency; overload;
+    function S(const ParamName: string; DefValue: string): string; overload;
+    function B(const ParamName: string; DefValue: Boolean): Boolean; overload;
+    function DT(const ParamName: string; DefValue: TDateTime): TDateTime; overload;
+
     function GetValue(Idx: Integer): Variant; overload;
 
     // Короткие методы для извлечения значения параметра по его интексу
+    // Внимание! Параметр должен существовать! Если парамет с указанным индексом
+    // отсутствует, то будет сгенерировано исключение!
     function I(Idx: Integer): Int64; overload;
     function U(Idx: Integer): Cardinal; overload;
     function D(Idx: Integer): Double; overload;
@@ -91,7 +170,9 @@ type
     // Методы для передачи параметров в функцию DoOperationInThread без объявления
     // переменной TParamsRec
     class function Build(ParamNamesAndValues: array of Variant): TParamsRec; static;
+    class function BuildFromVariant(ParamNamesAndValues: Variant): TParamsRec; static;
     class function BuildNoNames(ParamValues: array of Variant): TParamsRec; static;
+    class function ParamNamesToString(ParamNames: array of string; DelimChar: Char = ','): string; static;
   end;
 
 var
@@ -102,30 +183,50 @@ implementation
 
 { TParamsRec }
 
-procedure TParamsRec.AddParams(ParamNamesAndValues: array of Variant);
+procedure TParamsRec.SetParams(ParamNamesAndValues: array of Variant);
 const
-  ErrPrefix = 'TParamsRec.AddParams';
-var  
-  I, CurIdx: Integer;
+  ErrPrefix = 'TParamsRec.SetParams';
+var
+  I, CurIdx, Idx, MaxLen: Integer;
+  NewParams: array of TParamDesc;
 begin
   if Odd(Length(ParamNamesAndValues)) then
     raise Exception.Create(ErrPrefix + ': Число элементов должно быть чётным');
-  CurIdx := High(Params) + 1;
-  SetLength(Params, Length(Params) + Length(ParamNamesAndValues) div 2);
 
+  SetLength(NewParams, Length(ParamNamesAndValues) div 2);
+  CurIdx := 0;
   for I := 0 to High(ParamNamesAndValues) do
   begin
     if not Odd(I) then // Если Чётное (0, 2, 4, ...)
     begin
       if not VarIsStr(ParamNamesAndValues[I]) then
         raise Exception.CreateFmt('%s: Элемент %d массива ParamNamesAndValues должен быть строкой', [ErrPrefix, I]);
-      Params[CurIdx].ParamName := ParamNamesAndValues[I];
+      if ParamNamesAndValues[I] = '' then
+        raise Exception.CreateFmt('%s: Название элемена %d массива ParamNamesAndValues не указано', [ErrPrefix, I]);
+      NewParams[CurIdx].ParamName := ParamNamesAndValues[I];
     end else // Если нечётное (1, 3, 5, ...)
     begin
-      Params[CurIdx].ParamValue := ParamNamesAndValues[I];
+      NewParams[CurIdx].ParamValue := ParamNamesAndValues[I];
       Inc(CurIdx);
     end;
   end;
+
+  CurIdx := High(Params) + 1;
+  MaxLen := Length(Params) + Length(NewParams);
+  SetLength(Params, MaxLen); // Устанавливаем сначала максимальную длину
+  for I := 0 to High(NewParams) do
+  begin
+    Idx := GetParamIndex(NewParams[I].ParamName);
+    if Idx >= 0 then
+      Params[Idx] := NewParams[I]
+    else
+    begin
+      Params[CurIdx] := NewParams[I];
+      Inc(CurIdx);
+    end;
+  end;
+  if CurIdx <> MaxLen then
+    SetLength(Params, CurIdx);
 end;
 
 procedure TParamsRec.AddParamsNoNames(ParamValues: array of Variant);
@@ -151,18 +252,29 @@ begin
   Result := GetValue(Idx);
 end;
 
+function TParamsRec.B(const ParamName: string; DefValue: Boolean): Boolean;
+begin
+  Result := GetValue(ParamName, DefValue);
+end;
+
 class function TParamsRec.Build(
   ParamNamesAndValues: array of Variant): TParamsRec;
 begin
   try
     Result.Clear;
-    Result.AddParams(ParamNamesAndValues);
+    Result.SetParams(ParamNamesAndValues);
   except
     on E: Exception do
       raise Exception.Create('TParamsRec.Build: ' + E.Message);
   end;
 end;
 
+class function TParamsRec.BuildFromVariant(ParamNamesAndValues: Variant): TParamsRec;
+begin
+  Result.Clear;
+  Result.SetParamsFromVariant(ParamNamesAndValues);
+end;
+
 class function TParamsRec.BuildNoNames(
   ParamValues: array of Variant): TParamsRec;
 begin
@@ -180,11 +292,21 @@ begin
   Result := GetValue(Idx);
 end;
 
+function TParamsRec.C(const ParamName: string; DefValue: Currency): Currency;
+begin
+  Result := GetValue(ParamName, DefValue);
+end;
+
 procedure TParamsRec.Clear;
 begin
   Params := nil;
 end;
 
+function TParamsRec.Count: Integer;
+begin
+  Result := Length(Params);
+end;
+
 function TParamsRec.D(const ParamName: string): Double;
 begin
   Result := GetValue(ParamName);
@@ -211,6 +333,26 @@ begin
     end;
 end;
 
+function TParamsRec.GetParamType(Idx: Integer): TVarType;
+const
+  ErrPrefix = 'TParamsRec.GetParamType (by index)';
+begin
+  if (Idx < 0) or (Idx > High(Params)) then
+    raise Exception.CreateFmt('%s: указан недопустимый индекс параметра (%d)', [ErrPrefix, Idx]);
+  Result := VarType(Params[Idx].ParamValue);
+end;
+
+function TParamsRec.GetParamType(const ParamName: string): TVarType;
+var
+  Idx: Integer;
+begin
+  Idx := GetParamIndex(ParamName);
+  if Idx >= 0 then
+    Result := VarType(Params[Idx].ParamValue)
+  else
+    Result := varEmpty;
+end;
+
 function TParamsRec.GetValue(Idx: Integer): Variant;
 const
   ErrPrefix = 'TParamsRec.GetValue (by index)';
@@ -220,11 +362,33 @@ begin
   Result := Params[Idx].ParamValue;
 end;
 
+function TParamsRec.GetValue(const ParamName: string;
+  DefValue: Variant): Variant;
+const
+  ErrPrefix = 'TParamsRec.GetValue';
+var
+  Idx: Integer;
+begin
+  if ParamName = '' then
+    raise Exception.CreateFmt('%s: не указано имя параметра', [ErrPrefix]);
+
+  Idx := GetParamIndex(ParamName);
+  if Idx >= 0 then
+    Result := Params[Idx].ParamValue
+  else
+    Result := DefValue;
+end;
+
 function TParamsRec.HasParam(const ParamName: string): Boolean;
 begin
   Result := GetParamIndex(ParamName) >= 0;
 end;
 
+function TParamsRec.I(const ParamName: string; DefValue: Int64): Int64;
+begin
+  Result := GetValue(ParamName, DefValue);
+end;
+
 function TParamsRec.I(Idx: Integer): Int64;
 begin
   Result := GetValue(Idx);
@@ -266,25 +430,104 @@ begin
   Result := GetValue(Idx);
 end;
 
+function TParamsRec.D(const ParamName: string; DefValue: Double): Double;
+begin
+  Result := GetValue(ParamName, DefValue);
+end;
+
 function TParamsRec.DT(Idx: Integer): TDateTime;
 begin
   Result := GetValue(Idx);
 end;
 
+function TParamsRec.DT(const ParamName: string; DefValue: TDateTime): TDateTime;
+begin
+  Result := GetValue(ParamName, DefValue);
+end;
+
+function TParamsRec.ExtractAsVarArray: Variant;
+var
+  Idx, I: Integer;
+begin
+  if Count = 0 then
+    Result := VarArrayOf([])
+  else
+  begin
+    Result := VarArrayCreate([0, Count * 2 - 1], varVariant);
+    Idx := 0;
+    for I := 0 to High(Params) do
+    begin
+      Result[Idx] := Params[I].ParamName;
+      Inc(Idx);
+      Result[Idx] := Params[I].ParamValue;
+      Inc(Idx);
+    end;
+  end;
+end;
+
+function TParamsRec.ExtractParamNames: TParamsStringArray;
+var
+  I: Integer;
+begin
+  SetLength(Result, Length(Params));
+  for I := 0 to High(Params) do
+    Result[I] := Params[I].ParamName;
+end;
+
+function TParamsRec.ExtractParamValues: TParamsVariantArray;
+var
+  I: Integer;
+begin
+  SetLength(Result, Length(Params));
+  for I := 0 to High(Params) do
+    Result[I] := Params[I].ParamValue;
+end;
+
 function TParamsRec.S(Idx: Integer): string;
 begin
   Result := GetValue(Idx);
 end;
 
-procedure TParamsRec.SetParam(const ParamName: string; Value: Variant);
-var
-  Idx: Integer;
+function TParamsRec.S(const ParamName: string; DefValue: string): string;
 begin
-  Idx := GetParamIndex(ParamName);
-  if Idx >= 0 then
-    Params[Idx].ParamValue := Value
-  else
-    AddParams([ParamName, Value]);
+  Result := GetValue(ParamName, DefValue);
+end;
+
+procedure TParamsRec.SetParam(const ParamName: string; const Value: Variant);
+begin
+  SetParams([ParamName, Value]);
+end;
+
+procedure TParamsRec.SetParamsFromVariant(ParamNamesAndValues: Variant);
+var
+  AParams: array of Variant;
+  I: Integer;
+begin
+  if not VarIsArray(ParamNamesAndValues) then
+    raise Exception.Create('TParamsRec.SetParams: входящий параметр должен быть вариантным массивом!');
+  SetLength(AParams, VarArrayHighBound(ParamNamesAndValues, 1) + 1);
+  for I := 0 to VarArrayHighBound(ParamNamesAndValues, 1) do
+    AParams[I] := ParamNamesAndValues[I];
+  SetParams(AParams);
+end;
+
+class function TParamsRec.ParamNamesToString(ParamNames: array of string;
+  DelimChar: Char): string;
+var
+  s: string;  
+begin
+  Result := '';
+  for s in ParamNames do
+  begin
+    if Result <> '' then
+      Result := Result + DelimChar;
+    Result := Result + s;
+  end;
+end;
+
+function TParamsRec.U(const ParamName: string; DefValue: Cardinal): Cardinal;
+begin
+  Result := GetValue(ParamName, DefValue);
 end;
 
 function TParamsRec.U(Idx: Integer): Cardinal;

ExWaitWindow/MainFrm.pas

@@ -52,13 +52,13 @@ type
     procedure FormCreate(Sender: TObject);
   private
     function PrintKKMCheck(OperType: Integer; par: TParamsRec; AResParams: PParamsRec;
-      wsi: TWaitStatusInterface): Boolean;
+      wsi: IWaitStatusInterface): Boolean;
     { Private declarations }
   public
     { Public declarations }
   end;
 
-function BankOperation(OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
+function BankOperation(OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
 
 var
   MainForm: TMainForm;
@@ -67,7 +67,7 @@ implementation
 
 {$R *.dfm}
 
-function BankOperation(OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
+function BankOperation(OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
 begin
   wsi.StatusLine[1] := 'Вставьте/приложите карту';
   Sleep(2000);
@@ -99,13 +99,13 @@ begin
   begin
     AResParams.SetParam('CardNum', 'VISA****8077');
     AResParams.SetParam('OperTime', Now);
-    //AResParams.AddParams(['CardNum', 'VISA****8077']);
-    //AResParams.AddParams(['OperTime', Now]);
+    //AResParams.SetParams(['CardNum', 'VISA****8077']);
+    //AResParams.SetParams(['OperTime', Now]);
   end;
   Result := True;
 end;
 
-function SaveTransactionInDB(OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
+function SaveTransactionInDB(OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
 begin
   wsi.StatusLine[1] := Format('Товар: %s; %fр.; Карта: %s', [par.S('TovarName'), par.C('Summa'), par.S('CardNum')]);
   if par.HasParam('OperTime') then
@@ -114,7 +114,7 @@ begin
   Result := True;
 end;
 
-function FastOperation(OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
+function FastOperation(OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
 begin
   Result := True;
 end;
@@ -127,7 +127,7 @@ begin
   {$IFDEF D2009PLUS}
   // Демонстрация использования анонимной функции
   DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Быстрая операция', ParamsEmpty,
-    function (OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean
+    function (OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean
     begin
       Result := True;
     end, NOT_SHOW_STOP_BTN);
@@ -137,7 +137,7 @@ begin
   ShowMessageFmt('Время выполнения операции: %d мс', [ti.ElapsedMilliseconds]);
 end;
 
-function ProgressOperation(OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
+function ProgressOperation(OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
 var
   I: Integer;
 begin
@@ -165,7 +165,7 @@ begin
   ReportMemoryLeaksOnShutdown := True;
 end;
 
-function TMainForm.PrintKKMCheck(OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
+function TMainForm.PrintKKMCheck(OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
 begin
   wsi.StatusLine[1] := Format('Товар: %s; %fр.; Карта: %s', [par.S('TovarName'), par.C('Summa'), par.S('CardNum')]);
   Sleep(2000);
@@ -188,7 +188,8 @@ begin
     TParamsRec.Build(['Summa', Summa]), BankOperation, NEED_SHOW_STOP_BTN, @ResParams) then
   begin
     CardNum := ResParams.S('CardNum');
-    par.AddParams(['TovarName', TovarName, 'Summa', Summa, 'PayType', PayType, 'CardNum', CardNum, 'OperTime', ResParams.DT('OperTime')]);
+    par.SetParams(['TovarName', TovarName, 'Summa', Summa, 'PayType', PayType, 'CardNum', CardNum, 'OperTime', ResParams.DT('OperTime')]);
+    //par.SetParamsFromVariant(VarArrayOf(['TovarName', TovarName, 'Summa', Summa, 'PayType', PayType, 'CardNum', CardNum, 'OperTime', ResParams.DT('OperTime')]));
     DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Сохранение транзакции в БД', par, SaveTransactionInDB,  NOT_SHOW_STOP_BTN);
     DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Печать чека ККМ', par, PrintKKMCheck, NOT_SHOW_STOP_BTN);
   end;

ExWaitWindow/WaitFrm.pas

@@ -45,7 +45,7 @@ type
   {Интерфейс можно вынести (при необходимости) в отдельный файл. Интерфейсную
    ссылку можно передавать в DLL. IID не указан, т.к. технология COM здесь не
    используется }
-  TWaitStatusInterface = interface
+  IWaitStatusInterface = interface
     // private
     function GetOperationName: string;
     procedure SetOperationName(const Value: string);
@@ -73,11 +73,11 @@ type
   
   {$IFDEF D2009PLUS}
   // Для современных версий Delphi используется механизм анонимных функций.
-  TWorkFunction = reference to function (OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
+  TWorkFunction = reference to function (OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
   {$ELSE}
   // Для старых версий Delphi приходится объявлять отдельно TWorkFunction и TWorkMethod
-  TWorkFunction = function (OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean;
-  TWorkMethod = function (OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: TWaitStatusInterface): Boolean of object;
+  TWorkFunction = function (OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
+  TWorkMethod = function (OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean of object;
   {$ENDIF}
 
   TWaitForm = class(TForm)
@@ -100,7 +100,7 @@ type
     FIsSuccess: Boolean;
     FStartTime: TDateTime;
     FCanClose: Boolean;
-    FStatusInterface: TWaitStatusInterface;
+    FStatusInterface: IWaitStatusInterface;
   public
     { Public declarations }
   end;
@@ -118,7 +118,7 @@ implementation
 
 {$R *.dfm}
 type
-  TWaitStatusControl = class(TInterfacedObject, TWaitStatusInterface)
+  TWaitStatusControl = class(TInterfacedObject, IWaitStatusInterface)
   private
     FStatusText: TStringList;
     FOperationName: string;
@@ -161,13 +161,13 @@ type
     // Эвент нужен для того, чтобы доп. поток немедленно отреагирован на отображения
     // окна ожидания на экране.
     FEvent: TEvent;
-    FStatusInterface: TWaitStatusInterface;
+    FStatusInterface: IWaitStatusInterface;
     FOperType: Integer;
   protected
     procedure Execute; override;
   public
     constructor Create(AParams: TParamsRec; AResParams: PParamsRec; AWorkFunc: TWorkFunction; {$IFNDEF D2009PLUS}AWorkMethod: TWorkMethod; {$ENDIF}
-      AForm: TForm; AStatusInterface: TWaitStatusInterface; OperType: Integer);
+      AForm: TForm; AStatusInterface: IWaitStatusInterface; OperType: Integer);
     destructor Destroy; override;
   end;
 
@@ -225,7 +225,7 @@ end;
 
 constructor TBackgroundOperationsThread.Create(AParams: TParamsRec; AResParams: PParamsRec;
   AWorkFunc: TWorkFunction; {$IFNDEF D2009PLUS}AWorkMethod: TWorkMethod; {$ENDIF}AForm: TForm;
-  AStatusInterface: TWaitStatusInterface; OperType: Integer);
+  AStatusInterface: IWaitStatusInterface; OperType: Integer);
 const
   STATE_NONSIGNALED = FALSE;
   NOT_AUTO_RESET    = TRUE;

multithread_in_delphi_for_beginners.md

@@ -1,6 +1,6 @@
 # Многопоточное программирование в Delphi для начинающих
 
-(редакция 1.10 от 04.06.2021г)  
+(редакция 1.11 от 09.07.2021г)  
 Автор: Логинов Д.С.  
 Пенза, 2021
 
@@ -117,6 +117,8 @@ markdown-редакторы не подошли, т.к. они либо не у
 
 13. Проблемы, возникающие при создании большого количества потоков [...](#many_thread_problem)
 
+14. Выполнение длительной операции в дополнительном потоке с отображением информационного модального окна, блокирующего работу пользователя с программой [...](#show_modal_window)
+
 
 # 1. Вступление <a name="intro"></a>
 
@@ -2613,6 +2615,185 @@ end;
 6. Проблема масштабирования стандартного менеджера памяти (и FastMM4). Дело в том, что архитектура менеджера памяти FastMM4 закладывалась ещё во времена 1-ядерных процессоров и 1-поточных программ. Для программы, в которой отсутствуют дополнительные потоки, FastMM4 является оптимальным выбором. В дальнейшем на Delphi стали разрабатывать многопоточные программы, но процессоры всё ещё оставались 1-ядерными. Для многопоточной программы, запущенной на 1-ядерном процессоре, FastMM4 также являлся оптимальным выбором. К сожалению, для многоядерных процессоров FastMM4 не расчитан. Вы не сможете разработать высокопроизводительную программу, которая максимально эффективно утилизирует ядра процессора - узким местом будут обращения к функциям менеджера памяти (GetMem, FreeMem, создание объектов, работа со строками и динамическими массивами и т.д.). Если 2 потока решат одновременно создать объект (TObject.Create), то FastMM4 поставит вызовы функции менеджера памяти в очередь с использованием атомарной функции LockCmpxchg. При этом, если не удалось заблокировать ресурс, то может произойти вызов функции `Sleep(1)`, которая заморозит ожидающий поток до очередного срабатывания системного таймера (примерно на 16 мс).
 Хорошая новость заключается в том, что автор библиотеки FastMM4 разработал новый менеджер памяти - [FastMM5](https://github.com/pleriche/FastMM5), который намного лучше масштабируется, однако является платным для коммерческого использования.
 
+
+# 14. Выполнение длительной операции в дополнительном потоке с отображением информационного модального окна, блокирующего работу пользователя с программой <a name="show_modal_window"></a>
+
+При разработке приложения очень часто, в ответ на действия пользователя, приходится запускать на выполнение код, длительность которого может составить несколько секунд, при этом должен устанавливаться запрет на дальнейшие действия пользователя с программой, до тех пор, пока длительный код не завершит свою работу. С такими ситуациями мы встречаемся очень часто, например: 
+
+- при нажатии кнопки выполняем запрос к базе данных, а затем показываем пользователю результат запроса в новом окне;  
+- выполняем операцию с банковской картой;  
+- выполняем пробитие чека на кассе;  
+- выполняем формирование отчёта;  
+- отображаем на экране окно, которое в событии FormCreate выполняет длительную загрузку данных (из файла или из базы данных);  
+- сохраняем изменения, внесённые в документ;  
+- и т.д.
+
+Во всех случаях пользователю необходимо дождаться, пока операция не будет завершена. Пока операция выполняется, использование программы является бессмысленным. Более того, если мы возьмём, и просто запустим выполнение длительной операции в дополнительном потоке, не блокируя интерфейс пользователя, то пользователь может нажать что-нибудь лишнее, в результате чего программа может перейти в непредсказуемое состояние. При таком способе запуска длительной операции, для блокировки интерфейса пользователя рекомендуется выставить свойство `Enabled := False` для всех элементов, с которыми пользователь может взаимодействовать с помощью мыши либо клавиатуры, а также запретить закрытие окна (с помощью параметра `CanClose` в обработчике `FormCloseQuery`).
+
+Конечно, вы можете запустить длительный код в контексте основного потока. При этом пользователь не сможет ничего лишнего нажать до завершения операции (не забудьте изменить текст нажатой кнопки и курсор мыши на время выполнения операции - так пользователь будет хотябы понимать, что программа отреагировала на его действие и чем-то занимается). Если операция выполняется несколько секунд без какого-либо информирования пользователя, то пользоваться такой программой будет неприятно. Ещё хуже, если Windows повесит собственное окно с надписью "не отвечает" - в этом случае у пользователя может сложиться впечатление, что программа зависла. Если программа находится в таком состоянии более 30 секунд, то с большой вероятностью пользователь может попытаться решить "проблему" кардинально с помощью диспетчера задач либо путём перезагрузки компьютера.
+
+Вы можете перед началом длительной операции отобразить на экране дополнительное окно к надписью "Выполняется операция ХХХ. Ждите!", а в конце операции закрыть его (см п. 1.2). Однако при таком способе есть несколько минусов:
+1. Невозможно отобразить прошедшее время выполнения операции;  
+2. Windows может навесить собственное окно с надписью "Не отвечает", после чего возможна проблема с "вылетом" текущего окна на задний план (в этом случае пользователь не сможет ничего нажать в окне, которое находится на переднем плане и может принять кардинальное решение о перезагрузке компьютера);  
+3. В программе не работают никакие автоматические операции, запускающиеся из основного потока (обработчик TTimer.OnTimer не будет вызываться, пока основной поток не освободится);  
+4. Основной поток не обрабатывает вызовы SendMessage, PostMessage, Synchronize, Queue;  
+5. Если в программе используются асинхронные сетевые компоненты, использующие основной поток (например, Overbyte ICS), то их работа будет приостановлена, а соединения могут быть разорваны;  
+6. Сложно организовать информирование пользователя о текущем состоянии выполняемой операции;  
+7. Невозможно прервать ход выполнения длительной операции, даже если прерывание операции логично и не приводит к каким-либо проблемам (например, при формировании отчёта).
+
+Далее демонстрируется пример, в котором все перечисленные проблемы решены! По сути, это готовое решение, котором можно использовать практически в любом VCL-проекте. Но мне хотелось бы, чтобы читатель досконально разобрался с исходными кодами. Мною было потрачено на этот пример много дней и весь код я постарался привести в максимально читабельный вид. Также мною разработан модуль ParamsUtils.pas, который значительно упрощает передачу именованного списка параметров различного типа, что весьма полезно в ситуации, когда мы не можем напрямую вызвать целевую функцию с её "родными" параметрами.
+
+В папке ExWaitWindow находится пример, в котором демонстрируется способ отображения дополнительного модального окна при запуске длительной операции с помощью функции `DoOperationInThread`. Ниже пример использования функции `DoOperationInThread`:
+
+```pascal
+procedure TMainForm.Button3Click(Sender: TObject);
+begin
+  DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Длительные вычисления',
+    TParamsRec.Build(['Min', 300, 'Max', 700]),
+    ProgressOperation, NEED_SHOW_STOP_BTN);
+end;
+```
+
+В данном примере на экране отображается модальное окно с надписью "Длительные вычисления". Данное окно отображается на экране около 5 секунд. В этом окне отображаются следующие элементы:
+
+1. Время, прошедшее от начала операции;  
+2. Полоса ProgressBar, которая индицирует ход вычислений;  
+3. Текущее значение, используемое в вычислительном алгоритме;  
+4. Границы вычисления Min и Max;  
+5. Кнопка "Отмена", позволяющая досрочно прервать выполнение операции.
+
+:warning: **Внимание!** Обратите внимание, что длительная операция запускается в дополнительном потоке! 
+
+Объявление функции `DoOperationInThread` выглядит следующим образом:
+
+```pascal
+  function DoOperationInThread(AOwner: TForm; OperType: Integer; OperationName: string; AParams: TParamsRec;
+    WorkFunc: TWorkFunction; ShowStopButton: Boolean; AResParams: PParamsRec = RES_PARAMS_NIL): Boolean; overload;
+```
+
+Назначение параметров функции `DoOperationInThread`:
+
+- `AOwner` - объект формы, из которой вызывается функция `DoOperationInThread` (допускается использовать значение NIL);  
+- `OperType` - тип выполняемой операции. Если рабочая функция `WorkFunc` выполняет только одну операцию, то можно использовать константу `OPERATION_TYPE_NONE`;  
+- `OperationName` - наименование выполняемой операции. Отображается в модальном окне. Рабочая функция может его изменить;  
+- `WorkFunc` - рабочая функция, выполняющая длительную операцию. Запускается из дополнительного потока. В неё передаются входные параметры `AParams`. Она может установить значения выходных параметров `AResParams`. Также она может управлять содержимым модального информационного окна. В качестве `WorkFunc` можно использовать обычную функцию, метод, либо анонимную функцию (для современных Delphi);  
+- `AParams` - входящие параметры для передачи в рабочую функцию. Обеспечивается удобный доступ к параметрам по имени;  
+- `ShowStopButton` - определяет, нужно ли показывать кнопку "Отмена" в информационном окне. Если Вы отображаете кнопку "Отмена", то рабочая функция должна поддерживать возможность прерывания длительной операции;  
+- `AResParams` - указатель на структуру TParamsRec, который передаётся в рабочую функцию. С помощью данного указателя рабочая функция возвращает результат своей работы (в виде произвольного количества именованных параметров);  
+- `Result` - признак успешного выполнения рабочей функции. Функция `DoOperationInThread` возвращает это значение.
+
+`ProgressOperation` - это рабочая функция, содержащая код длительной операции.
+
+Объявление функции `ProgressOperation` соответствует типу `TWorkFunction`, который объявлен следующим образом:
+
+```pascal
+  TWorkFunction = function (OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
+```
+
+:information_source: **Информация!** Это лишь один из способов объявления типа рабочей функции. Также в функцию `DoOperationInThread` допускается передавать метод объекта и анонимную функцию.
+
+Назначение параметров рабочей функции:
+- `OperType` - тип выполняемой операции. Если рабочая функция выполняет только одну операцию, то она может не анализировать значение этого параметра;  
+- `AParams` - входящие параметры (произвольное количество именованных параметров);  
+- `AResParams` - указатель на структуру TParamsRec. С помощью данного указателя функция возвращает результат своей работы;  
+- `wsi` - интерфейсная ссылка (IWaitStatusInterface), предназначенная для управления содержимым модального окна ожидания;  
+- `Result` - признак успешного выполнения рабочей функции.
+
+Ниже представлен пример реализации рабочей функции `ProgressOperation`:
+
+```pascal
+function ProgressOperation(OperType: Integer; par: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
+var
+  I: Integer;
+begin
+  wsi.SetProgressMinMax(par.I('Min'), par.I('Max'));
+  wsi.StatusLine[2] := Format('Min=%d; Max=%d', [par.I('Min'), par.I('Max')]);
+  for I := par.I('Min') to par.I('Max') do
+  begin
+    wsi.StatusLine[1] := 'Текущее значение: ' + IntToStr(I);
+    wsi.ProgressPosition := I;
+    Sleep(10);
+    wsi.CheckNeedStop;
+  end;
+  Result := True;
+end;
+```
+
+Особенности функции `ProgressOperation`:
+
+- управляет элементом ProgressBar (метод `SetProgressMinMax` и свойство `ProgressPosition` интерфейса `IWaitStatusInterface`);  
+- устанавливает 1-ю и 2-ю строки текста, отображаемого в модальном окне ожидания длительной операции;  
+- на каждой итерации цикла проверяет, была ли нажата кнопка "Отмена". Если кнопка была нажата, то будет сгенерировано исключение `Exception`;  
+- если пользователь нажал кнопку "Отмена", то исключение будет сгенерировано в основном потоке;  
+- доступ к значениям целочисленных параметров `Min` и `Max` осуществляется с помощью кода `par.I('Min')` и `par.I('Max')`;  
+- функция возвращает признак успешного завершения `Result := True`.
+
+Реализация функции `DoOperationInThread` находится в модуле WaitFrm.pas. Модуль распространяется по свободной лицензии, поэтому любой желающий может вносить в свою копию модуля любые изменения и использовать модуль на своё усмотрение.
+
+Для управления содержимым окна ожидания используется интерфейс `IWaitStatusInterface`:
+```pascal
+  IWaitStatusInterface = interface
+    // private
+    function GetOperationName: string;
+    procedure SetOperationName(const Value: string);
+    function GetStatusText: string;
+    procedure SetStatusText(const Value: string);
+    function GetNeedStop: Boolean;
+    procedure SetNeedStop(const Value: Boolean);
+    function GetStatusLine(LineNum: Integer): string;
+    procedure SetStatusLine(LineNum: Integer; const Value: string);
+    procedure SetProgressPosition(Value: Double);
+    function GetProgressPosition: Double;
+
+    // public
+    property OperationName: string read GetOperationName write SetOperationName;
+    property StatusText: string read GetStatusText write SetStatusText;
+    property NeedStop: Boolean read GetNeedStop write SetNeedStop;
+    property ProgressPosition: Double read GetProgressPosition write SetProgressPosition;
+    property StatusLine[LineNum: Integer]: string read GetStatusLine write SetStatusLine;
+    procedure ClearStatusText;
+    procedure CheckNeedStop;
+    procedure SetProgressMinMax(AMin, AMax: Double);
+    function GetProgressMin: Integer;
+    function GetProgressMax: Integer;
+  end;
+```
+
+Обратите внимание, что в данном интерфейсе отсутствует строка IID, поскольку использование данного интерфейса в технологии COM не имеет смысла, а значит обращений к методу QueryInterface не будет!
+
+Структура `TParamsRec` находится в модуле ParamsUtils.pas. Модуль распространяется по свободной лицензии.
+
+Обратите на модуль ParamsUtils.pas также особое внимание. Вот комментарии к нему:
+```pascal
+{Основу модуля ParamsUtils составляет структура (record) TParamsRec, которая хранит
+именованный (либо неименованный) список параметров. Данная структура необходима
+для работы функции DoOperationInThread. Однако Вы можете использовать её как
+универсальный способ передачи параметров в функцию, принимающую произвольное количество
+параметров различного типа. Это намного лучше, чем передавать
+параметры в виде вариантного массива (либо массива вариантов), поскольку обеспечивается
+доступ к параметру по имени (а не только по индексу).
+
+  Что лучше? Классический способ передачи параметров в виде массива с произвольным количеством элементов:
+    MyFunc(VarArrayOf([s, pr, cnt, v, crt, Now]))
+  при этом доступ к элементам массива возможен только по индексу, например:
+  sTovarName := Params[0];
+  sSumma := Params[1] * Params[2]
+
+  или с использованием структуры TParamsRec:
+    MyFunc(TParamsRec.Build(['Tovar', s, 'Price', pr, 'Count', cnt, 'VidOpl', v, 'CardNum', crt, 'SaleTime', Now]))
+  при этом доступ к элементам массива возможен по имени, например:
+  sTovarName := par.S('Tovar');
+  sSumma := par.C('Price') * par.C('Count');
+
+Я считаю, что без сомнения, второй вариант намного более удобный, позволяет упростить
+код программы, сделать его более читабельным и снизить вероятность ошибок.
+
+Не используйте TParamsRec для передачи слишком большого количества параметров, т.к.
+для доступа к значению параметра используется последовательный поиск строки в массиве
+параметров, а это не самый быстрый способ доступа!}
+```
+
+
 <!-- 
 :warning: **Внимание!** 
 :exclamation: **Внимание!**