diff --git a/.gitignore b/.gitignore index a757874..114eb6e 100644 --- a/.gitignore +++ b/.gitignore @@ -40,3 +40,5 @@ __history /ExExceptions/lib /ExSync/ExEvent/SimpleLogger/lib /ExSync/ExEvent/SimpleLogger/backup +/ExSync/ExEvent/FastStopThread/backup +/ExSync/ExEvent/FastStopThread/lib diff --git a/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.ico b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.ico new file mode 100644 index 0000000..10c5fc1 Binary files /dev/null and b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.ico differ diff --git a/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpi b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpi new file mode 100644 index 0000000..24f2560 --- /dev/null +++ b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpi @@ -0,0 +1,85 @@ + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <RequiredPackages> + <Item> + <PackageName Value="LCL"/> + </Item> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="FastStopThreadLaz.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="FastStopThreadUnit.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form2"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit> + <Unit> + <Filename Value="..\..\..\CommonUtils\TimeIntervals.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="FastStopThreadLaz"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\..\..\CommonUtils"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpr b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpr new file mode 100644 index 0000000..1932407 --- /dev/null +++ b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpr @@ -0,0 +1,24 @@ +program FastStopThreadLaz; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, FastStopThreadUnit, TimeIntervals; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TForm2, Form2); + Application.Run; +end. + diff --git a/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.res b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.res new file mode 100644 index 0000000..bb86af9 Binary files /dev/null and b/ExSync/ExEvent/FastStopThread/FastStopThreadLaz.res differ diff --git a/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.dfm b/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.dfm index e9091a4..917aafc 100644 --- a/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.dfm +++ b/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.dfm @@ -2,8 +2,8 @@ object Form2: TForm2 Left = 0 Top = 0 Caption = #1044#1077#1084#1086#1085#1089#1090#1088#1072#1094#1080#1103' '#1088#1072#1073#1086#1090#1099' '#1089' '#1089#1086#1073#1099#1090#1080#1103#1084#1080 - ClientHeight = 321 - ClientWidth = 523 + ClientHeight = 351 + ClientWidth = 574 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -25,46 +25,54 @@ object Form2: TForm2 end object Label2: TLabel Left = 8 - Top = 255 + Top = 286 Width = 359 Height = 19 Caption = #1054#1089#1090#1072#1085#1086#1074' '#1087#1086#1090#1086#1082#1072' '#1080' '#1091#1085#1080#1095#1090#1086#1078#1077#1085#1080#1077' '#1086#1073#1098#1077#1082#1090#1072' '#1079#1072#1085#1103#1083#1086':' end object labFreeThreadTime: TLabel Left = 376 - Top = 255 + Top = 286 Width = 24 Height = 19 Caption = '???' end object Label3: TLabel Left = 8 - Top = 224 + Top = 255 Width = 239 Height = 19 Caption = #1042#1099#1079#1086#1074#1086#1074' '#1084#1077#1090#1086#1076#1072' DoUsefullWork:' end object labUseFullCalls: TLabel Left = 256 - Top = 224 + Top = 255 Width = 9 Height = 19 Caption = '0' end object Label4: TLabel Left = 8 - Top = 284 + Top = 315 Width = 342 Height = 19 Caption = #1042#1086#1079#1086#1073#1085#1086#1074#1083#1077#1085#1080#1077' '#1087#1086#1090#1086#1082#1072' '#1087#1086#1089#1083#1077' SetEvent '#1079#1072#1085#1103#1083#1086':' end object labResumeThreadAfterSetEvent: TLabel Left = 376 - Top = 284 + Top = 315 Width = 24 Height = 19 Caption = '???' end + object labMsgFromThread: TLabel + Left = 72 + Top = 120 + Width = 24 + Height = 19 + Caption = '???' + Visible = False + end object btnRunThread: TButton Left = 72 Top = 80 @@ -76,7 +84,7 @@ object Form2: TForm2 end object btnStopThread: TButton Left = 72 - Top = 167 + Top = 198 Width = 289 Height = 33 Caption = #1054#1089#1090#1072#1085#1086#1074#1080#1090#1100' '#1087#1086#1090#1086#1082 @@ -86,7 +94,7 @@ object Form2: TForm2 end object btnWakeUp: TButton Left = 72 - Top = 121 + Top = 152 Width = 289 Height = 33 Caption = #1056#1072#1079#1073#1091#1076#1080#1090#1100' '#1087#1086#1090#1086#1082 diff --git a/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.lfm b/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.lfm new file mode 100644 index 0000000..8efb8f5 --- /dev/null +++ b/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.lfm @@ -0,0 +1,123 @@ +object Form2: TForm2 + Left = 0 + Height = 351 + Top = 0 + Width = 574 + Caption = 'Демонстрация работы с событиями' + ClientHeight = 351 + ClientWidth = 574 + Color = clBtnFace + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Position = poScreenCenter + object Label1: TLabel + Left = 8 + Height = 57 + Top = 8 + Width = 425 + Caption = 'Пример демонстрирует организацию моментального'#13#10'завершения работы потока при использовании'#13#10'объекта синхронизации уровня ядра ОС: Event (событие)' + end + object Label2: TLabel + Left = 8 + Height = 19 + Top = 286 + Width = 359 + Caption = 'Останов потока и уничтожение объекта заняло:' + end + object labFreeThreadTime: TLabel + Left = 376 + Height = 19 + Top = 286 + Width = 24 + Caption = '???' + end + object Label3: TLabel + Left = 8 + Height = 19 + Top = 255 + Width = 239 + Caption = 'Вызовов метода DoUsefullWork:' + end + object labUseFullCalls: TLabel + Left = 256 + Height = 19 + Top = 255 + Width = 9 + Caption = '0' + end + object Label4: TLabel + Left = 8 + Height = 19 + Top = 315 + Width = 342 + Caption = 'Возобновление потока после SetEvent заняло:' + end + object labResumeThreadAfterSetEvent: TLabel + Left = 376 + Height = 19 + Top = 315 + Width = 24 + Caption = '???' + end + object labMsgFromThread: TLabel + Left = 72 + Height = 19 + Top = 120 + Width = 24 + Caption = '???' + Visible = False + end + object btnRunThread: TButton + Left = 72 + Height = 33 + Top = 80 + Width = 289 + Caption = 'Запустить поток' + TabOrder = 0 + OnClick = btnRunThreadClick + end + object btnStopThread: TButton + Left = 72 + Height = 33 + Top = 198 + Width = 289 + Caption = 'Остановить поток' + Enabled = False + TabOrder = 1 + OnClick = btnStopThreadClick + end + object btnWakeUp: TButton + Left = 72 + Height = 33 + Top = 152 + Width = 289 + Caption = 'Разбудить поток' + Enabled = False + TabOrder = 2 + OnClick = btnWakeUpClick + end + object cbUseProgressViewer: TCheckBox + Left = 376 + Height = 23 + Top = 88 + Width = 118 + Caption = 'Визуализация' + Font.CharSet = RUSSIAN_CHARSET + Font.Color = clBlack + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Pitch = fpVariable + Font.Quality = fqDraft + Font.Style = [fsStrikeOut] + ParentFont = False + TabOrder = 3 + Visible = False + end + object Timer1: TTimer + Interval = 333 + OnTimer = Timer1Timer + Left = 24 + Top = 80 + end +end diff --git a/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.pas b/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.pas index 8c6795e..011c4d7 100644 --- a/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.pas +++ b/ExSync/ExEvent/FastStopThread/FastStopThreadUnit.pas @@ -1,10 +1,16 @@ -unit FastStopThreadUnit; +{$IFDEF FPC}{$CODEPAGE UTF8}{$H+}{$MODE DELPHI}{$ENDIF} +unit FastStopThreadUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, SyncObjs, StdCtrls, TimeIntervals, ProgressViewer, ExtCtrls; + {$IFnDEF FPC} + Windows, Messages, ProgressViewer, + {$ELSE} + LCLIntf, LCLType, LMessages, + {$ENDIF} + SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, SyncObjs, StdCtrls, TimeIntervals, + ExtCtrls; type TMyThread = class(TThread) @@ -12,7 +18,10 @@ type Event: TEvent; FUseProgressViewer: Boolean; FUseFullCalls: Integer; + FGuiMsg: string; procedure DoUsefullWork; + procedure ShowMsg(Msg: string); + procedure UpdateGui; protected procedure Execute; override; public @@ -35,6 +44,7 @@ type labUseFullCalls: TLabel; Label4: TLabel; labResumeThreadAfterSetEvent: TLabel; + labMsgFromThread: TLabel; procedure btnRunThreadClick(Sender: TObject); procedure btnStopThreadClick(Sender: TObject); procedure btnWakeUpClick(Sender: TObject); @@ -53,7 +63,11 @@ var implementation -{$R *.dfm} +{$IFnDEF FPC} + {$R *.dfm} +{$ELSE} + {$R *.lfm} +{$ENDIF} { TMyThread } @@ -88,23 +102,36 @@ end; procedure TMyThread.Execute; var WaitRes: TWaitResult; + {$IFnDEF FPC} pv: TProgressViewer; + {$ENDIF} begin + {$IFnDEF FPC} pv := nil; // Чтобы компилятор не выдавал Warning + {$ENDIF} + while not Terminated do begin + ShowMsg('Ожидание события...'); + // Внимание! Визуализация ожидания события вносит значительные накладные // расходы и значительно увеличивает время уничтожения потока! + {$IFnDEF FPC} if FUseProgressViewer then pv := TProgressViewer.Create('Ожидание события'); + {$ENDIF} WaitRes := Event.WaitFor(5 * 1000); // Ожидание события - 5 секунд if WaitRes = wrSignaled then tiSignalled.Stop; // Останавливаем измерение времени + ShowMsg(''); + + {$IFnDEF FPC} if FUseProgressViewer then pv.TerminateProgress; + {$ENDIF} // Выполняем полезную работу если окончился таймаут ожидания (wrTimeout), // либо если произошёл вызов метода WakeUp @@ -113,6 +140,18 @@ begin end; end; +procedure TMyThread.ShowMsg(Msg: string); +begin + FGuiMsg := Msg; + TThread.Synchronize(nil, UpdateGui); +end; + +procedure TMyThread.UpdateGui; +begin + Form2.labMsgFromThread.Visible := FGuiMsg <> ''; + Form2.labMsgFromThread.Caption := FGuiMsg; +end; + procedure TMyThread.WakeUp; begin tiSignalled.Start;