德尔福.如何向线程发送来自窗体的消息以及线程如何处理消息

我有一个创建线程的主窗体。

线程创建一个带有进度条的窗体。

我想做的是从主窗体创建线程，并向线程发送一条消息，以增加线程窗体上的进度栏。这将允许我执行代码并向用户提供进度。

到目前为止，我有主要的形式：-

unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, contnrs,
StdCtrls, uThread, ExtCtrls;
type
TMainForm = class(TForm)
btnCreateForm: TButton;
btnSendMessage: TButton;
procedure btnCreateFormClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnSendMessageClick(Sender: TObject);
private
{ Private declarations }
MyProgressBarThread: TProgressBarThread;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.btnCreateFormClick(Sender: TObject);
begin
MyProgressBarThread := TProgressBarThread.Create(Self);
end;
procedure TMainForm.btnSendMessageClick(Sender: TObject);
begin
// Is this correct way to send a message to the Thread?
PostThreadMessage(MyProgressBarThread.Handle, WM_USER, 0, 0);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if Assigned(MyProgressBarThread) then
MyProgressBarThread.Terminate;
end;
end.

和线程：-

unit uThread;
interface
uses
Forms, StdCtrls, Graphics, ExtCtrls, ClipBrd, Contnrs, JPeg, SysUtils,
ComCtrls, System.Classes{taRightJustify}, Winapi.Messages, Winapi.Windows;
type
TProgressBarThread = class(TThread)
private
{ Private declarations }
FForm: TForm;
FUse_Progress_Position_Label: Boolean;
lbProcessing_Name: TLabel;
lbProcessing_Description: TLabel;
lbProcessing_Position_Number: TLabel;
ProgressBar1: TProgressBar;
procedure OnCloseForm(Sender: TObject; var Action: TCloseAction);
procedure OnDestroyForm(Sender: TObject);
protected
procedure Execute; override;
public
constructor Create(AForm: TForm);
end;
implementation
{ TProgressBarThread }
constructor TProgressBarThread.Create(AForm: TForm);
begin
FForm := TForm.Create(nil);
lbProcessing_Name := TLabel.Create(FForm);
ProgressBar1 := TProgressBar.Create(FForm);
lbProcessing_Description := TLabel.Create(FForm);
lbProcessing_Position_Number := TLabel.Create(FForm);
with FForm do
begin
Caption := 'Please Wait...';
Left := 277;
Top := 296;
BorderIcons := [biSystemMenu];
BorderStyle := bsSingle;
ClientHeight := 80;
ClientWidth := 476;
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
FormStyle := fsStayOnTop;
OldCreateOrder := False;
Position := poMainFormCenter;
PixelsPerInch := 96;
OnClose := OnCloseForm;
OnDestroy := OnDestroyForm;
with lbProcessing_Name do
begin
Parent := FForm;
Left := 16;
Top := 24;
Width := 130;
Height := 13;
Caption := 'Processing Request... ';
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [fsBold];
ParentFont := False;
end;
with lbProcessing_Description do
begin
Parent := FForm;
Left := 160;
Top := 24;
Width := 3;
Height := 13;
Font.Color := clBlue;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
ParentFont := False;
end;
with lbProcessing_Position_Number do
begin
Parent := FForm;
Left := 456;
Top := 24;
Width := 6;
Height := 13;
Alignment := taRightJustify;
Caption := '0';
Visible := False;
Font.Color := clBlue;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
end;
with ProgressBar1 do
begin
Parent := FForm;
Left := 16;
Top := 48;
Width := 449;
Height := 17;
TabOrder := 0;
end;
end;
FForm.Show;
inherited Create(False);
end;
procedure TProgressBarThread.Execute;
var
Msg: TMsg;
begin
FreeOnTerminate := True;
// Is this the correct way to Look for Messages sent to the Thread and to handle them?
while not (Terminated or Application.Terminated) do
begin
if PeekMessage(&Msg, 0, 0, 0, PM_NOREMOVE) then
begin
if Msg.message > 0 then
ProgressBar1.Position := ProgressBar1.Position + 1;
end;
end;
end;
procedure TProgressBarThread.OnCloseForm(Sender: TObject; var Action: TCloseAction);
begin
Terminate;
//  WaitFor;
end;
procedure TProgressBarThread.OnDestroyForm(Sender: TObject);
begin
if not Terminated then
begin
Terminate;
WaitFor;
end;
end;
end.

