TEvent ?
lazarus / 13-General

----------------------------------------------------------------------
dieselnutjob · 2008-11-01 19:15

I'm trying to translate program that I had working in Turbo Delphi.

The idea is that a thread increments a variable every second and
creates an event that can be used the main code to do something.

It fails on "if Assigned(FEvent) then FEvent(self);"

is uses SyncObjs the correct way to make TEvents work like they do in
Delphi?

can anyone help?

Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  SyncObjs, Classes, SysUtils, LResources, Forms, Controls, Graphics,
Dialogs;

type

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
type
  TEvent1 = procedure(Sender: TObject) of object;
  TThread1 = class(TThread)
  private
    FEvent: TEvent;
  protected
    procedure Execute; override;
    procedure DoEvent; dynamic;
  public
    constructor Create(CreateSuspended : Boolean);
    property Event: TEvent read FEvent write FEvent;
  end;

var
  Form1: TForm1;
  Thread1: TThread1;
  i: integer;

implementation

{ TEvent1 }

constructor TThread1.Create(CreateSuspended : Boolean);
begin
   FreeOnTerminate := True;
   inherited Create(CreateSuspended);
end;

procedure TThread1.Execute;
begin
  repeat;
    sleep(1000);
    i:=i+1;
    DoEvent;
  until(false);
end;

procedure TThread1.DoEvent;
begin
  if Assigned(FEvent) then FEvent(self);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  i:=0;
  Event1:=TEvent1.Create(True);
  Event1.Resume;
end;

initialization
  {$I unit1.lrs}

end.
[/code]

----------------------------------------------------------------------
theo · 2008-11-01 21:05

I don't think this has ever worked in Delphi either.

It looks very strange:
type
  TEvent1 = procedure(Sender: TObject) of object;
  Event1:=TEvent1.Create(True);

How should this compile?

What should FEvent(self);  do? FEvent is of type TEvent < TObject

I dont' really understand what you want to do. Maybe Synchronize?

http://wiki.freepascal.org/Multithreaded_Application_Tutorial

----------------------------------------------------------------------
dieselnutjob · 2008-11-01 22:47

here is the original unmodified Delphi code
this definitely compiles in Turbo Delphi explorer.

Code: [Select]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ButtonStop: TButton;
    ButtonStart: TButton;
    procedure FormCreate(Sender: TObject);
    procedure WaiterEvent(Sender: TObject);
    procedure ButtonStopClick(Sender: TObject);
    procedure ButtonStartClick(Sender: TObject);
    procedure SendText(TempText: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TEvent = procedure(Sender: TObject) of object;
  TWaiter = class(TThread)
  private
    FRun: Boolean;
    FOnEvent: TEvent;
  protected
    procedure Execute; override;
    procedure DoEvent; dynamic;
  public
    property Run: Boolean read FRun write FRun;
    property OnEvent: TEvent read FOnEvent write FOnEvent;
  end;

var
  Form1: TForm1;
  Waiter1: TWaiter;

const
  CRLF = Chr(13)+Chr(10);

implementation

{$R *.dfm}

procedure TWaiter.Execute;
begin
  repeat
    sleep(2000);
    if Run then DoEvent;
  until (False);
end;

procedure TWaiter.DoEvent;
begin
  if Assigned(FOnEvent) then
  FOnEvent(Self);
end;


procedure TForm1.ButtonStartClick(Sender: TObject);
begin
  Waiter1.Run := True;
  ButtonStart.Enabled := False;
  ButtonStop.Enabled := True;
end;

procedure TForm1.ButtonStopClick(Sender: TObject);
begin
  Waiter1.Run := False;
  ButtonStart.Enabled := True;
  ButtonStop.Enabled := False;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Text := '';
  SendText('Started' + CRLF);
  Waiter1 := TWaiter.Create(True);
  Waiter1.Run := False;
  ButtonStart.Enabled := True;
  ButtonStop.Enabled := False;
  Waiter1.FreeOnTerminate := True;
  Waiter1.OnEvent := WaiterEvent;
  Waiter1.Resume;
  SendText('Waiter started' + CRLF)
end;

procedure TForm1.WaiterEvent(Sender: TObject);
begin
  SendText('Event happened' + CRLF);
end;

procedure TForm1.SendText(TempText: String);
begin
   Memo1.SelStart := Memo1.GetTextLen;
   Memo1.SelLength := 0;
   Memo1.SelText := Temptext;
   Memo1.SelStart := Memo1.GetTextLen;
   SendMessage(Memo1.Handle, EM_SCROLLCARET, 0, 0);
end;


end.

----------------------------------------------------------------------
theo · 2008-11-02 00:08

Yes but this is not the same as above ;-)

