TThreadYield (Delphi)

Description

This example shows how to use the Yield method, the Priority property and several others listed in the Uses clause. This example demonstrates how to use the Synchronize method to interact with VCL components in a process intensive, high priority situation. Warning: running at these high priorities demonstrates the effect of the Yield method, but also will lock out button clicks and other Windows processes.

To use the sample you need to add five TButtons on the form, four used to start and terminate two threads and one used to call Yield method. Also the sample uses two TMemo components to display the status of the threads and a TSpinEdit to set the amount of time to work fot every thread.

Code

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, DBXTransport;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    seTimeToWork: TSpinEdit;
    btnCreate: TButton;
    btnTerminate: TButton;
    btnyield: TButton;
    Memo2: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure btnCreateClick(Sender: TObject);
    procedure btnTerminateClick(Sender: TObject);
    procedure btnyieldClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    FThread: TThread;
    FThread1: TThread;
  end;

  TMyThread = class(TThread)
  private
    FTime: integer; //the amount of time to work for the thread.
  protected
    procedure Execute; override;
  public
    constructor Create(Time: integer);
    procedure OnTerminate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
// TMyThread

constructor TMyThread.Create(Time: integer);
begin
  FTime := Time;
  inherited Create(True);
end;

procedure TMyThread.Execute;
var
  T: integer;
  mysleep, supersleep: integer;
begin
  T := FTime;
  Synchronize(
    procedure
    begin
      Form1.Memo1.Lines.Add('Begin Execution');
    end);
  if IsSingleProcessor then
  begin
    Synchronize(
      procedure
      begin
        Form1.Memo1.Lines.Add('The system has one processor');
      end);
  end
  else
  begin
    Synchronize(
      procedure
      begin
        Form1.Memo1.Lines.Add('The system has ' + IntToStr(ProcessorCount) + ' processors');
      end);
  end;
  repeat
    mysleep := 100000000; // You may have to adjust this depending on the speed of your processor.
    Synchronize(
      procedure
      begin
        Form1.Memo2.Lines.Add(format('Thread '+IntToStr(ThreadID) + ':  %5.2f%%', [100 - T / FTime * 100]));
      end);
    while (mysleep > 0) do // use a process intensive loop here.  We are trying to block.
    begin
      supersleep := mysleep*mysleep;
      mysleep := mysleep - 1;
    end;
    dec(T, 500);
  until Terminated or (T < 0);
  if Terminated then
  begin
    Synchronize(
      procedure
      begin
        Form1.Memo1.Lines.Add('Terminated by user');
      end);
  end;
  Synchronize(
    procedure
    begin
      Form1.Memo1.Lines.Add('Finish execution');
    end);
  Synchronize(
    procedure
    begin
      Form1.Memo2.Lines.Add('Terminated by user');
    end);
  Synchronize(
    procedure
    begin
      Form1.Memo2.Lines.Add('Finish execution');
    end);
end;

procedure TMyThread.OnTerminate(Sender: TObject);
begin
  FreeAndNil(Self)
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.seTimeToWork.Value := 30000;
end;
//thread1
procedure TForm1.btnCreateClick(Sender: TObject);
begin
  FThread := TMyThread.Create(seTimeToWork.Value); // This TSpinEdit is initialized to 30000, 
                                                   // but you can change it before starting the thread.
  FThread.Priority := tpHigher;
  FThread.FreeOnTerminate := False;  // Free FThread in the OnTerminate proc. This will set Terminated to true.
  FThread.Start;
end;

//thread1
procedure TForm1.btnTerminateClick(Sender: TObject);
begin
  if FThread <> nil then
    FThread.Terminate   // Calling Free on a TThread will set Terminated := True
                  // and then block until the thread terminates.
  else
    Form1.Memo1.Lines.Add('Thread does not exist');
end;

 //thread1
procedure TForm1.btnyieldClick(Sender: TObject);
begin
  if FThread<>nil then
  begin
    FThread.Yield;
    Form1.Memo1.Lines.Add('Thread yielded');
  end
  else
    Form1.Memo1.Lines.Add('Thread1 does not exist');
end;

//thread2
procedure TForm1.Button1Click(Sender: TObject);
begin
  FThread1 := TMyThread.Create(seTimeToWork.Value);
  FThread1.Priority := tpNormal;
  FThread1.FreeOnTerminate := False;   // Free FThread in the OnTerminate proc. This will set Terminated to true.
  FThread1.Start;
end;

 //thread2
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FThread1 <> nil then
    FThread1.Terminate // Calling Free on a TThread will set Terminated := True
                  // and then block until the thread terminates.
  else
    Form1.Memo1.Lines.Add('Thread1 does not exist'); // Don't do this from OnTerminate!
end;

Uses

• System.Classes.TThread.Synchronize ( fr | de | ja )
• System.Classes.TThread.Yield ( fr | de | ja )
• System.Classes.TThread.Priority ( fr | de | ja )
• System.Classes.TThread.OnTerminate ( fr | de | ja )
• System.Classes.TThread.IsSingleProcessor ( fr | de | ja )
• System.Classes.TThread.Terminate ( fr | de | ja )
• System.Classes.TThread.Terminated ( fr | de | ja )
• System.Classes.TThread.FreeOnTerminate ( fr | de | ja )
• System.Classes.TThread.Execute ( fr | de | ja )
• System.Classes.TThread.Start ( fr | de | ja )
• Vcl.Samples.Spin.TSpinEdit ( fr | de | ja )