对于我的情况，这是正确的方法吗？如果没有，那么有什么例子吗
是PostThreadMessage(MyProgressBarThread.Handle，WM_USER，0，0(；对吗
如何在线程中侦听消息并进行处理

tia

根据意见更新，2021年7月9日此代码是否正确且安全：-主窗体

unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, contnrs,
StdCtrls, uThread, ExtCtrls;
type
TMainForm = class(TForm)
btnStart_Process: TButton;
procedure btnStart_ProcessClick(Sender: TObject);
private
{ Private declarations }
Start_ProcessThread: TStart_ProcessThread;
procedure TheCallback(const ProgressBarPosition: Integer);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
hLogWnd: HWND = 0;
implementation
uses
uProgressBar;
{$R *.DFM}
procedure TMainForm.btnStart_ProcessClick(Sender: TObject);
begin
frmProgressBar.ProgressBar1.Max := Con_Max_ProgressBarPosition;
frmProgressBar.ProgressBar1.Position := 0;
frmProgressBar.Show;
Start_ProcessThread := TStart_ProcessThread.Create(TheCallback);
end;
procedure TMainForm.TheCallback(const ProgressBarPosition: Integer);
begin
if ProgressBarPosition <> Con_Finished_Processing then
frmProgressBar.ProgressBar1.Position := ProgressBarPosition
else
frmProgressBar.Close;
end;
end.

ProgressBarForm

unit uProgressBar;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls;
type
TfrmProgressBar = class(TForm)
ProgressBar1: TProgressBar;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmProgressBar: TfrmProgressBar;
implementation
{$R *.dfm}
end.

线程

unit uThread;
interface
uses
Forms, StdCtrls, Graphics, ExtCtrls, ClipBrd, Contnrs, JPeg, SysUtils,
ComCtrls, System.Classes{taRightJustify}, Winapi.Messages, Winapi.Windows;
const
Con_Finished_Processing = -1;
Con_Max_ProgressBarPosition = 1024 * 65536;
type
TMyCallback = procedure(const ProgressBarPosition: Integer) of object;
TStart_ProcessThread = class(TThread)
private
FCallback : TMyCallback;
procedure Execute; override;
procedure SendLog(I: Integer);
public
constructor Create(aCallback : TMyCallback);
end;
implementation
{ TStart_ProcessThread }
constructor TStart_ProcessThread.Create(aCallback: TMyCallback);
begin
inherited Create(false);
FCallback := aCallback;
end;
procedure TStart_ProcessThread.SendLog(I: Integer);
begin
if not Assigned(FCallback) then
Exit;
Self.Queue(  // Executed later in the main thread
procedure
begin
FCallback(I{ThePosition});
end
);
end;
procedure TStart_ProcessThread.Execute;
var
I: Integer;
begin
// Do the Work Load here:-
for I := 0 to Con_Max_ProgressBarPosition do
begin
if ((I mod 65536) = 0) then
begin
// Send back the progress of the work here:-
SendLog(I);
Sleep(10);
end;
end;
// Finished
SendLog(Con_Finished_Processing);
end;
end.

如果你想要更多的组件：我建议你看看Omni线程库。

http://www.omnithreadlibrary.com/book/chap10.html#leanpub-自动感应-数据从一个工人到另一个工人7.13.2当前版本中的示例(从工作人员向表单发送数据(

它是一个很棒的库，上面链接中的免费书籍是许多多线程场景的良好来源。

我几乎每次都使用3.2 Blocking集合(文本中有一个指向演示源的链接(。这并不是你想要的，但两者的结合应该是强大的，可以创建多线程工作负载链。

kbmMW包含一个名为SmartEvent的功能，我建议您查看该功能。它在这样的场景中非常有效，您希望代码的不同部分(线程化或非线程化(相互通信并传输数据。

它的工作原理很简单：

TForm1 = class(...)
...
private
procedure FormCreate(Sender: TObject);
public
[kbmMW_Event('UPDATESTATUS',[mweoSync])]
procedure UpdateStatus(const APct:integer);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Event.Subscribe(self);
end;
procedure TForm1.UpdateStatus(const APct:integer);
begin
Label1.Caption:='Pct='+inttostr(APct);
end;

然后在你的线程中做：

procedure TYourThread.Execute;
begin
...
Event.Notify('UPDATESTATUS',pct);
...
end;

所有线程同步等都将自动为您处理。你甚至可以打电话，期待数据的回复，而且你的通知可以有任何数量的订阅者。

kbmMW是一个完全支持Delphi和所有平台的工具箱。

您可以在此处阅读有关SmartEvent的更多信息：https://components4developers.blog/2019/11/11/smartevent-with-kbmmw-1/

相关内容

最新更新

热门标签：