Lazarus
Programming => Widgetset => Other => Topic started by: dieselnutjob on April 11, 2014, 05:20:55 pm
-
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?
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]
-
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.
-
you mean like this?
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.