Thread feedback using CriticalSession

Hi all.
Partecipating to the question http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_28655025.html#a40727705 I relized my tecnique to geve feedback from within a secondary thread is wrong. I'm tempted to follow the Geert's suggestion and to avoid to provide feedback at all, but, at least to learn, I'm trying to implement the tecnique suggested by Bruno, using a main unit, a thread unit and a third unit used by both mnmain and thread unit.
My example doesn't work and I'm wondering what I'm missing here again :-)
Below I provide the code in plain text.
Thank you all for your help.

Main unit .pas
unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, System.SyncObjs;

type
  TForm1 = class(TForm)
    mmoFeedback: TMemo;
    pnl1: TPanel;
    btnStart: TButton;
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    procedure SimpleThreadTerminated(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses uCS, SimpleThread;

procedure TForm1.btnStartClick(Sender: TObject);
var
  thr: TSimpleThread;
begin
  thr := TSimpleThread.Create;
  thr.OnTerminate := SimpleThreadTerminated;
  tmr1.Enabled := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Buffer := TStringList.Create;
  CS := TCriticalSection.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CS.Free;
  Buffer.Free;
end;

procedure TForm1.SimpleThreadTerminated(Sender: TObject);
begin
  tmr1.Enabled := False;
  Showmessage('Done');
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  mmoFeedback.Lines.BeginUpdate;
  CS.Enter;
  try
    mmoFeedback.Lines.AddStrings(Buffer);
    Buffer.Clear;
  finally
    CS.Leave;
    mmoFeedback.Lines.EndUpdate;  // >> after Leave so that other threads are delayed as short as possible
  end;
  mmoFeedback.Update;
end;

end.

Open in new window


Main unit .dfm
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 223
  ClientWidth = 274
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object mmoFeedback: TMemo
    Left = 0
    Top = 41
    Width = 274
    Height = 182
    Align = alClient
    ReadOnly = True
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object pnl1: TPanel
    Left = 0
    Top = 0
    Width = 274
    Height = 41
    Align = alTop
    TabOrder = 1
    object btnStart: TButton
      Left = 102
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Start'
      TabOrder = 0
      OnClick = btnStartClick
    end
  end
  object tmr1: TTimer
    Enabled = False
    OnTimer = tmr1Timer
    Left = 216
    Top = 8
  end
end

Open in new window


Thread unit SimpleThread:
unit SimpleThread;

interface

uses System.Classes, System.Win.Registry, System.SysUtils, Winapi.Windows, IniFiles, StrUtils,
Vcl.Forms;

type
  TSimpleThread = class(TThread)
  private
  protected
    procedure Execute; override;
  public
    constructor Create();
    destructor Destroy; override;
  end;


implementation

uses RegExpo, uCS;


{ TSimpleThread }

constructor TSimpleThread.Create();
begin
  inherited Create(False);
end;


destructor TSimpleThread.Destroy;
begin
  inherited;
end;

procedure TSimpleThread.Execute;
var
  i: Integer;
begin
  FreeOnTerminate := True;
  for i:= 0 to 10000 do
    Log('Record '+IntToStr(i));
end;

end.

Open in new window


uCS:
unit uCS;

interface

uses System.SyncObjs, System.Classes;

var
  CS: TCriticalSection;
  msg: string;
  Buffer: TStringList;

  procedure Log(AMessage: string);

implementation

procedure Log(AMessage: string);
begin
  CS.Enter;
  try
    Buffer.Add(AMessage);
  finally
    CS.Leave;
  end;
end;



end.

Open in new window

LVL 32
Marco GasiFreelancerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Sinisa VukSoftware architectCommented:
first thing I can see i  that you create non suspended Thread and set
thr.OnTerminate := SimpleThreadTerminated;

Open in new window

... in next line - this is wrong - because your thread is already running...

Look at my example of how I do it:
unit Unit32;

interface

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

type
  TThreadMessageEvent = procedure(Sender: TObject; sMessage: String) of object;

  TSimpleThread = class(TThread)
  private
    FLogMessage: String;
    FOnThreadMessage: TThreadMessageEvent;
  protected
    procedure Execute; override;
    procedure LogToMainForm;
  public
    constructor Create(ThreadMessage: TThreadMessageEvent);
    destructor Destroy; override;
    procedure Log(sText: String);
    property OnThreadMessage: TThreadMessageEvent read FOnThreadMessage write FOnThreadMessage;
  end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ThreadMsg(Sender: TObject; sMessage: String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TSimpleThread }

constructor TSimpleThread.Create(ThreadMessage: TThreadMessageEvent);
begin
  FOnThreadMessage := ThreadMessage;

  inherited Create(False);

  FreeOnTerminate := True;
end;

destructor TSimpleThread.Destroy;
begin

  inherited;
end;

procedure TSimpleThread.Execute;
var
  i: Integer;
begin
  for i:= 0 to 10000 do
  begin
    Log('Record '+IntToStr(i));
    sleep(100);
  end;
end;

procedure TSimpleThread.Log(sText: String);
begin
  FLogMessage := sText;
  Synchronize(LogToMainForm);
end;

procedure TSimpleThread.LogToMainForm;
begin
  if Assigned(FOnThreadMessage) then
    FOnThreadMessage(Self, FLogMessage);
end;

//main form

procedure TForm1.Button1Click(Sender: TObject);
var
  t: TSimpleThread;
begin
  t := TSimpleThread.Create(ThreadMsg);
end;

procedure TForm1.ThreadMsg(Sender: TObject; sMessage: String);
begin
  Memo1.Lines.Add(sMessage);
end;

end.

Open in new window


I use callback procedure from main form and do sync with message. This should be enough. No need criticalsection for this.
0
Marco GasiFreelancerAuthor Commented:
Hi Sinisa. Interesting, even if I would like to get the job done using the tecnique suggested in the other quesiton...
Bur let me ask: what if I need to have in the main form a procedure to do something when thread is terminated? That is: how do I have to create the thread in order to legitimately create and assign an OnTerminate event?
0
Sinisa VukSoftware architectCommented:
just set Suspended in constructor of Thread:
constructor TSimpleThread.Create();
begin
  inherited Create(True);
end;

Open in new window


... and when creating thread do:
  thr := TSimpleThread.Create;
  thr.OnTerminate := SimpleThreadTerminated;
  //you can set some properties of thread here too
  thr.Resume; //this will run thread
  tmr1.Enabled := True;

Open in new window

0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

Bruno BuesserCommented:
Hi Marco

Comment out tmr1.Enabled := False and you will see the strings in the memo.
in SimpleThreadTerminated you disable the timer before it is fired the first time.

Bruno
0
Marco GasiFreelancerAuthor Commented:
@Sinisa: thanks for clarifying that point: you're always a great resource.

@Bruno: thanks for your reply. I did what you suggested and it works but I have two questions:
1 - why if I stop the timer in SimpleThreadTerminated it is immediately stopped? Shouldn't the event be fired when the thread is terminated?
2 - though I added mmoFeedback.Update at the end of the Timer1Execute event, the memo is filled with the values only when the thread is terminated: I click, start, almost immediately the message 'Done' is shown (question 1) and after that the program freezes until the thread is terminate wihtout any feedback, so if I'd want to replace the memo with a progressbar it would remain empty until the end and suddenly it would be filled at the end of the process.

What other am I missing here?
0
Sinisa VukSoftware architectCommented:
put this procedure:

procedure TForm1.SimpleThreadTerminated(Sender: TObject);
begin
  tmr1.Enabled := False;
  tmr1Timer(nil); //will fill remain buffer
  Showmessage('Done');
end;

Open in new window

0
Bruno BuesserCommented:
The thread is terminated just after Execute has finished. You don't have any while loop in Execute which would prevent Execute to be finished at once. So the timer is stopped just after the buffer is filled with the strings and before the timer is executed the first time. You problem seems to be that things happens much faster than you are expecting,
I suggest do slow down your for loop with Sleep(200) and set timer interval to 100 so that you can see the progress.  

   tmr1.Interval := 100   >> with object inspector or in form create

  >> In Execute insert Sleep:
  for i:= 0 to 100 do
  begin
    Log('Record '+IntToStr(i));
    Sleep(200);
  end;

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Marco GasiFreelancerAuthor Commented:
Thank you so mutch for all your help.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.