This compiles also in Lazarus with small changes:
Change
  Waiter1.OnEvent := @WaiterEvent; or add {$mode delphi} instead of
{$mode objfpc}
Uncomment
SendMessage(Memo1.Handle, EM_SCROLLCARET, 0, 0);

But imho this is not good code on Delphi either.
It has nothing to do with delphi / fpc's TEvent.
TEvent It's a simple procedure definition here.
It's not Synchronized and you'll get Access Violations with this code.
Please read the link I gave you above about threads.

----------------------------------------------------------------------
dieselnutjob · 2008-11-02 23:21

yes you are right of course..
so here is the code that I was trying to write (this does compile)
I have some questions as I am a bit of a newbie with Delphi and a
total beginner with Lazarus (I thought it might be better to switch
over now, lower on the learning curve).
I understand that it's not synchronised.  From the Multithread
Tutorial the difference would appear to be that my code fires an event
into the GUI code and then keeps running, whilst synchronised code
will pause whilst the GUI processes the event.  Now it might be that
one solution is best sometimes and other times the other might be?
 Like if the thread is handling a communication protocol it maybe
can't just go to sleep for a while?  Have I understood this correctly?
Secondly I guess that you talk about access violation because the
variable i is available to the GUI thread and the Thread1 thread.
 Have I understood correctly?  Presumably the solution is to use to
set  a TThread property and set the read/write permissions properly,
and use these properties to pass information between the threads?  or
maybe I've misunderstood what causes the access violation....
Last question.  My code doesn't have an "constructor
Create(CreateSuspended : Boolean);" line which the tutorial seems to
suggest that I need, but yet it works.  So what does that line in the
tutorial actually do?

thanks

Code: [Select]
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure ThreadEvent(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TEvent = procedure(Sender: TObject) of object;
  TThread1 = class(TThread)
  private
    FEvent: TEvent;
  protected
    procedure Execute; override;
    procedure DoEvent; dynamic;
  public
    property Event: TEvent read FEvent write FEvent;
  end;

var
  Form1: TForm1;
  Thread1: TThread1;
  i: Integer;

implementation

//{$R *.dfm}

procedure TThread1.Execute;
begin
  repeat
    sleep(1000);
    i:=i+1;
    DoEvent;
  until (False);
end;

procedure TThread1.DoEvent;
begin
  if Assigned(FEvent) then FEvent(Self);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  i:=0;
  Thread1 := TThread1.Create(True);
  Thread1.FreeOnTerminate := True;
  Thread1.Event := @ThreadEvent;
  Thread1.Resume;
end;

procedure TForm1.ThreadEvent(Sender: TObject);
begin
  Memo1.Text:=IntToStr(i);
end;

initialization
  {$I unit1.lrs}
 
end.

----------------------------------------------------------------------
theo · 2008-11-03 10:45

There are many resources on the Web which answer your questions.

http://wiki.delphigl.com/index.php/Tutorial_Multithreading (German,
see examples).
http://www.eonclash.com/Tutorials/Multithreading/MartinHarvey1.1/ToC.h
tml
or Google for "delphi multithreading tutorial" etc.

----------------------------------------------------------------------
dieselnutjob · 2008-11-03 12:02

