thread event test project 1

TEventThread example: matrix multiplication

A thread is created for each line of the Matrix For now only a dummy is used as an implementation of TEventThread. So the result is correct, but no Threads are used.

GUI unit

  unit eventthreadtest1;
  
  interface
  
  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls,
    eventthreadtest2,
    eventthread_1;
  
  type
    TForm33 = class(TForm)
      Button1: TButton;
      Memo1: TMemo;
      procedure Button1Click(Sender: TObject);
     private
     public
      { Public declarations }
    end;
  
    TMainEventThread = class (TEventThread)
     private
      { Private declarations }
      mm: TMatrixMult;
      mr: TMatrix;
      ThreadsRunning : Integer;
      procedure doit;
      procedure ThreadReady(Sender: TObject);
      procedure AllThreadsReady;
    end;
  
  var
    Form33: TForm33;
  
  implementation
  
  {$R *.dfm}
  
  var
    MainEventThread: TMainEventThread;
  
  
  procedure SetupMatrices(var mr, m1, m2: TMatrix);
  var
    i, j: Integer;
  begin
    SetLength(m1, 3);
    SetLength(m2, 4);
    SetLength(mr, 3);
    for i := 0 to length(m1)-1 do begin
      SetLength(m1[i], length(m2));
      SetLength(mr[i], length(m1));
    end;
    for i := 0 to length(m2)-1 do begin
      setlength(m2[i], length(m1));
    end;
    for i := 0 to length(m1)-1 do begin
      for j := 0 to length(m2)-1 do begin
        m1 [i, j] := i+j;
        m2 [j, i] := 1 + 2*i + 3*j;
      end;
    end;
  end;
  
  
  
  procedure TMainEventThread.doit;
  type
     trtest = record ptr: pointer; self: TObject; end;
  var
    m1, m2: TMatrix;
    l: Integer;
  
    etest: TMultLineEvent;
    rtest: trtest;
    stest: string;
  
  begin
    Form33.Memo1.Clear;
    SetupMatrices(mr, m1, m2);
    mm := TMatrixMult.Create(length(m1), ThreadReady);
    ThreadsRunning := length(m1);
    for l := 0 to length(m1)-1 do begin
  
      ///////////////////////////////////////////
      // just for demonstartion //////////////////
      //  if (mm.MultLineEvent[l] is TEventThread) then begin
          etest := mm.MultLineEvent[l];
          move(etest, rtest, 8);
          if rtest.self is TEventThread then begin
            stest := 'is TEventThread';
           end else begin
            stest := 'wrong type';
          end;
          Form33.Memo1.Lines.Add(stest);
      ///////////////////////////////////////////
      ///////////////////////////////////////////
  
      mm.MultLineEvent[l](mr, m1, m2, l);
              // doing an indirect call to a "procedure..of object"
              // which _is_ a TThreadEvent schedulres a thread event
              // instead of just calling the precudure
    end;
    // We now need to wait for all threads to be ready
  end;
  
  procedure TMainEventThread.ThreadReady(Sender: TObject);
  begin       // this is a thread event calling the main thread. Tus the code
              // is always running as the Main thread. So no danger that
              // e.g. ThreadsRunning := ThreadsRunning - 1 suffers from
              // multitasking ambiguity
    ThreadsRunning := ThreadsRunning - 1;
    if ThreadsRunning <> 0 then exit;
    mm.Free;
    AllThreadsReady;
  end;
  
  procedure TMainEventThread.AllThreadsReady;
  var
    i, j: Integer;
    s: String;
  begin
  // calculation ready
    for i := 0 to length(mr)-1 do begin
      s := ;
      for j := 0 to length(mr[0])-1 do begin
        s := s + FloatToStr(mr[i,j]) + ' ';
      end;
      Form33.Memo1.Lines.Add(s);
    end;
  end;
  
  procedure TForm33.Button1Click(Sender: TObject);
  begin
   MainEventThread := TMainEventThread.Create;
   MainEventThread.doit;
   MainEventThread.Free
  end;
  
  end.

