mirror of
https://github.com/loginov-dmitry/multithread.git
synced 2024-11-28 09:33:03 +02:00
Добавлен пример Ex9 (демонстрация передачи данных в основной поток с использованием функции SendMessage)
This commit is contained in:
loginov-dmitry
parent
970bf50126
commit
271b6a0790
16
Ex9/Ex9Proj.dpr
Normal file
16
Ex9/Ex9Proj.dpr
Normal file
@ -0,0 +1,16 @@
|
||||
program Ex9Proj;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
Ex9Unit in 'Ex9Unit.pas' {Form1},
|
||||
MTUtils in '..\CommonUtils\MTUtils.pas',
|
||||
TimeIntervals in '..\CommonUtils\TimeIntervals.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
73
Ex9/Ex9Proj.dproj
Normal file
73
Ex9/Ex9Proj.dproj
Normal file
@ -0,0 +1,73 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{e61f19e4-8d17-47fe-b58d-3316554ace6a}</ProjectGuid>
|
||||
<MainSource>Ex9Proj.dpr</MainSource>
|
||||
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
|
||||
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||
<DCC_DependencyCheckOutputName>Ex9Proj.exe</DCC_DependencyCheckOutputName>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
|
||||
<Version>7.0</Version>
|
||||
<DCC_DebugInformation>False</DCC_DebugInformation>
|
||||
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_Define>RELEASE</DCC_Define>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
|
||||
<Version>7.0</Version>
|
||||
<DCC_Define>DEBUG</DCC_Define>
|
||||
</PropertyGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality</Borland.Personality>
|
||||
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<BorlandProject xmlns=""> <Delphi.Personality> <Parameters>
|
||||
<Parameters Name="UseLauncher">False</Parameters>
|
||||
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||
</Parameters>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||
<VersionInfo Name="Release">0</VersionInfo>
|
||||
<VersionInfo Name="Build">0</VersionInfo>
|
||||
<VersionInfo Name="Debug">False</VersionInfo>
|
||||
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||
<VersionInfo Name="Special">False</VersionInfo>
|
||||
<VersionInfo Name="Private">False</VersionInfo>
|
||||
<VersionInfo Name="DLL">False</VersionInfo>
|
||||
<VersionInfo Name="Locale">1049</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1251</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
|
||||
</VersionInfoKeys>
|
||||
<Source>
|
||||
<Source Name="MainSource">Ex9Proj.dpr</Source>
|
||||
</Source>
|
||||
</Delphi.Personality> </BorlandProject></BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="Ex9Proj.dpr">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="..\CommonUtils\MTUtils.pas" />
|
||||
<DCCReference Include="..\CommonUtils\TimeIntervals.pas" />
|
||||
<DCCReference Include="Ex9Unit.pas">
|
||||
<Form>Form1</Form>
|
||||
</DCCReference>
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
BIN
Ex9/Ex9Proj.res
Normal file
BIN
Ex9/Ex9Proj.res
Normal file
Binary file not shown.
73
Ex9/Ex9Unit.dfm
Normal file
73
Ex9/Ex9Unit.dfm
Normal file
@ -0,0 +1,73 @@
|
||||
object Form1: TForm1
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 127
|
||||
ClientWidth = 452
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -13
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnDestroy = FormDestroy
|
||||
DesignSize = (
|
||||
452
|
||||
127)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 16
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Top = 72
|
||||
Width = 64
|
||||
Height = 16
|
||||
Caption = #1056#1077#1079#1091#1083#1100#1090#1072#1090':'
|
||||
end
|
||||
object labResult: TLabel
|
||||
Left = 78
|
||||
Top = 72
|
||||
Width = 7
|
||||
Height = 16
|
||||
Caption = '0'
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 8
|
||||
Top = 96
|
||||
Width = 119
|
||||
Height = 16
|
||||
Caption = #1057#1090#1072#1090#1091#1089' '#1074#1099#1095#1080#1089#1083#1077#1085#1080#1081':'
|
||||
end
|
||||
object labThreadStateInfo: TLabel
|
||||
Left = 132
|
||||
Top = 97
|
||||
Width = 18
|
||||
Height = 16
|
||||
Caption = '???'
|
||||
end
|
||||
object btnRunInParallelThread: TButton
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 217
|
||||
Height = 33
|
||||
Caption = #1042#1099#1095#1080#1089#1083#1080#1090#1100' '#1089#1091#1084#1084#1091' '#1088#1103#1076#1072' '#1095#1080#1089#1077#1083' '#1076#1086':'
|
||||
TabOrder = 0
|
||||
OnClick = btnRunInParallelThreadClick
|
||||
end
|
||||
object ProgressBar1: TProgressBar
|
||||
Left = 8
|
||||
Top = 49
|
||||
Width = 436
|
||||
Height = 17
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
TabOrder = 1
|
||||
end
|
||||
object edMaxValue: TEdit
|
||||
Left = 232
|
||||
Top = 16
|
||||
Width = 89
|
||||
Height = 24
|
||||
TabOrder = 2
|
||||
Text = '10000000'
|
||||
end
|
||||
end
|
||||
136
Ex9/Ex9Unit.pas
Normal file
136
Ex9/Ex9Unit.pas
Normal file
@ -0,0 +1,136 @@
|
||||
unit Ex9Unit;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, MTUtils, ComCtrls;
|
||||
|
||||
const
|
||||
UM_PROGRESS_INIT = WM_USER + 1;
|
||||
UM_PROGRESS_CHANGE = WM_USER + 2;
|
||||
|
||||
type
|
||||
TProgressData = class
|
||||
CurrValue: Integer;
|
||||
CalcResult: Int64;
|
||||
ThreadStateInfo: string;
|
||||
end;
|
||||
|
||||
TMyThread = class(TThread)
|
||||
private
|
||||
ProgressData: TProgressData;
|
||||
FFormHandle: THandle;
|
||||
FMaxValue: Integer;
|
||||
public
|
||||
procedure Execute; override;
|
||||
constructor Create(AMaxValue: Integer; AFormHandle: THandle);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TForm1 = class(TForm)
|
||||
btnRunInParallelThread: TButton;
|
||||
ProgressBar1: TProgressBar;
|
||||
Label1: TLabel;
|
||||
labResult: TLabel;
|
||||
edMaxValue: TEdit;
|
||||
Label2: TLabel;
|
||||
labThreadStateInfo: TLabel;
|
||||
procedure btnRunInParallelThreadClick(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
FMyThread: TMyThread;
|
||||
procedure UMProgressInit(var Msg: TMessage); message UM_PROGRESS_INIT;
|
||||
procedure UMProgressChange(var Msg: TMessage); message UM_PROGRESS_CHANGE;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure TForm1.btnRunInParallelThreadClick(Sender: TObject);
|
||||
begin
|
||||
// Уничтожаем запущенный поток
|
||||
if Assigned(FMyThread) then
|
||||
FreeAndNil(FMyThread);
|
||||
|
||||
// Создаём и запускаем новый поток
|
||||
FMyThread := TMyThread.Create(StrToInt(edMaxValue.Text), Handle);
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FMyThread.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.UMProgressChange(var Msg: TMessage);
|
||||
var
|
||||
ProgressData: TProgressData;
|
||||
begin
|
||||
ProgressData := TProgressData(Msg.WParam);
|
||||
ProgressBar1.Position := ProgressData.CurrValue;
|
||||
labResult.Caption := IntToStr(ProgressData.CalcResult);
|
||||
labThreadStateInfo.Caption := ProgressData.ThreadStateInfo;
|
||||
end;
|
||||
|
||||
procedure TForm1.UMProgressInit(var Msg: TMessage);
|
||||
var
|
||||
MaxValue: Integer;
|
||||
begin
|
||||
MaxValue := Msg.WParam;
|
||||
ProgressBar1.Max := MaxValue;
|
||||
ProgressBar1.Position := 0;
|
||||
labResult.Caption := '0';
|
||||
labThreadStateInfo.Caption := 'Start';
|
||||
end;
|
||||
|
||||
{ TMyThread }
|
||||
|
||||
constructor TMyThread.Create(AMaxValue: Integer; AFormHandle: THandle);
|
||||
begin
|
||||
inherited Create(False);
|
||||
FMaxValue := AMaxValue;
|
||||
FFormHandle := AFormHandle;
|
||||
ProgressData := TProgressData.Create;
|
||||
end;
|
||||
|
||||
destructor TMyThread.Destroy;
|
||||
begin
|
||||
//ProgressData.Free; - НЕЛЬЗЯ ТУТ!
|
||||
inherited;
|
||||
ProgressData.Free;
|
||||
end;
|
||||
|
||||
procedure TMyThread.Execute;
|
||||
var
|
||||
CurrVal: Integer;
|
||||
begin
|
||||
// Выставляем параметры компонента ProgressBar1
|
||||
SendMessage(FFormHandle, UM_PROGRESS_INIT, FMaxValue, 0);
|
||||
ThreadWaitTimeout(Self, 1000); // Просто пауза 1 сек.
|
||||
CurrVal := 0;
|
||||
// Выполняем некоторые вычисления
|
||||
while CurrVal < FMaxValue do
|
||||
begin
|
||||
if Terminated then Break;
|
||||
Inc(CurrVal);
|
||||
ProgressData.CurrValue := CurrVal;
|
||||
ProgressData.CalcResult := ProgressData.CalcResult + CurrVal;
|
||||
ProgressData.ThreadStateInfo := Format('Progress: %f%%',
|
||||
[CurrVal / FMaxValue * 100]);
|
||||
|
||||
// Обновление прогресса выполняется только 1 раз из 10000
|
||||
if CurrVal mod 10000 = 0 then
|
||||
SendMessage(FFormHandle, UM_PROGRESS_CHANGE, WPARAM(ProgressData), 0);
|
||||
end;
|
||||
|
||||
// Обновляем прогресс в конце вычислений
|
||||
SendMessage(FFormHandle, UM_PROGRESS_CHANGE, WPARAM(ProgressData), 0);
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user