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

Ex5 converted to Lazarus

This commit is contained in:
loginov-dmitry 2024-10-12 23:31:06 +03:00
parent e8c551a597
commit 4d94e35cba
11 changed files with 222 additions and 8 deletions

2
.gitignore vendored
View File

@ -15,3 +15,5 @@ __history
/Ex3/lib
/Ex4/backup
/Ex4/lib
/Ex5/backup
/Ex5/lib

View File

@ -5,7 +5,10 @@ uses
Ex5Unit in 'Ex5Unit.pas' {Form1},
MTUtils in '..\CommonUtils\MTUtils.pas',
TimeIntervals in '..\CommonUtils\TimeIntervals.pas',
ProgressViewer in '..\CommonUtils\ProgressViewer.pas';
ProgressViewer in '..\CommonUtils\ProgressViewer.pas',
LDSWaitFrm in '..\ExWaitWindow\LDSWaitFrm.pas' {LDSWaitForm},
LDSWaitIntf in '..\ExWaitWindow\LDSWaitIntf.pas',
ParamsUtils in '..\CommonUtils\ParamsUtils.pas';
{$R *.res}

View File

@ -1,4 +1,5 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<?xml version="1.0" encoding="utf-8"?>
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{5a439af1-90ce-4391-8632-091e44023bf2}</ProjectGuid>
<MainSource>Ex5Proj.dpr</MainSource>
@ -30,8 +31,13 @@
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\CommonUtils\MTUtils.pas" />
<DCCReference Include="..\CommonUtils\ParamsUtils.pas" />
<DCCReference Include="..\CommonUtils\ProgressViewer.pas" />
<DCCReference Include="..\CommonUtils\TimeIntervals.pas" />
<DCCReference Include="..\ExWaitWindow\LDSWaitFrm.pas">
<Form>LDSWaitForm</Form>
</DCCReference>
<DCCReference Include="..\ExWaitWindow\LDSWaitIntf.pas" />
<DCCReference Include="Ex5Unit.pas">
<Form>Form1</Form>
</DCCReference>

Binary file not shown.

BIN
Ex5/Ex5ProjLaz.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 130 KiB

91
Ex5/Ex5ProjLaz.lpi Normal file
View File

@ -0,0 +1,91 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="Ex5ProjLaz"/>
<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="Ex5ProjLaz.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="Ex5Unit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
<Unit>
<Filename Value="..\CommonUtils\ParamsUtils.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="..\ExWaitWindow\LDSWaitFrm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="LDSWaitForm"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="Ex5ProjLaz"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\CommonUtils;..\ExWaitWindow"/>
<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>

25
Ex5/Ex5ProjLaz.lpr Normal file
View File

@ -0,0 +1,25 @@
program Ex5ProjLaz;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Ex5Unit, ParamsUtils, LDSWaitFrm
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
Ex5/Ex5ProjLaz.res Normal file

Binary file not shown.

View File

@ -11,6 +11,7 @@ object Form1: TForm1
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96

48
Ex5/Ex5Unit.lfm Normal file
View File

@ -0,0 +1,48 @@
object Form1: TForm1
Left = 0
Height = 127
Top = 0
Width = 251
Caption = 'Form1'
ClientHeight = 127
ClientWidth = 251
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poScreenCenter
object Label1: TLabel
Left = 16
Height = 16
Top = 48
Width = 218
Caption = 'Режим завершения работы потоков:'
end
object btnRunParallelThreads: TButton
Left = 8
Height = 33
Top = 8
Width = 235
Caption = 'Запустить параллельные потоки'
TabOrder = 0
OnClick = btnRunParallelThreadsClick
end
object cbTerminateMode: TComboBox
Left = 24
Height = 24
Top = 72
Width = 210
ItemHeight = 16
ItemIndex = 0
Items.Strings = (
'Последовательно (медленно)'
'Одновременно (быстрее)'
)
Style = csDropDownList
TabOrder = 1
Text = 'Последовательно (медленно)'
end
end

View File

@ -1,10 +1,16 @@
unit Ex5Unit;
{$IFDEF FPC}{$CODEPAGE UTF8}{$H+}{$MODE DELPHI}{$ENDIF}
unit Ex5Unit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ProgressViewer, Contnrs, MTUtils;
{$IFnDEF FPC}
Windows, Messages,
{$ELSE}
LCLIntf, LCLType, LMessages,
{$ENDIF}
SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Contnrs, MTUtils,
LDSWaitFrm, LDSWaitIntf, ParamsUtils;
type
TMyLongThread1 = class(TThread)
@ -40,9 +46,12 @@ type
procedure btnRunParallelThreadsClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FList: TObjectList; // Потоки для первой и второй задачи
function StopThreads(OperType: Integer; AParams: TParamsRec; AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
public
{ Public declarations }
end;
@ -52,7 +61,11 @@ var
implementation
{$IFnDEF FPC}
{$R *.dfm}
{$ELSE}
{$R *.lfm}
{$ENDIF}
procedure TForm1.btnRunParallelThreadsClick(Sender: TObject);
begin
@ -84,16 +97,25 @@ begin
Sleep(5000); // Оставлено для демонстрации режима "Одновременно"
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DoOperationInThread(Self, cbTerminateMode.ItemIndex, 'Выход из программы...', ParamsEmpty, StopThreads, NOT_SHOW_STOP_BTN);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FList := TObjectList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
{
var
AProgress: TProgressViewer;
I: Integer;
I: Integer;}
begin
{Пример использования TProgressViewer для визуализации.
Визуализация была переделана на вызов функции StopThreads через функцию DoOperationInThread
для совместимости в Лазарусом
AProgress := TProgressViewer.Create('Выход из программы');
try
if cbTerminateMode.ItemIndex = 1 then
@ -107,7 +129,23 @@ begin
FList.Free;
finally
AProgress.TerminateProgress;
end;}
end;
function TForm1.StopThreads(OperType: Integer; AParams: TParamsRec;
AResParams: PParamsRec; wsi: IWaitStatusInterface): Boolean;
var
I: Integer;
begin
if OperType = 1 then
begin // Выбран режим "Одновременно (быстрее)"
// Выставляем флаг Terminated для всех потоков. Можно использовать
// родительский класс TThread для операции приведения типов.
for I := 0 to FList.Count - 1 do
TThread(FList[I]).Terminate;
end;
// При уничтожении списка TObjectList будут уничтожены все объекты потоков
FList.Free;
end;
{ TMyLongThread2 }