worker unit

  unit eventthreadtest2;
  
  interface
  
  uses Classes
    ,eventthread_1;   // provides a dummy impementation of TEventTrread class
  
  type
    TMatrixElement = extended;
    TVector = array of TMatrixElement;
    TMatrix = array of TVector;
  
    TMultLineEvent = procedure (const mr, m1, m2: TMatrix; l: Integer) of object;
  
    TMatrixMultThread = class(TEventThread)
     private
      FNotifyEvent: TNotifyEvent;
      FAktLine: Integer;
      procedure NotifyReady;
     public
      procedure MultLine(const mr, m1, m2: TMatrix; l: Integer);
      property NotifyEvent: TNotifyEvent read FNotifyEvent write FNotifyEvent;
      property AktLine: Integer read FAktLine;
    end;
  
    TMatrixMult = Class(TObject)
     private
      FMatrixMultThread : array of TMatrixMultThread;
      FMultLineEvent : array of TMultLineEvent;
      function GetMultLineEvent(i: Integer): TMultLineEvent;
      procedure SetMultLineEvent(i: Integer; const Value: TMultLineEvent);
      procedure SetEventCount(Value: Integer; ThreadReady: TNotifyEvent);
     public
      constructor Create(Count: Integer; ThreadReady: TNotifyEvent);
      destructor Destroy; override;
      property MultLineEvent[i: Integer]: TMultLineEvent
               read GetMultLineEvent write SetMultLineEvent;
    end;
  
  implementation
  
  { TMatrixMultThread }
  
  procedure TMatrixMultThread.MultLine(const mr, m1, m2: TMatrix; l: Integer);
  var
    i, j: Integer;
    sum: TMatrixElement;
  begin
    FAktLine := l;
    for i := 0 to length(m1)-1 do begin
      sum := 0;
      for j := 0 to length(m2)-1 do begin
        sum := sum + m1[l, j] * m2[j, i];
      end;
      mr[l, i] := sum;
    end;
    NotifyReady;
  end;
  
  procedure TMatrixMultThread.NotifyReady;
  begin
    if assigned(FNotifyEvent) then FNotifyEvent(self);
           // doing an indirect call to a "procedure..of object"
           // which _is_ a TThreadEvent schedulres a thread event
           // instead of just calling the procedure
  end;
  
  { TMatrixMult }
  
  constructor TMatrixMult.Create(Count: Integer; ThreadReady: TNotifyEvent);
  begin
    inherited Create;
    SetEventCount(Count, ThreadReady);
  end;
  
  destructor TMatrixMult.Destroy;
  var
    l: Integer;
  begin
    for l := 0 to length(FMatrixMultThread)-1 do begin
      FMatrixMultThread[l].Free;
    end;
    inherited;
  end;
  
  procedure TMatrixMult.SetEventCount(Value: Integer; ThreadReady: TNotifyEvent);
  var
    l: Integer;
  begin
    SetLength(FMatrixMultThread, Value);
    SetLength(FMultLineEvent, Value);
    for l := 0 to Value-1 do begin
      FMatrixMultThread[l] := TMatrixMultThread.Create;
      FMatrixMultThread[l].NotifyEvent := ThreadReady;
      FMultLineEvent[l] := FMatrixMultThread[l].MultLine;
    end;
  end;
  
  function TMatrixMult.GetMultLineEvent(i: Integer): TMultLineEvent;
  begin
    Result := FMultLineEvent[i];
  end;
  
  procedure TMatrixMult.SetMultLineEvent(i: Integer; const Value: TMultLineEvent);
  begin
    FMultLineEvent[i] := Value;
  end;
  
  end.

TEventThread dummy unit

  unit eventthread_1;
  
  interface
  
  type
    TEventThread = class(TObject)
    end;
  
  implementation
  end.
  

--Mschnell 15:35, 7 December 2007 (CET)