diff --git a/ExWaitWindow/D10.4/WaitWindowEx10_4.dpr b/ExWaitWindow/D10.4/WaitWindowEx10_4.dpr
new file mode 100644
index 0000000..c108a40
--- /dev/null
+++ b/ExWaitWindow/D10.4/WaitWindowEx10_4.dpr
@@ -0,0 +1,16 @@
+program WaitWindowEx10_4;
+
+uses
+ Forms,
+ MainFrm in '..\MainFrm.pas' {MainForm},
+ WaitFrm in '..\WaitFrm.pas' {WaitForm},
+ TimeIntervals in '..\..\CommonUtils\TimeIntervals.pas';
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.MainFormOnTaskbar := True;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/ExWaitWindow/D10.4/WaitWindowEx10_4.dproj b/ExWaitWindow/D10.4/WaitWindowEx10_4.dproj
new file mode 100644
index 0000000..6a38f62
--- /dev/null
+++ b/ExWaitWindow/D10.4/WaitWindowEx10_4.dproj
@@ -0,0 +1,957 @@
+
+
+ {ec9046a0-8814-4b41-9c07-4315c8b50e49}
+ Debug
+ DCC32
+ WaitWindowEx10_4.exe
+ WaitWindowEx10_4.dpr
+ VCL
+ 19.1
+ True
+ Debug
+ Win32
+ 32897
+ Application
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ WaitWindowEx10_4
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
+ 1049
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+
+
+ android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ $(BDS)\bin\default_app.manifest
+ WaitWindowEx10_4_Icon.ico
+ true
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
+
+
+ $(BDS)\bin\default_app.manifest
+ WaitWindowEx10_4_Icon.ico
+ true
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
+
+
+ 7.0
+ 0
+ False
+ 0
+ RELEASE;$(DCC_Define)
+
+
+ true
+ PerMonitorV2
+
+
+ 7.0
+ DEBUG;$(DCC_Define)
+
+
+ Debug
+
+
+ true
+ PerMonitorV2
+
+
+ Delphi.Personality.12
+
+
+
+
+ False
+ True
+ False
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1049
+ 1251
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+ WaitWindowEx10_4.dpr
+
+
+
+ True
+ True
+ True
+ False
+
+
+
+
+ WaitWindowEx10_4.exe
+ true
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ classes
+ 1
+
+
+ classes
+ 1
+
+
+
+
+ res\xml
+ 1
+
+
+ res\xml
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ library\lib\armeabi
+ 1
+
+
+ library\lib\armeabi
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ library\lib\mips
+ 1
+
+
+ library\lib\mips
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ library\lib\arm64-v8a
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\values-v21
+ 1
+
+
+ res\values-v21
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-ldpi
+ 1
+
+
+ res\drawable-ldpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+
+
+ res\drawable-small
+ 1
+
+
+ res\drawable-small
+ 1
+
+
+
+
+ res\drawable-normal
+ 1
+
+
+ res\drawable-normal
+ 1
+
+
+
+
+ res\drawable-large
+ 1
+
+
+ res\drawable-large
+ 1
+
+
+
+
+ res\drawable-xlarge
+ 1
+
+
+ res\drawable-xlarge
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ 0
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .dll;.bpl
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .bpl
+
+
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ 0
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen
+ 64
+
+
+ ..\$(PROJECTNAME).launchscreen
+ 64
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ Contents
+ 1
+
+
+ Contents
+ 1
+
+
+
+
+ Contents\Resources
+ 1
+
+
+ Contents\Resources
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ library\lib\arm64-v8a
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 12
+
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+
+
+
diff --git a/ExWaitWindow/D10.4/WaitWindowEx10_4.res b/ExWaitWindow/D10.4/WaitWindowEx10_4.res
new file mode 100644
index 0000000..823cfd8
Binary files /dev/null and b/ExWaitWindow/D10.4/WaitWindowEx10_4.res differ
diff --git a/ExWaitWindow/D10.4/WaitWindowEx10_4_Icon.ico b/ExWaitWindow/D10.4/WaitWindowEx10_4_Icon.ico
new file mode 100644
index 0000000..379ec80
Binary files /dev/null and b/ExWaitWindow/D10.4/WaitWindowEx10_4_Icon.ico differ
diff --git a/ExWaitWindow/MainFrm.dfm b/ExWaitWindow/MainFrm.dfm
new file mode 100644
index 0000000..2991ba1
--- /dev/null
+++ b/ExWaitWindow/MainFrm.dfm
@@ -0,0 +1,123 @@
+object MainForm: TMainForm
+ Left = 0
+ Top = 0
+ Caption =
+ #1055#1088#1080#1084#1077#1088' '#1086#1090#1086#1073#1088#1072#1078#1077#1085#1080#1103' '#1084#1086#1076#1072#1083#1100#1085#1086#1075#1086' '#1086#1082#1085#1072' '#1087#1088#1080' '#1074#1099#1087#1086#1083#1085#1077#1085#1080#1080' '#1086#1087#1077#1088#1072#1094#1080#1080' '#1074' '#1076#1086#1087 +
+ '. '#1087#1086#1090#1086#1082#1077
+ ClientHeight = 440
+ ClientWidth = 592
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ OnCreate = FormCreate
+ DesignSize = (
+ 592
+ 440)
+ PixelsPerInch = 96
+ TextHeight = 16
+ object Label1: TLabel
+ Left = 40
+ Top = 16
+ Width = 504
+ Height = 208
+ Caption =
+ #1042' '#1076#1072#1085#1085#1086#1084' '#1087#1088#1080#1084#1077#1088#1077' '#1076#1077#1084#1086#1085#1089#1090#1088#1080#1088#1091#1077#1090#1089#1103', '#1082#1072#1082' '#1084#1086#1078#1085#1086' '#1074#1099#1087#1086#1083#1085#1080#1090#1100' '#1089#1077#1088#1080#1102' '#1074#1079#1072#1080 +
+ #1084#1086#1089#1074#1103#1079#1072#1085#1085#1099#1093' '#13#10#1076#1083#1080#1090#1077#1083#1100#1085#1099#1093' '#1086#1087#1077#1088#1072#1094#1080#1081' '#1080' '#1087#1088#1080' '#1101#1090#1086#1084' '#1085#1077' '#1073#1083#1086#1082#1080#1088#1086#1074#1072#1090#1100' '#1075#1083#1072#1074 +
+ #1085#1099#1081' '#1087#1086#1090#1086#1082'. '#13#10#1044#1077#1084#1086#1085#1089#1090#1088#1080#1088#1091#1077#1090#1089#1103' '#1101#1084#1091#1083#1103#1094#1080#1103' '#1087#1088#1086#1076#1072#1078#1080' '#1090#1086#1074#1072#1088#1072' '#1087#1086' '#1073#1072#1085#1082#1086#1074#1089#1082 +
+ #1086#1081' '#1082#1072#1088#1090#1077'. '#1054#1085#1072' '#1089#1086#1089#1090#1086#1080#1090' '#13#10#1080#1079' '#1089#1083#1077#1076#1091#1102#1097#1080#1093' '#1076#1077#1081#1089#1090#1074#1080#1081':'#13#10'1) '#1054#1087#1077#1088#1072#1094#1080#1103' '#1089' ' +
+ #1073#1072#1085#1082#1086#1074#1089#1082#1086#1081' '#1082#1072#1088#1090#1086#1081' ('#1091#1087#1088#1072#1074#1083#1077#1085#1080#1077' '#1087#1077#1088#1077#1076#1072#1105#1090#1089#1103' '#1084#1086#1076#1091#1083#1102' '#1073#1072#1085#1082#1086#1074#1089#1082#1086#1075#1086#13#10#1087#1088#1086 +
+ #1094#1077#1089#1089#1080#1085#1075#1072'. '#1054#1087#1077#1088#1072#1094#1080#1103' '#1084#1086#1078#1077#1090' '#1079#1072#1085#1103#1090#1100' '#1085#1077#1089#1082#1086#1083#1100#1082#1086' '#1084#1080#1085#1091#1090').'#13#10'2) '#1060#1080#1082#1089#1072#1094#1080#1103' '#1090 +
+ #1088#1072#1085#1079#1072#1082#1094#1080#1080' '#1074' '#1073#1072#1079#1091' '#1076#1072#1085#1085#1099#1093' ('#1086#1087#1077#1088#1072#1094#1080#1103' '#1084#1086#1078#1077#1090' '#1079#1072#1085#1103#1090#1100' '#1085#1077#1089#1082#1086#1083#1100#1082#1086' '#1089#1077#1082#1091#1085#1076')' +
+ #13#10'3) '#1055#1088#1086#1073#1080#1090#1080#1077' '#1095#1077#1082#1072' '#1085#1072' '#1082#1072#1089#1089#1077' ('#1086#1087#1077#1088#1072#1094#1080#1103' '#1084#1086#1078#1077#1090' '#1079#1072#1085#1103#1090#1100' '#1085#1077#1089#1082#1086#1083#1100#1082#1086' '#1089#1077#1082 +
+ #1091#1085#1076')'#13#10#13#10#1041#1083#1072#1075#1086#1076#1072#1088#1103' '#1090#1086#1084#1091', '#1095#1090#1086' '#1075#1083#1072#1074#1085#1099#1081' '#1087#1086#1090#1086#1082' '#1085#1077' '#1073#1083#1086#1082#1080#1088#1091#1077#1090#1089#1103', '#1087#1088#1086#1075#1088#1072 +
+ #1084#1084#1072' '#1084#1086#1078#1077#1090' '#1074' '#1092#1086#1085#1077#13#10#1074#1099#1087#1086#1083#1085#1103#1090#1100' '#1083#1102#1073#1099#1077' '#1086#1087#1077#1088#1072#1094#1080#1080' ('#1085#1072#1087#1088#1080#1084#1077#1088', '#1089#1080#1085#1093#1088#1086#1085#1080#1079#1072 +
+ #1094#1080#1103' '#1089' '#1076#1088#1091#1075#1086#1081' '#1091#1095#1105#1090#1085#1086#1081' '#1089#1080#1089#1090#1077#1084#1086#1081','#13#10#1088#1077#1079#1077#1088#1074#1080#1088#1086#1074#1072#1085#1080#1077' '#1073#1072#1079#1099' '#1076#1072#1085#1085#1099#1093', '#1086#1087#1088#1086 +
+ #1089' '#1086#1073#1086#1088#1091#1076#1086#1074#1072#1085#1080#1103', '#1086#1090#1086#1073#1088#1072#1078#1077#1085#1080#1077' '#1090#1077#1082#1091#1097#1077#1075#1086#13#10#1074#1088#1077#1084#1077#1085#1080' '#1080' '#1090'.'#1076'.)'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clBlue
+ Font.Height = -13
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ end
+ object Label2: TLabel
+ Left = 40
+ Top = 413
+ Width = 117
+ Height = 19
+ Anchors = [akLeft, akBottom]
+ Caption = #1058#1077#1082#1091#1097#1077#1077' '#1074#1088#1077#1084#1103':'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ ExplicitTop = 344
+ end
+ object labCurTime: TLabel
+ Left = 163
+ Top = 413
+ Width = 24
+ Height = 19
+ Anchors = [akLeft, akBottom]
+ Caption = '???'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ ExplicitTop = 344
+ end
+ object Label3: TLabel
+ Left = 200
+ Top = 330
+ Width = 280
+ Height = 16
+ Caption = #1053#1072#1082#1083#1072#1076#1085#1099#1077' '#1088#1072#1089#1093#1086#1076#1099' '#1089#1086#1089#1090#1072#1074#1083#1103#1102#1090' '#1086#1090' 10 '#1076#1086' 30 '#1084#1089
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clBlue
+ Font.Height = -13
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ end
+ object Button1: TButton
+ Left = 64
+ Top = 248
+ Width = 433
+ Height = 41
+ Caption = #1042#1099#1087#1086#1083#1085#1080#1090#1100' '#1101#1084#1091#1083#1103#1094#1080#1102' '#1087#1088#1086#1076#1072#1078#1080' '#1087#1086' '#1073#1072#1085#1082#1086#1074#1089#1082#1086#1081' '#1082#1072#1088#1090#1077
+ TabOrder = 0
+ OnClick = Button1Click
+ end
+ object Button2: TButton
+ Left = 64
+ Top = 296
+ Width = 433
+ Height = 34
+ Caption = #1048#1079#1084#1077#1088#1077#1085#1080#1077' '#1085#1072#1082#1083#1072#1076#1085#1099#1093' '#1088#1072#1089#1093#1086#1076#1086#1074' '#1085#1072' '#1087#1086#1082#1072#1079' '#1084#1086#1076#1072#1083#1100#1085#1086#1081' '#1092#1086#1088#1084#1099
+ TabOrder = 1
+ OnClick = Button2Click
+ end
+ object Button3: TButton
+ Left = 64
+ Top = 352
+ Width = 433
+ Height = 41
+ Caption = #1044#1077#1084#1086#1085#1089#1090#1088#1072#1094#1080#1103' ProgressBar'
+ TabOrder = 2
+ OnClick = Button3Click
+ end
+ object Timer1: TTimer
+ Interval = 300
+ OnTimer = Timer1Timer
+ Left = 16
+ Top = 248
+ end
+end
diff --git a/ExWaitWindow/MainFrm.pas b/ExWaitWindow/MainFrm.pas
new file mode 100644
index 0000000..92e3fc8
--- /dev/null
+++ b/ExWaitWindow/MainFrm.pas
@@ -0,0 +1,204 @@
+{
+Copyright (c) 2021, Loginov Dmitry Sergeevich
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+}
+
+unit MainFrm;
+
+interface
+
+{$IF RTLVersion >= 20.00}
+ {$DEFINE D2009PLUS}
+{$IFEND}
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, ExtCtrls, StdCtrls, WaitFrm, TimeIntervals;
+
+type
+ TMainForm = class(TForm)
+ Label1: TLabel;
+ Label2: TLabel;
+ labCurTime: TLabel;
+ Timer1: TTimer;
+ Button1: TButton;
+ Button2: TButton;
+ Label3: TLabel;
+ Button3: TButton;
+ procedure Timer1Timer(Sender: TObject);
+ procedure Button1Click(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure Button3Click(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+ function PrintKKMCheck(OperType: Integer; AParams: Variant; var AResParams: Variant;
+ wsi: TWaitStatusInterface): Boolean;
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+function BankOperation(OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.dfm}
+
+function BankOperation(OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+begin
+ wsi.StatusLine[1] := 'Вставьте/приложите карту';
+ Sleep(2000);
+ //raise Exception.Create('BankOperation error!');
+ wsi.CheckNeedStop();
+ wsi.StatusLine[1] := 'Введите ПИН-КОД';
+ Sleep(1000);
+ wsi.CheckNeedStop();
+ wsi.StatusLine[2] := '*';
+ Sleep(500);
+ wsi.CheckNeedStop();
+ wsi.StatusLine[2] := '**';
+ Sleep(500);
+ wsi.CheckNeedStop();
+ wsi.StatusLine[2] := '***';
+ Sleep(500);
+ wsi.CheckNeedStop();
+ wsi.StatusLine[2] := '****';
+ Sleep(500);
+ wsi.CheckNeedStop();
+ wsi.StatusLine[2] := '';
+ wsi.StatusLine[1] := 'Выполняется соединение с банком...';
+ Sleep(2000);
+ wsi.StatusLine[1] := 'Операция проведена успешно!';
+ Sleep(1000);
+ wsi.StatusLine[1] := 'Извлеките карту';
+ Sleep(1000);
+ AResParams := VarArrayOf(['VISA****8077']);
+ Result := True;
+end;
+
+function SaveTransactionInDB(OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+var
+ TovarName, CardNum: string;
+ Summa: Currency;
+begin
+ TovarName := AParams[0];
+ Summa := AParams[1];
+ CardNum := AParams[3];
+ wsi.StatusLine[1] := Format('Товар: %s; %fр.; Карта: %s', [TovarName, Summa, CardNum]);
+ Sleep(2000);
+ Result := True;
+end;
+
+function FastOperation(OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+begin
+ Result := True;
+end;
+
+procedure TMainForm.Button2Click(Sender: TObject);
+var
+ ti: TTimeInterval;
+ ResParams: Variant;
+begin
+ ti.Start;
+ {$IFDEF D2009PLUS}
+ // Демонстрация использования анонимной функции
+ DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Быстрая операция', Null,
+ function (OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean
+ begin
+ Result := True;
+ end, NOT_SHOW_STOP_BTN, ResParams);
+ {$ELSE}
+ DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Быстрая операция', Null, FastOperation, NOT_SHOW_STOP_BTN, ResParams);
+ {$ENDIF}
+ ShowMessageFmt('Время выполнения операции: %d мс', [ti.ElapsedMilliseconds]);
+end;
+
+function ProgressOperation(OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+var
+ I: Integer;
+begin
+ wsi.SetProgressMinMax(100, 600);
+ for I := 100 to 600 do
+ begin
+ wsi.StatusLine[1] := 'Текущее значение: ' + IntToStr(I);
+ wsi.ProgressPosition := I;
+ Sleep(10);
+ wsi.CheckNeedStop;
+ end;
+ Result := True;
+end;
+
+procedure TMainForm.Button3Click(Sender: TObject);
+var
+ ResParams: Variant;
+begin
+ DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Длительные вычисления', Null, ProgressOperation, NEED_SHOW_STOP_BTN, ResParams);
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+ ReportMemoryLeaksOnShutdown := True;
+end;
+
+function TMainForm.PrintKKMCheck(OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+var
+ TovarName, CardNum: string;
+ Summa: Currency;
+begin
+ TovarName := AParams[0];
+ Summa := AParams[1];
+ CardNum := AParams[3];
+ wsi.StatusLine[1] := Format('Товар: %s; %fр.; Карта: %s', [TovarName, Summa, CardNum]);
+ Sleep(2000);
+ wsi.OperationName := 'Закрытие чека ККМ';
+ Sleep(1000);
+ Result := True;
+end;
+
+procedure TMainForm.Button1Click(Sender: TObject);
+var
+ Summa: Currency;
+ ResParams: Variant;
+ CardNum, TovarName: string;
+ PayType: string;
+begin
+ TovarName := 'Молоко';
+ Summa := 51.23;
+ PayType := 'ByCard';
+ if DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Операция с банковской картой', VarArrayOf([Summa]), BankOperation, NEED_SHOW_STOP_BTN, ResParams) then
+ begin
+ CardNum := ResParams[0];
+ DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Сохранение транзакции в БД', VarArrayOf([TovarName, Summa, PayType, CardNum]), SaveTransactionInDB, NOT_SHOW_STOP_BTN, ResParams);
+ DoOperationInThread(Self, OPERATION_TYPE_NONE, 'Печать чека ККМ', VarArrayOf([TovarName, Summa, PayType, CardNum]), PrintKKMCheck, NOT_SHOW_STOP_BTN, ResParams);
+ end;
+end;
+
+procedure TMainForm.Timer1Timer(Sender: TObject);
+begin
+ labCurTime.Caption := FormatDateTime('dd.mm.yyyy hh:nn:ss', Now);
+end;
+
+end.
diff --git a/ExWaitWindow/WaitFrm.dfm b/ExWaitWindow/WaitFrm.dfm
new file mode 100644
index 0000000..d5a5f39
--- /dev/null
+++ b/ExWaitWindow/WaitFrm.dfm
@@ -0,0 +1,137 @@
+object WaitForm: TWaitForm
+ Left = 0
+ Top = 0
+ BorderIcons = []
+ BorderStyle = bsDialog
+ Caption = #1042#1099#1087#1086#1083#1085#1103#1077#1090#1089#1103' '#1076#1083#1080#1090#1077#1083#1100#1085#1072#1103' '#1086#1087#1077#1088#1072#1094#1080#1103
+ ClientHeight = 237
+ ClientWidth = 391
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ OnCloseQuery = FormCloseQuery
+ OnShow = FormShow
+ DesignSize = (
+ 391
+ 237)
+ PixelsPerInch = 96
+ TextHeight = 19
+ object Label1: TLabel
+ Left = 21
+ Top = 10
+ Width = 353
+ Height = 23
+ Caption = #1042#1099#1087#1086#1083#1085#1103#1077#1090#1089#1103' '#1076#1083#1080#1090#1077#1083#1100#1085#1072#1103' '#1086#1087#1077#1088#1072#1094#1080#1103
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -19
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object labOperationName: TLabel
+ Left = 8
+ Top = 57
+ Width = 248
+ Height = 19
+ Alignment = taCenter
+ Caption = #1053#1072#1080#1084#1077#1085#1086#1074#1072#1085#1080#1077' '#1090#1077#1082#1091#1097#1077#1081' '#1086#1087#1077#1088#1072#1094#1080#1080
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ end
+ object Label3: TLabel
+ Left = 159
+ Top = 191
+ Width = 83
+ Height = 23
+ Anchors = [akLeft, akBottom]
+ Caption = #1046#1076#1080#1090#1077'...'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clBlue
+ Font.Height = -19
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ ExplicitTop = 148
+ end
+ object Label4: TLabel
+ Left = 8
+ Top = 216
+ Width = 105
+ Height = 16
+ Anchors = [akLeft, akBottom]
+ Caption = #1055#1088#1086#1096#1083#1086' '#1074#1088#1077#1084#1077#1085#1080':'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ ExplicitTop = 173
+ end
+ object lbTime: TLabel
+ Left = 119
+ Top = 217
+ Width = 33
+ Height = 16
+ Anchors = [akLeft, akBottom]
+ Caption = '00:00'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ ExplicitTop = 173
+ end
+ object btnStop: TSpeedButton
+ Left = 296
+ Top = 208
+ Width = 82
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Caption = #1054#1090#1084#1077#1085#1072
+ Visible = False
+ OnClick = btnStopClick
+ ExplicitTop = 165
+ end
+ object labWaitStatus: TLabel
+ Left = 8
+ Top = 86
+ Width = 375
+ Height = 76
+ Alignment = taCenter
+ AutoSize = False
+ Caption = #1057#1090#1072#1090#1091#1089' 1'#13#10#1057#1090#1072#1090#1091#1089' 2'#13#10#1057#1090#1072#1090#1091#1089' 3'#13#10#1057#1090#1072#1090#1091#1089' 4'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ end
+ object ProgressBar1: TProgressBar
+ Left = 32
+ Top = 171
+ Width = 321
+ Height = 17
+ Smooth = True
+ TabOrder = 0
+ Visible = False
+ end
+ object Timer1: TTimer
+ Interval = 200
+ OnTimer = Timer1Timer
+ Left = 16
+ Top = 40
+ end
+end
diff --git a/ExWaitWindow/WaitFrm.pas b/ExWaitWindow/WaitFrm.pas
new file mode 100644
index 0000000..f175131
--- /dev/null
+++ b/ExWaitWindow/WaitFrm.pas
@@ -0,0 +1,432 @@
+{
+Copyright (c) 2021, Loginov Dmitry Sergeevich
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+}
+
+unit WaitFrm;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ActiveX, ExtCtrls, Buttons, SyncObjs, ComCtrls;
+
+{$IF RTLVersion >= 20.00}
+ {$DEFINE D2009PLUS}
+{$IFEND}
+
+const
+ NEED_SHOW_STOP_BTN = True;
+ NOT_SHOW_STOP_BTN = False;
+ OPERATION_TYPE_NONE = 0;
+
+type
+ {Интерфейс можно вынести (при необходимости) в отдельный файл. Интерфейсную
+ ссылку можно передавать в DLL. IID не указан, т.к. технология COM здесь не
+ используется }
+ TWaitStatusInterface = 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;
+
+ {$IFDEF D2009PLUS}
+ // Для современных версий Delphi используется механизм анонимных функций.
+ TWorkFunction = reference to function (OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+ {$ELSE}
+ // Для старых версий Delphi приходится объявлять отдельно TWorkFunction и TWorkMethod
+ TWorkFunction = function (OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean;
+ TWorkMethod = function (OperType: Integer; AParams: Variant; var AResParams: Variant; wsi: TWaitStatusInterface): Boolean of object;
+ {$ENDIF}
+
+ TWaitForm = class(TForm)
+ Label1: TLabel;
+ labOperationName: TLabel;
+ Label3: TLabel;
+ Label4: TLabel;
+ lbTime: TLabel;
+ Timer1: TTimer;
+ btnStop: TSpeedButton;
+ labWaitStatus: TLabel;
+ ProgressBar1: TProgressBar;
+ procedure FormShow(Sender: TObject);
+ procedure Timer1Timer(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure btnStopClick(Sender: TObject);
+ private
+ AThread: TThread;
+ FResParams: Variant;
+ FError: string;
+ FIsSuccess: Boolean;
+ FStartTime: TDateTime;
+ FCanClose: Boolean;
+ FStatusInterface: TWaitStatusInterface;
+ public
+ { Public declarations }
+ end;
+
+function DoOperationInThread(AOwner: TForm; OperType: Integer; OperationName: string; AParams: Variant;
+ WorkFunc: TWorkFunction; ShowStopButton: Boolean; var AResParams: Variant): Boolean; overload;
+
+{$IFNDEF D2009PLUS}
+// Данный вариант используется только для поддержки старых версий Delphi
+function DoOperationInThread(AOwner: TForm; OperType: Integer; OperationName: string; AParams: Variant;
+ WorkMethod: TWorkMethod; ShowStopButton: Boolean; var AResParams: Variant): Boolean; overload;
+{$ENDIF}
+
+implementation
+
+{$R *.dfm}
+type
+ TWaitStatusControl = class(TInterfacedObject, TWaitStatusInterface)
+ private
+ FStatusText: TStringList;
+ FOperationName: string;
+ FCritSect: TCriticalSection;
+ FNeedStop: Boolean;
+ FProgressPosition: Integer;
+ FProgressMin: Integer;
+ FProgressMax: Integer;
+ public
+ 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 ClearStatusText;
+ procedure CheckNeedStop;
+ procedure SetProgressPosition(Value: Double);
+ function GetProgressPosition: Double;
+ procedure SetProgressMinMax(AMin, AMax: Double);
+ function GetProgressMin: Integer;
+ function GetProgressMax: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+ TBackgroundOperationsThread = class(TThread)
+ public
+ FParams: Variant;
+ FWorkFunc: TWorkFunction;
+ {$IFNDEF D2009PLUS}
+ FWorkMethod: TWorkMethod;
+ {$ENDIF}
+ FForm: TForm;
+
+ // Эвент нужен для того, чтобы доп. поток немедленно отреагирован на отображения
+ // окна ожидания на экране.
+ FEvent: TEvent;
+ FStatusInterface: TWaitStatusInterface;
+ FOperType: Integer;
+ protected
+ procedure Execute; override;
+ public
+ constructor Create(AParams: Variant; AWorkFunc: TWorkFunction; {$IFNDEF D2009PLUS}AWorkMethod: TWorkMethod; {$ENDIF}
+ AForm: TForm; AStatusInterface: TWaitStatusInterface; OperType: Integer);
+ destructor Destroy; override;
+ end;
+
+function DoOperationInThreadInternal(AOwner: TForm; OperType: Integer; OperationName: string; AParams: Variant;
+ WorkFunc: TWorkFunction; {$IFNDEF D2009PLUS}WorkMethod: TWorkMethod; {$ENDIF}ShowStopButton: Boolean; var AResParams: Variant): Boolean;
+var
+ AForm: TWaitForm;
+begin
+ if GetCurrentThreadId <> MainThreadID then
+ raise Exception.Create('DoOperationInThreadInternal: Вызов должен происходить из главного потока');
+
+ AForm := TWaitForm.Create(AOwner);
+ try
+ AForm.btnStop.Visible := ShowStopButton;
+
+ AForm.labOperationName.Caption := OperationName;
+ AForm.labOperationName.Left := (AForm.Width - AForm.labOperationName.Width) div 2;
+
+ AForm.labWaitStatus.Caption := '';
+
+ AForm.FStatusInterface := TWaitStatusControl.Create;
+
+ AForm.AThread := TBackgroundOperationsThread.Create(AParams, WorkFunc, {$IFNDEF D2009PLUS}WorkMethod, {$ENDIF}AForm, AForm.FStatusInterface, OperType);
+ AForm.ShowModal;
+
+ if AForm.FError <> '' then
+ raise Exception.Create(AForm.FError);
+
+ Result := AForm.FIsSuccess;
+ AResParams := AForm.FResParams;
+ finally
+ AForm.AThread.Free;
+ AForm.Free;
+ end;
+end;
+
+function DoOperationInThread(AOwner: TForm; OperType: Integer; OperationName: string; AParams: Variant;
+ WorkFunc: TWorkFunction; ShowStopButton: Boolean; var AResParams: Variant): Boolean;
+begin
+ Result := DoOperationInThreadInternal(AOwner, OperType, OperationName, AParams,
+ WorkFunc, {$IFNDEF D2009PLUS}nil, {$ENDIF}ShowStopButton, AResParams);
+end;
+
+{$IFNDEF D2009PLUS}
+function DoOperationInThread(AOwner: TForm; OperType: Integer; OperationName: string; AParams: Variant;
+ WorkMethod: TWorkMethod; ShowStopButton: Boolean; var AResParams: Variant): Boolean; overload;
+begin
+ Result := DoOperationInThreadInternal(AOwner, OperType, OperationName, AParams,
+ nil, WorkMethod, ShowStopButton, AResParams);
+end;
+{$ENDIF}
+
+{ TBackgroundOperationsThread }
+
+constructor TBackgroundOperationsThread.Create(AParams: Variant;
+ AWorkFunc: TWorkFunction; {$IFNDEF D2009PLUS}AWorkMethod: TWorkMethod; {$ENDIF}AForm: TForm;
+ AStatusInterface: TWaitStatusInterface; OperType: Integer);
+const
+ STATE_NONSIGNALED = FALSE;
+ NOT_AUTO_RESET = TRUE;
+begin
+ inherited Create(False);
+ FParams := AParams;
+ FWorkFunc := AWorkFunc;
+ {$IFNDEF D2009PLUS}
+ FWorkMethod := AWorkMethod;
+ {$ENDIF}
+ FForm := AForm;
+ FEvent := TEvent.Create(nil, NOT_AUTO_RESET, STATE_NONSIGNALED, '', False);
+ FStatusInterface := AStatusInterface;
+ FOperType := OperType;
+end;
+
+destructor TBackgroundOperationsThread.Destroy;
+begin
+ FEvent.SetEvent; // На всякий случай
+ inherited;
+ FEvent.Free;
+end;
+
+procedure TBackgroundOperationsThread.Execute;
+begin
+ try
+ CoInitialize(nil);
+ try
+ if Assigned(FWorkFunc) then
+ TWaitForm(FForm).FIsSuccess := FWorkFunc(FOperType, FParams, TWaitForm(FForm).FResParams, TWaitForm(FForm).FStatusInterface)
+ {$IFNDEF D2009PLUS}
+ else if Assigned(FWorkMethod) then
+ TWaitForm(FForm).FIsSuccess := FWorkMethod(FOperType, FParams, TWaitForm(FForm).FResParams, TWaitForm(FForm).FStatusInterface)
+ {$ENDIF}
+ finally
+ CoUnInitialize();
+ end;
+
+ except
+ on E: Exception do
+ TWaitForm(FForm).FError := 'Ошибка в потоке: ' + E.Message;
+ end;
+
+ // Ожидаем, когда форма появится на экране
+ FEvent.WaitFor(INFINITE);
+
+ // Выставляем форме разрешение за закрытие
+ TWaitForm(FForm).FCanClose := True;
+
+ // Посылаем форме сообщение о закрытии
+ SendMessage(TWaitForm(FForm).Handle, WM_CLOSE, 0, 0);
+end;
+
+procedure TWaitForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+begin
+ CanClose := FCanClose;
+end;
+
+procedure TWaitForm.FormShow(Sender: TObject);
+begin
+ FStartTime := Now;
+
+ // Сообщаем потоку о появлении формы на экране
+ TBackgroundOperationsThread(AThread).FEvent.SetEvent;
+end;
+
+procedure TWaitForm.btnStopClick(Sender: TObject);
+begin
+ FStatusInterface.NeedStop := True;
+end;
+
+procedure TWaitForm.Timer1Timer(Sender: TObject);
+begin
+ lbTime.Caption := FormatDateTime('nn:ss', Now - FStartTime);
+ if FStatusInterface.OperationName <> '' then
+ labOperationName.Caption := FStatusInterface.OperationName;
+ labOperationName.Left := (Width - labOperationName.Width) div 2;
+ labWaitStatus.Caption := FStatusInterface.StatusText;
+ ProgressBar1.Visible := FStatusInterface.ProgressPosition > 0;
+ ProgressBar1.Min := FStatusInterface.GetProgressMin;
+ ProgressBar1.Max := FStatusInterface.GetProgressMax;
+ ProgressBar1.Position := Round(FStatusInterface.ProgressPosition);
+end;
+
+{ TWaitStatusControl }
+
+procedure TWaitStatusControl.CheckNeedStop;
+begin
+ if FNeedStop then
+ raise Exception.Create('Пользователь нажал кнопку "Отмена"');
+end;
+
+procedure TWaitStatusControl.ClearStatusText;
+begin
+ SetStatusText('');
+end;
+
+constructor TWaitStatusControl.Create;
+begin
+ inherited;
+ FStatusText := TStringList.Create;
+ FCritSect := TCriticalSection.Create;
+ FProgressMax := 100;
+end;
+
+destructor TWaitStatusControl.Destroy;
+begin
+ FStatusText.Free;
+ FCritSect.Free;
+ inherited;
+end;
+
+function TWaitStatusControl.GetNeedStop: Boolean;
+begin
+ Result := FNeedStop;
+end;
+
+function TWaitStatusControl.GetOperationName: string;
+begin
+ FCritSect.Enter;
+ Result := FOperationName;
+ FCritSect.Leave;
+end;
+
+function TWaitStatusControl.GetProgressMax: Integer;
+begin
+ Result := FProgressMax;
+end;
+
+function TWaitStatusControl.GetProgressMin: Integer;
+begin
+ Result := FProgressMin;
+end;
+
+function TWaitStatusControl.GetProgressPosition: Double;
+begin
+ Result := FProgressPosition;
+end;
+
+function TWaitStatusControl.GetStatusLine(LineNum: Integer): string;
+begin
+ Result := '';
+ if (LineNum < 1) or (LineNum > 4) then Exit;
+
+ FCritSect.Enter;
+ try
+ if FStatusText.Count < LineNum then Exit;
+ Result := FStatusText[LineNum - 1];
+ finally
+ FCritSect.Leave;
+ end;
+end;
+
+function TWaitStatusControl.GetStatusText: string;
+begin
+ FCritSect.Enter;
+ Result := FStatusText.Text;
+ FCritSect.Leave;
+end;
+
+procedure TWaitStatusControl.SetNeedStop(const Value: Boolean);
+begin
+ FNeedStop := Value;
+end;
+
+procedure TWaitStatusControl.SetOperationName(const Value: string);
+begin
+ FCritSect.Enter;
+ FOperationName := Value;
+ FCritSect.Leave;
+end;
+
+procedure TWaitStatusControl.SetProgressMinMax(AMin, AMax: Double);
+begin
+ FProgressMin := Round(AMin);
+ FProgressMax := Round(AMax);
+end;
+
+procedure TWaitStatusControl.SetProgressPosition(Value: Double);
+begin
+ FProgressPosition := Round(Value);
+end;
+
+procedure TWaitStatusControl.SetStatusLine(LineNum: Integer;
+ const Value: string);
+begin
+ if (LineNum < 1) or (LineNum > 4) then Exit;
+
+ FCritSect.Enter;
+ try
+ while FStatusText.Count < LineNum do
+ FStatusText.Add('');
+ FStatusText[LineNum - 1] := Value;
+ finally
+ FCritSect.Leave;
+ end;
+end;
+
+procedure TWaitStatusControl.SetStatusText(const Value: string);
+begin
+ FCritSect.Enter;
+ FStatusText.Text := Value;
+ FCritSect.Leave;
+end;
+
+end.
diff --git a/ExWaitWindow/WaitWindowEx.dpr b/ExWaitWindow/WaitWindowEx.dpr
new file mode 100644
index 0000000..a3d36ed
--- /dev/null
+++ b/ExWaitWindow/WaitWindowEx.dpr
@@ -0,0 +1,16 @@
+program WaitWindowEx;
+
+uses
+ Forms,
+ MainFrm in 'MainFrm.pas' {MainForm},
+ WaitFrm in 'WaitFrm.pas' {WaitForm},
+ TimeIntervals in '..\CommonUtils\TimeIntervals.pas';
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.MainFormOnTaskbar := True;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/ExWaitWindow/WaitWindowEx.dproj b/ExWaitWindow/WaitWindowEx.dproj
new file mode 100644
index 0000000..c022ff3
--- /dev/null
+++ b/ExWaitWindow/WaitWindowEx.dproj
@@ -0,0 +1,40 @@
+
+
+ {ec9046a0-8814-4b41-9c07-4315c8b50e49}
+ Debug
+ AnyCPU
+ DCC32
+ WaitWindowEx.exe
+ WaitWindowEx.dpr
+
+
+ 7.0
+ False
+ False
+ 0
+ RELEASE
+
+
+ 7.0
+ DEBUG
+
+
+ Delphi.Personality
+
+
+FalseTrueFalseFalseFalse1000FalseFalseFalseFalseFalse104912511.0.0.01.0.0.0WaitWindowEx.dpr
+
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/ExWaitWindow/WaitWindowEx.res b/ExWaitWindow/WaitWindowEx.res
new file mode 100644
index 0000000..b91e940
Binary files /dev/null and b/ExWaitWindow/WaitWindowEx.res differ
diff --git a/multithread_in_delphi_for_beginners.md b/multithread_in_delphi_for_beginners.md
index d01d40d..406a6c0 100644
--- a/multithread_in_delphi_for_beginners.md
+++ b/multithread_in_delphi_for_beginners.md
@@ -21,8 +21,6 @@ markdown-редакторы не подошли, т.к. они либо не у
- пример программирования в PPL. Нужно дать ссылки на статьи и видеоуроки в интернете
- подробнее об OmniThreadLibrary - сначала нужно дождаться кроссплатформенной версии
- функция SignalObjectAndWait
-- рассмотреть проблему прерывания ожидания при использования TIdTCPServer (например, при ReadTimeOut равном 30 сек.). Хотелось бы, чтобы и нагрузка на процессор была минимальной и чтобы служба с 1000 подключений могла закрываться оперативно
-
2020-07-28 - начало работы над markdown-версией
-->
@@ -2597,17 +2595,17 @@ end;
3. Использование функции WinAPI-функции `Sleep` либо `WaitForXXX` для организации задержек в бесконечном цикле. Очень простое решение - реализовать в дополнительном потоке бесконечный цикл, периодически проверять значение какого-то флага (либо элемента в очереди), в зависимости от значения флага выполнять какое-либо действие, после чего переводить поток в спящий режим с помощью `Sleep` либо `WaitForXXX`. Если вы укажете время ожидания 1000 мс (или больше), то нет проблем (в том смысле, что нагрузка на процессор будет минимальной - примерно 50000 тактов в секунду при паузе в 1 секунду). Однако если Вы будете проверять значение флага каждые 10 миллисекунд, то нагрузка на процессор будет уже существенной - 2500000 тактов в секунду будет тратиться только на работу `Sleep(10)`. Если у вас запущено 1000 таких потоков и каждый расходует 2500000 тактов в секунду, то будет обеспечена 100% загрузка одного ядра процессора (либо эта загрузка будет размазана по нескольким ядрам). Т.е. ваши 1000 потоков ещё не делают ничего полезного, но уже грузят процессор по полной программе! :)
Для того, чтобы такой проблемы не было, не рекомендуется использовать `Sleep` либо `WaitForXXX` с маленькой задержкой. Гораздо лучше использовать `WaitForXXX` с большой задержкой (в том числе, INFINITY), а при изменении значения флага следует переводить объект ядра, который ожидает функция `WaitForXXX`, в сигнальное состояние. В этом случае потоки не будут тратить на контроль состояния флага практически никаких ресурсов процессора!
-4. Неправильное использование компонента `TIdTCPServer`. При разработке TCP-серверов Delphi-программисты чаще всего используют компонет TIdTCPServer. При правильном использовании данный компонент может держать до 50000 подключений (существуют реальные примеры с таким количеством подключений). Разумеется, для этого программа должна быть 64-битной. Для поддержки 50000 подключений будет создано 50000 потоков и выделено около 3 ГБ ОЗУ, что весьма затратно. При таком количестве потоков ни в коем случае не должно быть циклов, в которых выполняется проверка чего-либо каждые 10 мс. Значение `Socket.ReadTimeout` должно быть не менее 10000 (10 секунд). При использовании `Socket.CheckForDataOnSource` для ожидания приёма данных от клиента также желательно использовать значение не менее 10000.
-**Внимание!** Перед каждым вызовом `Socket.CheckForDataOnSource` необходима проверка `if Socket.InputBuffer.Size = 0 then`, что обусловлено особенностями реализации метода `CheckForDataOnSource`. Если в буфере есть данные, то выполнять вызов `Socket.CheckForDataOnSource` не следует!
+4. Неправильное использование компонента `TIdTCPServer`. При разработке TCP-серверов Delphi-программисты чаще всего используют компонент TIdTCPServer. При правильном использовании данный компонент может держать до 50000 подключений (существуют реальные примеры с таким количеством подключений). Разумеется, для этого программа должна быть 64-битной. Для поддержки 50000 подключений будет создано 50000 потоков и выделено около 3 ГБ ОЗУ, что весьма затратно. При таком количестве потоков ни в коем случае не должно быть циклов, в которых выполняется проверка чего-либо каждые 10 мс. Значение `Socket.ReadTimeout` должно быть не менее 10000 (10 секунд). При использовании `Socket.CheckForDataOnSource` для ожидания приёма данных от клиента также желательно использовать значение не менее 10000.
+:warning: **Внимание!** Перед каждым вызовом `Socket.CheckForDataOnSource` необходима проверка `if Socket.InputBuffer.Size = 0 then`, что обусловлено особенностями реализации метода `CheckForDataOnSource`. Если в буфере есть данные, то выполнять вызов `Socket.CheckForDataOnSource` не следует!
-**Информация!** Сами по себе данные в буфере `Socket.InputBuffer` появиться не могут. Появляются они там в следующих случаях:
+:information_source: **Информация!** Сами по себе данные в буфере `Socket.InputBuffer` появиться не могут. Появляются они там в следующих случаях:
а) в контексте вызова метода `Socket.ReadXXX`,
б) в контексте вызова метода `Socket.CheckForDataOnSource`,
в) в момент подключения клиента к серверу, если клиент сразу же передал данные на сервер.
-**Информация!** На практике Delphi-программисту очень редко приходится разрабатывать TCP-сервер, способный держать 50000 соединений. Всё зависит от того, что именно делает TCP-сервер. Если он не выполняет какой-то особой обработки, а просто возвращает в ответ на запрос клиента текущее время (или иную информацию, которую не нужно запрашивать из базы данных или получать в результате сложных вычислений), то проблем никаких нет. Однако, если на каждый запрос приходится выполнять обращение к базе данных или производить сложные вычисления, то ресурсы сервера могут закончиться гораздо раньше (например, на 1000 соединений). В связи с этим рекомендую минимизировать количество обращений к базе данных и стараться держать всю необходимую информацию в памяти TCP-сервера, периодически обновляя её в фоновом потоке.
+:information_source: **Информация!** На практике Delphi-программисту очень редко приходится разрабатывать TCP-сервер, способный держать 50000 соединений. Всё зависит от того, что именно делает TCP-сервер. Если он не выполняет какой-то особой обработки, а просто возвращает в ответ на запрос клиента текущее время (или иную информацию, которую не нужно запрашивать из базы данных или получать в результате сложных вычислений), то проблем никаких нет. Однако, если на каждый запрос приходится выполнять обращение к базе данных или производить сложные вычисления, то ресурсы сервера могут закончиться гораздо раньше (например, на 1000 соединений). В связи с этим рекомендую минимизировать количество обращений к базе данных и стараться держать всю необходимую информацию в памяти TCP-сервера, периодически обновляя её в фоновом потоке.
-**Внимание!** Не рекомендую использовать `TIdTCPServer` для решения задачи транзита данных. Данная задача отличается тем, что TCP-сервер не выполняет практически никакой обработки данных, а лишь передаёт клиенту "Б" данные, принятые от клиента "А" (и обратно). Если таких клиентов ("А" и "Б") будет 50000, то программа будет использовать около 3 ГБ ОЗУ. Загрузка процессора при активном обмене данными между клиентами будет также весьма приличной, поскольку при большом количестве потоков будет происходить очень много переключений контекста, а каждое переключение мы оцениваем в 50000 тактов. Существуют гораздо более удачные варианты решения задачи транзита данных: асинхронные сокеты и порты завершения ввода/вывода. И в том и в другом способе используется фиксированное количество потоков (например, 8 потоков для 4-ядерного процессора) и требуется намного меньше ОЗУ (как минимум, в 10 раз меньше, чем при использовании `TIdTCPServer`). Количество переключений контекста также намного меньше (сравнение имеет смысл производить только при высокой интенсивности обмена данными), т.к. за один квант времени поток сможет обработать данные, принятые от нескольких клиентов и передать данные нескольким клиентам.
+:warning: **Внимание!** Не рекомендую использовать `TIdTCPServer` для решения задачи транзита данных. Данная задача отличается тем, что TCP-сервер не выполняет практически никакой обработки данных, а лишь передаёт клиенту "Б" данные, принятые от клиента "А" (и обратно). Если таких клиентов ("А" и "Б") будет 50000, то программа будет использовать около 3 ГБ ОЗУ. Загрузка процессора при активном обмене данными между клиентами будет также весьма приличной, поскольку при большом количестве потоков будет происходить очень много переключений контекста, а каждое переключение мы оцениваем в 50000 тактов. Существуют гораздо более удачные варианты решения задачи транзита данных: асинхронные сокеты и порты завершения ввода/вывода. И в том и в другом способе используется фиксированное количество потоков (например, 8 потоков для 4-ядерного процессора) и требуется намного меньше ОЗУ (как минимум, в 10 раз меньше, чем при использовании `TIdTCPServer`). Количество переключений контекста также намного меньше (сравнение имеет смысл производить только при высокой интенсивности обмена данными), т.к. за один квант времени каждый поток может обработать множество соединений.
5. Большой расход памяти при использовании некоторых менеджеров памяти. Современные высокопроизводительные менеджеры памяти, например, [tcmalloc](https://github.com/google/tcmalloc), могут создавать для каждого потока свой собственный пул блоков памяти. Благодаря этому удаётся минимизировать количество блокировок при выделении и освобождении памяти, что позволяет разрабатывать приложения, которые хорошо масштабируются по количеству ядер, т.е. могут максимально эффективно использовать доступные ресурсы памяти и процессора. Кстати, для Delphi имеется интерфейсный файл [tcmalloc.pas](https://github.com/obones/tcmalloc-delphi), позволяющий использовать менеджер памяти tcmalloc, представленный в виде библиотеки "libtcmalloc.dll". С точки зрения производительности, он значительно эффективнее встроенного в Delphi менеждера памяти, при этом поддерживаются любые версии Delphi, однако в нём отсутствуют многие плюшки, которые есть в FastMM4.
Проблема таких менеджеров памяти заключается в том, что им требуется значительно больший объем памяти ОЗУ по сравнению со стандартным менеджером памяти. На каждый поток такой менеджер памяти запросто может выделить дополнительно по 1 МБ ОЗУ. При использовании такого менеджера памяти вы не сможете создавать тысячи потоков, поскольку память ОЗУ может очень быстро закончиться. С точки зрения разработки серверов это означает, что сетевую библиотеку Indy10 с таким менеджером памяти лучше не использовать. Вместо Indy10 вы можете рассмотреть сетевые библиотеки, работающие по другим принципам, например, использующие асинхронные сокеты Windows (это сложнее, чем Indy10) либо механизм "i/o completion ports" (это значительно сложнее, чем Indy10).