MyFPGMultiThreadedProgram please check my work

[dieselnutjob]

I used the code at http://wiki.lazarus.freepascal.org/Multithreaded_Application_Tutorial

and fpgui-isised it.

It seems to work okay, but the orginal had some "inherited;" statements in it which I don't really understand.
update 12/4/2014: it seems to me that because AfterCreate and BeforeDestruction are existing routines, which I am modifying, that they should have "inherited" statements in them.  Now added in the code. Comments?

Is my code okay?

Code: [Select]

program MyFPGMultiThreadedProgram;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, Sysutils,
  fpg_base,
  fpg_main,
  fpg_form,
  fpg_button,
  fpg_label;

type
  TShowStatusEvent = procedure(Status: String) of Object;

  TMyThread = class(TThread)
  private
    fStatusText : string;
    FOnShowStatus: TShowStatusEvent;
    procedure ShowStatus;
  protected
    procedure Execute; override;
  public
    Constructor Create(CreateSuspended : boolean);
    property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
  end;

type
  TMainForm = class(TfpgForm)
  private
    {@VFD_HEAD_BEGIN: MainForm}
    lblStatus: TfpgLabel;
    btnStart: TfpgButton;
    btnQuit: TfpgButton;
    {@VFD_HEAD_END: MainForm}
    MyThread: TMyThread;
    procedure ShowStatus(Status: string);
    procedure btnStartClicked(Sender: TObject);
    procedure btnQuitClicked(Sender: TObject);
  public
    procedure AfterCreate; override;
    procedure BeforeDestruction; override;
  end;

{ TMyThread }

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

procedure TMyThread.ShowStatus;
// this method is executed by the mainthread and can therefore access all GUI elements.
begin
 if Assigned(FOnShowStatus) then
 begin
   FOnShowStatus(fStatusText);
 end;
end;

procedure TMyThread.Execute;
var
 newStatus : string;
 i: integer;
begin
 i:=0;
 fStatusText := 'TMyThread Starting...';
 Synchronize(@Showstatus);
 fStatusText := 'TMyThread Running...';
 while (not Terminated) {and ([any condition required])} do
   begin
     inc(i);
     NewStatus:=inttostr(i);
     sleep(500);
     if NewStatus <> fStatusText then
       begin
         fStatusText := newStatus;
         Synchronize(@Showstatus);
       end;
   end;
end;

{ TMainForm }
procedure TMainForm.btnStartClicked(Sender: TObject);
begin
 MyThread.Start;
end;


procedure TMainForm.btnQuitClicked(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.ShowStatus(Status: string);
begin
  lblStatus.Text:=Status;
end;

procedure TMainForm.AfterCreate;
begin
  inherited; //added later on reflection

  MyThread := TMyThread.Create(true);
  MyThread.OnShowStatus := @ShowStatus;

 {@VFD_BODY_BEGIN: MainForm}
  Name := 'MainForm';
  SetPosition(329, 251, 300, 100);
  WindowTitle := 'Memo Test';
  WindowPosition := wpOneThirdDown;

  lblStatus := TfpgLabel.Create(self);
  with lblStatus do
  begin
    Name := 'lblStatus';
    SetPosition(10, 50, 280, 20);
    Text := 'Press start button';
    FontDesc := '#Label1';
  end;

  btnStart := TfpgButton.Create(self);
  with btnStart do
  begin
    Name := 'btnStart';
    SetPosition(10, 8, 80, 24);
    Anchors := [anRight,anTop];
    Text := 'Start';
    FontDesc := '#Label1';
    Hint := '';
    TabOrder := 1;
    OnClick := @btnStartClicked;
  end;

  btnQuit := TfpgButton.Create(self);
  with btnQuit do
  begin
    Name := 'btnQuit';
    SetPosition(208, 8, 80, 24);
    Anchors := [anRight,anTop];
    Text := 'Quit';
    FontDesc := '#Label1';
    Hint := '';
    ImageName := 'stdimg.quit';
    TabOrder := 2;
    OnClick := @btnQuitClicked;
  end;

  {@VFD_BODY_END: MainForm}
end;

procedure TMainForm.BeforeDestruction;
begin
  MyThread.Terminate;
  inherited; //added later on reflection
end;

procedure MainProc;
var
  frm: TMainForm;
begin
  fpgApplication.Initialize;
  frm := TMainForm.Create(nil);
  frm.Show;
  fpgApplication.Run;
  frm.Free;
end;

begin
  MainProc;
end.
[\code]

[Graeme]

I used the code at http://wiki.lazarus.freepascal.org/Multithreaded_Application_Tutorial
and fpgui-isised it.

Nice! :-)