okay
I've read the "multithreaded application tutorial" on Lazarus wiki
again (third time..)
it says
QuoteBut if one or several threads changes the variable, then you must
make sure, that only one thread accesses the variable at a a time
I can see that I have broken that rule.  Also I guess synchronisation
is the cure for that one, because if a background thread is paused so
that GUI thread reads a variable and displays something on Form1, then
it can't be accessing the variable too.
I think that the penny has dropped.  Have I got it?

thanks

----------------------------------------------------------------------
theo · 2008-11-03 12:07

Quote from: "dieselnutjob"Have I got it?

I think so ;-)

----------------------------------------------------------------------
dieselnutjob · 2008-11-03 20:08

complete code for a simple app.  it just needs a form with a memo1,
button1, and button2 on a form

is this good code?
I couldn't quite figure out how I could get either the GUI thread or
the thread1 thread could both update the memo1.text, so both
TForm1.Button2Click and TForm1.UpdateGUI call TForm1.UpdateText
This is why I had to have a variable k because TForm1.UpdateText could
get called from either thread and so can't read j
probably there's a better way....

Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls;

Type
    { TThread1 }
    TjEvent = procedure(j: Integer) of Object;
    TThread1 = class(TThread)
    private
      fj : Integer;
      FjEvent: TjEvent;
      procedure UpdateGUI;
    protected
      procedure Execute; override;
    public
      Constructor Create(CreateSuspended : boolean);
      property OnjEvent: TjEvent read FjEvent write FjEvent;
    end;

Type
    { TForm1 }
    TForm1 = class(TForm)
      Button1: TButton;
      Button2: TButton;
      Memo1: TMemo;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure Button1Click(Sender: TObject);
      procedure Button2Click(Sender: TObject);
      procedure UpdateText;
    private
      Thread1: TThread1;
      procedure UpdateGUI(j: Integer);
    public
    end;
var
  Form1: TForm1;
  Thread1: TThread1;
  i: Integer;
  k: Integer;

implementation

//{$R *.dfm}

  constructor TThread1.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
  end;

  procedure TThread1.UpdateGUI;
  // this method is executed by the mainthread and can therefore
access all GUI elements.
  begin
    if Assigned(FjEvent) then
    begin
      FjEvent(fj);
    end;
  end;

  procedure TThread1.Execute;
  var
    Finished: boolean;
  begin
    fj := 0;
    Synchronize(@UpdateGUI);
    Finished := false;
    while (not Terminated) and (not Finished) do
      begin
        sleep(1000);
        fj := fj + 1;
        Synchronize(@UpdateGUI);
        if fj > 100 then Finished := true;
      end;
  end;

  procedure TForm1.FormCreate(Sender: TObject);
  begin
    inherited;
    i := 0;
    k := 0;
    Thread1 := TThread1.Create(true);
    Thread1.OnjEvent := @UpdateGUI;
  end;

  procedure TForm1.FormDestroy(Sender: TObject);
  begin
    Thread1.Terminate;
    Thread1.Free;
    inherited;
  end;

  procedure TForm1.Button1Click(Sender: TObject);
  begin
   Button1.Enabled := false;
   Thread1.Resume;
  end;

  procedure TForm1.Button2Click(Sender: TObject);
  begin
    i := i + 1;
    UpdateText;
  end;

  //this is triggered by TThread1 using Thread1.OnjEvent:=@UpdateGUI
above
  procedure TForm1.UpdateGUI(j: integer);
  begin
    k := j;
    UpdateText;
  end;

  procedure TForm1.UpdateText;
  begin
    if i > k then Memo1.text := IntToStr(i)+'>'+IntToStr(k);
    if i < k then Memo1.text := IntToStr(i)+'<'+IntToStr(k);
    if i = k then Memo1.text := IntToStr(i)+'='+IntToStr(k);
  end;

initialization
  {$I unit1.lrs}
 
end.