德尔福。如何从表单向线程发送消息并让线程处理消息答案

【问题标题】：Delphi. How to Send a Thread a Message from a Form and for the Thread to Process the Message德尔福。如何从表单向线程发送消息并让线程处理消息
【发布时间】：2021-07-08 08:29:18
【问题描述】：

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

线程创建一个带有进度条的表单。

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

到目前为止，我有主表单：-

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

根据 cmets 09/07/2021 更新此代码是否正确且安全：- 主窗体

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.

进度条表单

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.

【问题讨论】：

您的表单和进度逻辑是颠倒的。您不需要将进度从表单发送到线程，您需要将进度从线程执行方法发送到表单。表单需要处理进度消息并设置进度条位置。从后台线程的上下文设置进度条位置不是线程安全的。您永远不应该从后台线程访问 UI 控件。我假设您正在后台线程中执行工作。如果您在主线程中工作，那么从线程更新进度也是错误的方法。
@Dalija Prasnikar。谢谢回复。主窗体执行工作。线程显示进度。即使使用 Application.ProcessMessages、Progress.Repaint 等，从主窗体显示另一个标准窗体并带有进度条来显示位置并不总是有效。关于我想要实现的任何示例？谢谢。
将冗长的任务从主线程移到辅助线程。并从辅助线程到主线程使用PostMessage 来更新UI。
如果你在主线程中工作，你将无法使用线程更新进度。主要问题是 UI 控件必须从主线程使用，而当主线程工作时，它不能做任何其他事情。这是 Application.ProcessMessages 介入并允许处理 Windows 消息的地方，因此您可以更新 UI - 包括进度条。但这是一个糟糕的解决方案。只有正确的解决方案是将工作转移到后台线程。根据您实际所做的（工作）Application.ProcessMessages 可能会被修补，但这种方法总是会遇到一些问题。
如果你将工作移到后台线程中，你仍然有可重用性，因为你的进度表并不关心你在线程中做什么样的工作。你不会失去任何东西。

标签： multithreading delphi

【解决方案1】：

如果您要使用其他组件：我建议您查看 Omni 线程库。

http://www.omnithreadlibrary.com/book/chap10.html#leanpub-auto-sending-data-from-a-worker-to-a-form 当前版本中的 7.13.2 示例（将数据从工作人员发送到表单）

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

我几乎每次都使用 3.2 Blocking 集合（在文本中有一个演示源的链接）它不是你特别想要的，但两者的结合应该是强大的多线程工作负载链。

【讨论】：

【解决方案2】：

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/

【讨论】：