2021年12月3日 星期五

MyThread = Class(TThread)

 https://wiert.me/2020/01/01/delphi-multi-threading-confused-by-tthread-synchronize-tthread-queue-youre-not-alone/

 delphi TThread Synchronization OnExecute TMutexAcquire TCriticalSection TMutex TSpinlock TMonitor

Type
 MyThread = Class(TThread)
  private
    …
  protected
    ...
 end;


----------
procedure TMyThread.DoProgress;
////
procedure TMyThread.Execute;
const
Interval = 1000000;
begin
FreeOnTerminate := True;
FProgressBar.Max := FCountTo div Interval;
FProgressBar.Step := FProgressBar.Max;
while FCounter < FCountTo do
begin
if FCounter mod Interval = 0 then Synchronize(DoProgress) ;


----------
Type
 MyThread = Class(TThread)
  private
   procedure doProgress;
  end;
 
Implementation
 
procedure doProgress;
begin
  Form1.ProgressBar1.Progress;
end;

----------
var
 T : MyThread;
begin
 T := MyThread.Create(True);
 T.FreeOnTerminate := True;
 T.Resume;
end;
----------
type
 MyThread = Class(TThread)
  private
   ...  
  protected
   procedure Execute; override;
  end;
 
var
 
implementation
 
procedure MyThread.Execute;
begin
 
end;
----------
procedure MyThread.Execute;
begin
 Synchronize(doProgress);
end;

----------
MyThread.Suspend;
...
MyThread.Resume;


----------

var
 isSuspended : Boolean;
begin
 isSuspended := MyThread.Suspended;
end;
----------
var
 MyThreadID : Cardinal;
begin
 MyThreadID := MyThread.ThreadID;
end;
----------
MyThread.Terminate;
----------
procedure MyThread.Execute;
begin
 Synchronize(doProgress);
 …
 MyThread.Terminate;
 Exit;
end;

procedure MyThread.Execute;
begin
 if MyThread.Terminated then
    Exit;
 …
 if MyThread.Terminated then
    Exit;
 …
 MyThread.Terminate;
 Exit;
end;

procedure MyThread.Execute;
begin
 if MyThread.Terminated then
    Exit;
 …
 if MyThread.Terminated then
    Exit;
 …
 MyThread.Terminate;
 MyThread.WaiteFor;
 Exit;
end;


----------
{ Important: Methods and properties of objects in VCL or CLX can only be used
  in a method called using Synchronize, for example,
 
      Synchronize(UpdateCaption);
 
  and UpdateCaption could look like,
 
    procedure myTred.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }
---------------

const
  TM_MYTHREAD_MSG = WM_USER + 200;
  TM_MYTHREAD_START = TM_MYTHREAD_MSG + 1;
  TM_MYTHREAD_PROGRESS = TM_MYTHREAD_MSG +2;
  TM_MYTHREAD_DONE =  TM_MYTHREAD_MSG +3;
/////
PostMessage(FormHandle, TM_MYTHREAD_MSG, TM_MYTHREAD_START,0);
//////
TMyForm = class(TForm)
...
protected
  procedure TmMyThreadMsg(var Msg: TMessage); message TM_MYTHREAD_MSG;
...
end;
 
////////
 
 procedure TMyForm.TmMyThreadMsg(var Msg: TMessage);
begin
  case Msg.LParam of
    TM_MYTHREAD_START : Progressbar1.Position := 0;
    TM_MYTHREAD_PROGRESS : Progressbar1.Position := Progressbar1.Position + 1;
    TM_MYTHREAD_DONE : Progressbar1.Position := Progressbar1.Max;
  end;
end;

---------------
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
  public
  end;
  Type
 MyThread = Class(TThread)
  private
  protected
   procedure Execute; override;
 end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
////
procedure MyThread.Execute;
begin
form1.Caption:=form1.Caption+'1';
end;
////
procedure TForm1.FormCreate(Sender: TObject);
var
 T : MyThread;
begin
 T := MyThread.Create(True);
 T.FreeOnTerminate := true;
 T.Resume;
end;
end.
---------------
 

沒有留言: