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

大佬教程收集整理的这篇文章主要介绍了德尔福。如何从表单向线程发送消息并让线程处理消息，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。

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

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

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

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

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

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);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  if Assigned(MyProgressbarThread) then
    MyProgressbarThread.Terminate;
end;

end.

还有主题：-

unit uThread;

interface

uses
  Forms,ExtCtrls,ClipBrd,Contnrs,JPeg,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,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.

1. 这是适合我的情况的正确方法吗？如果没有，那么有什么例子吗？
2. 是PostThreadmessage(MyProgressbarThread.Handle,0);正确吗？
3. 如何监听线程中的消息并处理它们？

tia

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

unit uMain;

interface

uses
  windows,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,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,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.

解决方法

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;

大佬总结

以上是大佬教程为你收集整理的德尔福。如何从表单向线程发送消息并让线程处理消息全部内容，希望文章能够帮你解决德尔福。如何从表单向线程发送消息并让线程处理消息所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错，欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ：384754419，请注明来意。