/examples/multithreading/mainunit.pas

  1{
  2 ***************************************************************************
  3 *                                                                         *
  4 *   This source is free software; you can redistribute it and/or modify   *
  5 *   it under the terms of the GNU General Public License as published by  *
  6 *   the Free Software Foundation; either version 2 of the License, or     *
  7 *   (at your option) any later version.                                   *
  8 *                                                                         *
  9 *   This code is distributed in the hope that it will be useful, but      *
 10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 12 *   General Public License for more details.                              *
 13 *                                                                         *
 14 *   A copy of the GNU General Public License is available on the World    *
 15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 16 *   obtain it by writing to the Free Software Foundation,                 *
 17 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 18 *                                                                         *
 19 ***************************************************************************
 20
 21  Abstract:
 22    Demo to show, how to start a thread and how synchronize with the main
 23    thread.
 24    Important: The cthread unint must be added to the uses section of the .lpr
 25               file. See multithreadingexample1.lpr.
 26}
 27unit MainUnit;
 28
 29{$mode objfpc}{$H+}
 30
 31interface
 32
 33uses
 34  Classes, SysUtils, Forms, Controls, Graphics, Dialogs;
 35
 36type
 37
 38  { TMyThread }
 39
 40  TMyThread = class(TThread)
 41  private
 42    fStatusText: string;
 43    procedure ShowStatus;
 44  protected
 45    procedure Execute; override;
 46  public
 47    constructor Create(CreateSuspended: boolean);
 48  end;
 49
 50  { TForm1 }
 51
 52  TForm1 = class(TForm)
 53    procedure FormCreate(Sender: TObject);
 54  private
 55  public
 56  end;
 57
 58var
 59  Form1: TForm1; 
 60
 61implementation
 62
 63{$R *.lfm}
 64
 65{ TForm1 }
 66
 67procedure TForm1.FormCreate(Sender: TObject);
 68var
 69  MyThread : TMyThread;
 70begin
 71  MyThread := TMyThread.Create(True); // With the True parameter it doesn't start automatically
 72  if Assigned(MyThread.FatalException) then
 73    raise MyThread.FatalException;
 74      
 75  // Here the code initialises anything required before the threads starts executing
 76
 77  MyThread.Start;
 78end;
 79
 80{ TMyThread }
 81
 82procedure TMyThread.ShowStatus;
 83// this method is only called by Synchronize(@ShowStatus) and therefore
 84// executed by the main thread
 85// The main thread can access GUI elements, for example Form1.Caption.
 86begin
 87  Form1.Caption := fStatusText;
 88end;
 89
 90procedure TMyThread.Execute;
 91var
 92  newStatus : string;
 93begin
 94  fStatusText := 'TMyThread Starting ...';
 95  Synchronize(@Showstatus);
 96  fStatusText := 'TMyThread Running ...';
 97  while (not Terminated) and (true {any condition required}) do begin
 98
 99    //here goes the code of the main thread loop
100    newStatus:='TMyThread Time: '+FormatDateTime('YYYY-MM-DD HH:NN:SS',Now);
101    
102    if NewStatus <> fStatusText then begin
103      fStatusText := newStatus;
104      Synchronize(@Showstatus);
105    end;
106  end;
107end;
108
109constructor TMyThread.Create(CreateSuspended: boolean);
110begin
111  FreeOnTerminate := True;
112  inherited Create(CreateSuspended);
113end;
114
115end.
116