mirror of
https://github.com/loginov-dmitry/multithread.git
synced 2024-11-24 08:52:15 +02:00
Ex5 converted to Lazarus
This commit is contained in:
parent
e8c551a597
commit
4d94e35cba
2
.gitignore
vendored
2
.gitignore
vendored
@ -15,3 +15,5 @@ __history
|
||||
/Ex3/lib
|
||||
/Ex4/backup
|
||||
/Ex4/lib
|
||||
/Ex5/backup
|
||||
/Ex5/lib
|
||||
|
@ -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}
|
||||
|
||||
|
@ -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>
|
||||
|
BIN
Ex5/Ex5Proj.res
BIN
Ex5/Ex5Proj.res
Binary file not shown.
BIN
Ex5/Ex5ProjLaz.ico
Normal file
BIN
Ex5/Ex5ProjLaz.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 130 KiB |
91
Ex5/Ex5ProjLaz.lpi
Normal file
91
Ex5/Ex5ProjLaz.lpi
Normal 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
25
Ex5/Ex5ProjLaz.lpr
Normal 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
BIN
Ex5/Ex5ProjLaz.res
Normal file
Binary file not shown.
@ -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
48
Ex5/Ex5Unit.lfm
Normal 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
|
@ -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
|
||||
|
||||
{$R *.dfm}
|
||||
{$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;}
|
||||
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 }
|
||||
|
Loading…
Reference in New Issue
Block a user