books/multithread
1
0
Fork 0
mirror of https://github.com/loginov-dmitry/multithread.git synced 2024-11-28 09:33:03 +02:00
Code Issues Releases Activity

Ex FastStopThread converted to Lazarus

Browse Source
This commit is contained in:
loginov-dmitry 2024-10-13 22:34:02 +03:00
parent 4aa4cad0fe
commit c6251d64b2
8 changed files with 295 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

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

BIN
ExSync/ExEvent/FastStopThread/FastStopThreadLaz.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 130 KiB

85
ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpi Normal file
View File

@ -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>

24
ExSync/ExEvent/FastStopThread/FastStopThreadLaz.lpr Normal file
View File

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

BIN
ExSync/ExEvent/FastStopThread/FastStopThreadLaz.res Normal file
View File

Binary file not shown.

28
ExSync/ExEvent/FastStopThread/FastStopThreadUnit.dfm
View File

@ -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

123
ExSync/ExEvent/FastStopThread/FastStopThreadUnit.lfm Normal file
View File

@ -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

47
ExSync/ExEvent/FastStopThread/FastStopThreadUnit.pas
View File

@ -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;