update 12/4/2014: it seems to me that because AfterCreate and BeforeDestruction are existing routines, which I am modifying, that they should have "inherited" statements in them.

In theory you are 100% correct. Normally if you override a virtual method you call inherited. I say "normally" because it isn't a must, it is up to the developer and what behaviour they want. The fpGUI TfpgBaseForm.AfterCreate method is empty, so if you didn't call inherited AfterCreate when you defined your form, it wouldn't have made any difference.

The only change I would make to your code, is to use TfpgForm's OnDestroy event instead of overriding BeforeDestruction. The end result is exactly the same, but I think the OnDestroy is more developer friendly.

[dieselnutjob]

you mean like this?

Code: [Select]

program MyFPGMultiThreadedProgram;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, Sysutils,
  fpg_base,
  fpg_main,
  fpg_form,
  fpg_button,
  fpg_label;

type
  TShowStatusEvent = procedure(Status: String) of Object;

  TMyThread = class(TThread)
  private
    fStatusText : string;
    FOnShowStatus: TShowStatusEvent;
    procedure ShowStatus;
  protected
    procedure Execute; override;
  public
    Constructor Create(CreateSuspended : boolean);
    property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
  end;

type
  TMainForm = class(TfpgForm)
  private
    {@VFD_HEAD_BEGIN: MainForm}
    lblStatus: TfpgLabel;
    btnStart: TfpgButton;
    btnQuit: TfpgButton;
    {@VFD_HEAD_END: MainForm}
    MyThread: TMyThread;
    procedure ShowStatus(Status: string);
    procedure btnStartClicked(Sender: TObject);
    procedure btnQuitClicked(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  public
    procedure AfterCreate; override;
    {procedure BeforeDestruction; override;}
  end;

{ TMyThread }

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

procedure TMyThread.ShowStatus;
// this method is executed by the mainthread and can therefore access all GUI elements.
begin
 if Assigned(FOnShowStatus) then
 begin
   FOnShowStatus(fStatusText);
 end;
end;

procedure TMyThread.Execute;
var
 newStatus : string;
 i: integer;
begin
 i:=0;
 fStatusText := 'TMyThread Starting...';
 Synchronize(@Showstatus);
 fStatusText := 'TMyThread Running...';
 while (not Terminated) {and ([any condition required])} do
   begin
     inc(i);
     NewStatus:=inttostr(i);
     sleep(500);
     if NewStatus <> fStatusText then
       begin
         fStatusText := newStatus;
         Synchronize(@Showstatus);
       end;
   end;
end;

{ TMainForm }
procedure TMainForm.btnStartClicked(Sender: TObject);
begin
 MyThread.Start;
end;


procedure TMainForm.btnQuitClicked(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  MyThread.Terminate;
end;

procedure TMainForm.ShowStatus(Status: string);
begin
  lblStatus.Text:=Status;
end;

procedure TMainForm.AfterCreate;
begin
  inherited; //added later on reflection

  MyThread := TMyThread.Create(true);
  MyThread.OnShowStatus := @ShowStatus;

 {@VFD_BODY_BEGIN: MainForm}
  Name := 'MainForm';
  SetPosition(329, 251, 300, 100);
  WindowTitle := 'Memo Test';
  WindowPosition := wpOneThirdDown;
  OnDestroy := @FormDestroy;

  lblStatus := TfpgLabel.Create(self);
  with lblStatus do
  begin
    Name := 'lblStatus';
    SetPosition(10, 50, 280, 20);
    Text := 'Press start button';
    FontDesc := '#Label1';
  end;

  btnStart := TfpgButton.Create(self);
  with btnStart do
  begin
    Name := 'btnStart';
    SetPosition(10, 8, 80, 24);
    Anchors := [anRight,anTop];
    Text := 'Start';
    FontDesc := '#Label1';
    Hint := '';
    TabOrder := 1;
    OnClick := @btnStartClicked;
  end;

  btnQuit := TfpgButton.Create(self);
  with btnQuit do
  begin
    Name := 'btnQuit';
    SetPosition(208, 8, 80, 24);
    Anchors := [anRight,anTop];
    Text := 'Quit';
    FontDesc := '#Label1';
    Hint := '';
    ImageName := 'stdimg.quit';
    TabOrder := 2;
    OnClick := @btnQuitClicked;
  end;

  {@VFD_BODY_END: MainForm}
end;

{procedure TMainForm.BeforeDestruction;
begin
  MyThread.Terminate;
  inherited; //added later on reflection
end;}

procedure MainProc;
var
  frm: TMainForm;
begin
  fpgApplication.Initialize;
  frm := TMainForm.Create(nil);
  frm.Show;
  fpgApplication.Run;
  frm.Free;
end;

begin
  MainProc;
end.