Ex FastStopThread converted to Lazarus

.gitignore

@@ -40,3 +40,5 @@ __history
 /ExExceptions/lib
 /ExSync/ExEvent/SimpleLogger/lib
 /ExSync/ExEvent/SimpleLogger/backup
+/ExSync/ExEvent/FastStopThread/backup
+/ExSync/ExEvent/FastStopThread/lib

ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpi

@@ -0,0 +1,85 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="FastStopThreadLaz"/>
+      <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>

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.
+

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
+  ClientHeight = 351
-  ClientWidth = 523
+  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

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

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,
+  {$IFnDEF FPC}
-  Dialogs, SyncObjs, StdCtrls, TimeIntervals, ProgressViewer, ExtCtrls;
+    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;