From f10441b47fb250a1b22e7b46fe021dd204fa9840 Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 8 Jul 2006 15:12:53 +0000 Subject: [PATCH] added multithreading examples git-svn-id: trunk@9575 - --- .gitattributes | 15 ++ .../criticalsectionexample1.lpi | 62 +++++ .../criticalsectionexample1.lpr | 18 ++ .../multithreading/criticalsectionunit1.lfm | 43 +++ .../multithreading/criticalsectionunit1.lrs | 16 ++ .../multithreading/criticalsectionunit1.pas | 147 +++++++++++ examples/multithreading/mainunit.pas | 25 +- .../multithreading/multithreadingexample1.lpi | 3 +- .../multithreading/multithreadingexample1.lpr | 5 +- .../multithreading/processmessagesunit1.lfm | 34 +++ .../multithreading/processmessagesunit1.lrs | 14 + .../multithreading/processmessagesunit1.pas | 138 ++++++++++ .../singlethreadingexample1.lpi | 63 +++++ .../singlethreadingexample1.lpr | 18 ++ examples/multithreading/waitforexample1.lpi | 244 ++++++++++++++++++ examples/multithreading/waitforexample1.lpr | 18 ++ examples/multithreading/waitforunit1.lfm | 32 +++ examples/multithreading/waitforunit1.lrs | 13 + examples/multithreading/waitforunit1.pas | 162 ++++++++++++ 19 files changed, 1058 insertions(+), 12 deletions(-) create mode 100644 examples/multithreading/criticalsectionexample1.lpi create mode 100644 examples/multithreading/criticalsectionexample1.lpr create mode 100644 examples/multithreading/criticalsectionunit1.lfm create mode 100644 examples/multithreading/criticalsectionunit1.lrs create mode 100644 examples/multithreading/criticalsectionunit1.pas create mode 100644 examples/multithreading/processmessagesunit1.lfm create mode 100644 examples/multithreading/processmessagesunit1.lrs create mode 100644 examples/multithreading/processmessagesunit1.pas create mode 100644 examples/multithreading/singlethreadingexample1.lpi create mode 100644 examples/multithreading/singlethreadingexample1.lpr create mode 100644 examples/multithreading/waitforexample1.lpi create mode 100644 examples/multithreading/waitforexample1.lpr create mode 100644 examples/multithreading/waitforunit1.lfm create mode 100644 examples/multithreading/waitforunit1.lrs create mode 100644 examples/multithreading/waitforunit1.pas diff --git a/.gitattributes b/.gitattributes index 6f50c5f235..5921ff5735 100644 --- a/.gitattributes +++ b/.gitattributes @@ -994,11 +994,26 @@ examples/memotest.lpi svneol=native#text/plain examples/memotest.pp svneol=native#text/pascal examples/messagedialogs.lpi svneol=native#text/plain examples/messagedialogs.pp svneol=native#text/pascal +examples/multithreading/criticalsectionexample1.lpi svneol=native#text/plain +examples/multithreading/criticalsectionexample1.lpr svneol=native#text/plain +examples/multithreading/criticalsectionunit1.lfm svneol=native#text/plain +examples/multithreading/criticalsectionunit1.lrs svneol=native#text/plain +examples/multithreading/criticalsectionunit1.pas svneol=native#text/plain examples/multithreading/mainunit.lfm svneol=native#text/plain examples/multithreading/mainunit.lrs svneol=native#text/plain examples/multithreading/mainunit.pas svneol=native#text/plain examples/multithreading/multithreadingexample1.lpi svneol=native#text/plain examples/multithreading/multithreadingexample1.lpr svneol=native#text/plain +examples/multithreading/processmessagesunit1.lfm svneol=native#text/plain +examples/multithreading/processmessagesunit1.lrs svneol=native#text/plain +examples/multithreading/processmessagesunit1.pas svneol=native#text/plain +examples/multithreading/singlethreadingexample1.lpi svneol=native#text/plain +examples/multithreading/singlethreadingexample1.lpr svneol=native#text/plain +examples/multithreading/waitforexample1.lpi svneol=native#text/plain +examples/multithreading/waitforexample1.lpr svneol=native#text/plain +examples/multithreading/waitforunit1.lfm svneol=native#text/plain +examples/multithreading/waitforunit1.lrs svneol=native#text/plain +examples/multithreading/waitforunit1.pas svneol=native#text/plain examples/notebk.lpi svneol=native#text/plain examples/notebk.pp svneol=native#text/pascal examples/notebku.pp svneol=native#text/pascal diff --git a/examples/multithreading/criticalsectionexample1.lpi b/examples/multithreading/criticalsectionexample1.lpi new file mode 100644 index 0000000000..1b0245df9a --- /dev/null +++ b/examples/multithreading/criticalsectionexample1.lpi @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/multithreading/criticalsectionexample1.lpr b/examples/multithreading/criticalsectionexample1.lpr new file mode 100644 index 0000000000..63608e5e7f --- /dev/null +++ b/examples/multithreading/criticalsectionexample1.lpr @@ -0,0 +1,18 @@ +program CriticalSectionExample1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, CriticalSectionUnit1; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/examples/multithreading/criticalsectionunit1.lfm b/examples/multithreading/criticalsectionunit1.lfm new file mode 100644 index 0000000000..5647a70364 --- /dev/null +++ b/examples/multithreading/criticalsectionunit1.lfm @@ -0,0 +1,43 @@ +object Form1: TForm1 + Caption = 'Form1' + ClientHeight = 169 + ClientWidth = 312 + PixelsPerInch = 75 + HorzScrollBar.Page = 311 + VertScrollBar.Page = 168 + Left = 286 + Height = 169 + Top = 202 + Width = 312 + object Label1: TLabel + Caption = 'Label1' + Color = clNone + ParentColor = False + Left = 43 + Height = 17 + Top = 125 + Width = 65 + end + object CountWithCritSecButton: TButton + AutoSize = True + BorderSpacing.InnerBorder = 4 + Caption = 'Count with critical section' + OnClick = CountWithCritSecButtonClick + TabOrder = 0 + Left = 40 + Height = 26 + Top = 24 + Width = 158 + end + object CountWithoutCritSecButton: TButton + AutoSize = True + BorderSpacing.InnerBorder = 4 + Caption = 'Count without critical section' + OnClick = CountWithoutCritSecButtonClick + TabOrder = 1 + Left = 40 + Height = 26 + Top = 64 + Width = 175 + end +end diff --git a/examples/multithreading/criticalsectionunit1.lrs b/examples/multithreading/criticalsectionunit1.lrs new file mode 100644 index 0000000000..02a5499c47 --- /dev/null +++ b/examples/multithreading/criticalsectionunit1.lrs @@ -0,0 +1,16 @@ +{ Dies ist eine automatisch erzeugte Lazarus-Ressourcendatei } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#7'Caption'#6#5'Form1'#12'ClientHeight'#3#169#0#11'C' + +'lientWidth'#3'8'#1#13'PixelsPerInch'#2'K'#18'HorzScrollBar.Page'#3'7'#1#18 + +'VertScrollBar.Page'#3#168#0#4'Left'#3#30#1#6'Height'#3#169#0#3'Top'#3#202#0 + +#5'Width'#3'8'#1#0#6'TLabel'#6'Label1'#7'Caption'#6#6'Label1'#5'Color'#7#6'c' + +'lNone'#11'ParentColor'#8#4'Left'#2'+'#6'Height'#2#17#3'Top'#2'}'#5'Width'#2 + +'A'#0#0#7'TButton'#22'CountWithCritSecButton'#8'AutoSize'#9#25'BorderSpacing' + +'.InnerBorder'#2#4#7'Caption'#6#27'Count with critical section'#7'OnClick'#7 + +#27'CountWithCritSecButtonClick'#8'TabOrder'#2#0#4'Left'#2'('#6'Height'#2#26 + +#3'Top'#2#24#5'Width'#3#158#0#0#0#7'TButton'#25'CountWithoutCritSecButton'#8 + +'AutoSize'#9#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#30'Count without' + +' critical section'#7'OnClick'#7#30'CountWithoutCritSecButtonClick'#8'TabOrd' + +'er'#2#1#4'Left'#2'('#6'Height'#2#26#3'Top'#2'@'#5'Width'#3#175#0#0#0#0 +]); diff --git a/examples/multithreading/criticalsectionunit1.pas b/examples/multithreading/criticalsectionunit1.pas new file mode 100644 index 0000000000..1819a98018 --- /dev/null +++ b/examples/multithreading/criticalsectionunit1.pas @@ -0,0 +1,147 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + Abstract: + Demo to show how 5 threads increases a counter. + With and without critical sections. + + With critical sections you will always get 50000. + Without you will see different results on each run and depending on your + system. +} +unit CriticalSectionUnit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, + StdCtrls, LCLProc, LCLType, LCLIntf; + +type + + { TMyThread } + + TMyThread = class(TThread) + public + procedure Execute; override; + property Finished: boolean read FFinished write FFinished; + end; + + { TForm1 } + + TForm1 = class(TForm) + CountWithoutCritSecButton: TButton; + CountWithCritSecButton: TButton; + Label1: TLabel; + procedure CountWithCritSecButtonClick(Sender: TObject); + procedure CountWithoutCritSecButtonClick(Sender: TObject); + private + public + CriticalSection: TCriticalSection; + Counter: integer; + UseCriticalSection: boolean; + procedure DoCounting; + end; + +var + Form1: TForm1; + +implementation + +{ TForm1 } + +procedure TForm1.CountWithCritSecButtonClick(Sender: TObject); +begin + UseCriticalSection:=true; + DoCounting; +end; + +procedure TForm1.CountWithoutCritSecButtonClick(Sender: TObject); +begin + UseCriticalSection:=false; + DoCounting; +end; + +procedure TForm1.DoCounting; +var + i: Integer; + Threads: array[1..5] of TMyThread; + AllFinished: Boolean; +begin + Counter:=0; + + // create the CriticalSection + InitializeCriticalSection(CriticalSection); + + // start 5 threads + for i:=Low(Threads) to High(Threads) do + Threads[i]:=TMyThread.Create(false); + // wait till all threads finished + repeat + AllFinished:=true; + for i:=Low(Threads) to High(Threads) do + if not Threads[i].Finished then AllFinished:=false; + until AllFinished; + // free the threads + for i:=Low(Threads) to High(Threads) do + Threads[i].Free; + + // free the CriticalSection + DeleteCriticalSection(CriticalSection); + + // show the Counter + Label1.Caption:='Counter='+IntToStr(Counter); +end; + +{ TMyThread } + +procedure TMyThread.Execute; +var + i: Integer; + CurCounter: LongInt; + j: Integer; +begin + // increment the counter many times + // Because the other threads are doing the same, it will frequently happen, + // that 2 (or more) threads read the same number, increment it by one and + // write the result back, overwriting the result of the other threads. + for i:=1 to 100000 do begin + if Form1.UseCriticalSection then + EnterCriticalSection(Form1.CriticalSection); + try + CurCounter:=Form1.Counter; + for j:=1 to 1000 do ; + inc(CurCounter); + Form1.Counter:=CurCounter; + finally + if Form1.UseCriticalSection then + LeaveCriticalSection(Form1.CriticalSection); + end; + end; + Finished:=true; +end; + +initialization + {$I criticalsectionunit1.lrs} + +end. + diff --git a/examples/multithreading/mainunit.pas b/examples/multithreading/mainunit.pas index bc6827e884..a21d84b14a 100644 --- a/examples/multithreading/mainunit.pas +++ b/examples/multithreading/mainunit.pas @@ -17,6 +17,12 @@ * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** + + Abstract: + Demo to show, how to start a thread and how synchronize with the main + thread. + Important: The cthread unint must be added to the uses section of the .lpr + file. See multithreadingexample1.lpr. } unit MainUnit; @@ -60,18 +66,21 @@ procedure TForm1.FormCreate(Sender: TObject); var MyThread : TMyThread; begin - MyThread := TMyThread.Create(True); // This way it doesn't start automatically - if Assigned(MyThread.FatalException) then - raise MyThread.FatalException; + MyThread := TMyThread.Create(True); // With the True parameter it doesn't start automatically + if Assigned(MyThread.FatalException) then + raise MyThread.FatalException; - // Here the code initialises anything required before the threads starts executing + // Here the code initialises anything required before the threads starts executing - MyThread.Resume; + MyThread.Resume; end; { TMyThread } procedure TMyThread.ShowStatus; +// this method is only called by Synchronize(@ShowStatus) and therefore +// executed by the main thread +// The main thread can access GUI elements, for example Form1.Caption. begin Form1.Caption := fStatusText; end; @@ -80,13 +89,13 @@ procedure TMyThread.Execute; var newStatus : string; begin - fStatusText := 'Starting...'; + fStatusText := 'TMyThread Starting...'; Synchronize(@Showstatus); - fStatusText := 'Running...'; + fStatusText := 'TMyThread Running...'; while (not Terminated) and (true {any condition required}) do begin //here goes the code of the main thread loop - newStatus:='Time: '+FormatDateTime('YYYY-MM-DD HH:NN:SS',Now); + newStatus:='TMyThread Time: '+FormatDateTime('YYYY-MM-DD HH:NN:SS',Now); if NewStatus <> fStatusText then begin fStatusText := newStatus; diff --git a/examples/multithreading/multithreadingexample1.lpi b/examples/multithreading/multithreadingexample1.lpi index bfd1af89b1..822fd3b86a 100644 --- a/examples/multithreading/multithreadingexample1.lpi +++ b/examples/multithreading/multithreadingexample1.lpi @@ -6,12 +6,11 @@ + - - diff --git a/examples/multithreading/multithreadingexample1.lpr b/examples/multithreading/multithreadingexample1.lpr index 5edd2a3e32..181cbf27c5 100644 --- a/examples/multithreading/multithreadingexample1.lpr +++ b/examples/multithreading/multithreadingexample1.lpr @@ -3,12 +3,13 @@ program MultiThreadingExample1; {$mode objfpc}{$H+} uses + // for multi threading the cthreads unit must be used on unix systems: + // for example: Linux, MacOSX, FreeBSD, Solaris {$IFDEF UNIX} cthreads, {$ENDIF} Interfaces, // this includes the LCL widgetset - Forms - { add your units here }, MainUnit; + Forms, MainUnit; begin Application.Initialize; diff --git a/examples/multithreading/processmessagesunit1.lfm b/examples/multithreading/processmessagesunit1.lfm new file mode 100644 index 0000000000..cf7e0b834c --- /dev/null +++ b/examples/multithreading/processmessagesunit1.lfm @@ -0,0 +1,34 @@ +object Form1: TForm1 + Caption = 'Form1' + ClientHeight = 142 + ClientWidth = 303 + OnCreate = FormCreate + PixelsPerInch = 75 + HorzScrollBar.Page = 302 + VertScrollBar.Page = 141 + Left = 286 + Height = 142 + Top = 202 + Width = 303 + object StartStopButton: TButton + Anchors = [akTop] + BorderSpacing.InnerBorder = 4 + Caption = 'Start' + OnClick = StartStopButtonClick + TabOrder = 0 + Left = 72 + Height = 25 + Top = 40 + Width = 158 + end + object ProgressBar1: TProgressBar + Anchors = [akTop, akLeft, akRight] + Max = 1000 + Smooth = True + Step = 1 + Left = 32 + Height = 20 + Top = 88 + Width = 244 + end +end diff --git a/examples/multithreading/processmessagesunit1.lrs b/examples/multithreading/processmessagesunit1.lrs new file mode 100644 index 0000000000..9b6a9e3db7 --- /dev/null +++ b/examples/multithreading/processmessagesunit1.lrs @@ -0,0 +1,14 @@ +{ Dies ist eine automatisch erzeugte Lazarus-Ressourcendatei } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#7'Caption'#6#5'Form1'#12'ClientHeight'#3#142#0#11'C' + +'lientWidth'#3'/'#1#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'K'#18'H' + +'orzScrollBar.Page'#3'.'#1#18'VertScrollBar.Page'#3#141#0#4'Left'#3#30#1#6'H' + +'eight'#3#142#0#3'Top'#3#202#0#5'Width'#3'/'#1#0#7'TButton'#15'StartStopButt' + +'on'#7'Anchors'#11#5'akTop'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6 + +#5'Start'#7'OnClick'#7#20'StartStopButtonClick'#8'TabOrder'#2#0#4'Left'#2'H' + +#6'Height'#2#25#3'Top'#2'('#5'Width'#3#158#0#0#0#12'TProgressBar'#12'Progres' + +'sBar1'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#3'Max'#3#232#3#6'Smoot' + +'h'#9#4'Step'#2#1#4'Left'#2' '#6'Height'#2#20#3'Top'#2'X'#5'Width'#3#244#0#0 + +#0#0 +]); diff --git a/examples/multithreading/processmessagesunit1.pas b/examples/multithreading/processmessagesunit1.pas new file mode 100644 index 0000000000..83b604778f --- /dev/null +++ b/examples/multithreading/processmessagesunit1.pas @@ -0,0 +1,138 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + Abstract: + Demo to show, how to process a big file with the main thread. +} +unit ProcessMessagesUnit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, + ComCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + ProgressBar1: TProgressBar; + StartStopButton: TButton; + procedure FormCreate(Sender: TObject); + procedure StartStopButtonClick(Sender: TObject); + private + procedure Run; + procedure UpdateButton; + public + Running: boolean; + Aborting: boolean; + Filename: String; + end; + +var + Form1: TForm1; + +implementation + +{ TForm1 } + +procedure TForm1.FormCreate(Sender: TObject); +begin + Filename:='processmessagesunit1.pas'; +end; + +procedure TForm1.StartStopButtonClick(Sender: TObject); +begin + if not Running then + Run + else + Aborting:=true; +end; + +procedure TForm1.Run; +var + fs: TFileStream; + Buffer: string; + Count: LongInt; + i: Integer; + Last: TDateTime; +begin + if Running then exit; + Running:=true; + UpdateButton; + try + // open a file + fs:=TFileStream.Create(Filename,fmOpenRead); + try + SetLength(Buffer,10); + while true do begin + + // process all user events, like clicking on the button + Application.ProcessMessages; + if Aborting or Application.Terminated then break; + + // read some bytes + Count:=fs.Read(Buffer[1],length(Buffer)); + if Count=0 then break; + + // process ... + for i:=1 to Count do begin + Last:=Now; + repeat + until Now-Last>(double(1)/fs.Size)/10000; + end; + + // show progress + ProgressBar1.Position:=ProgressBar1.Min + +((ProgressBar1.Max-ProgressBar1.Min+1)*fs.Position) div fs.Size; + end; + finally + fs.Free; + end; + except + on E: Exception do begin + MessageDlg('Error',E.Message,mtError,[mbCancel],0); + end; + end; + Aborting:=false; + Running:=false; + UpdateButton; +end; + +procedure TForm1.UpdateButton; +begin + if Running then begin + if Aborting then + StartStopButton.Caption:='Aborting ...' + else + StartStopButton.Caption:='Running ...'; + end else begin + StartStopButton.Caption:='Start'; + end; +end; + +initialization + {$I processmessagesunit1.lrs} + +end. + diff --git a/examples/multithreading/singlethreadingexample1.lpi b/examples/multithreading/singlethreadingexample1.lpi new file mode 100644 index 0000000000..2f83dab9d5 --- /dev/null +++ b/examples/multithreading/singlethreadingexample1.lpi @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/multithreading/singlethreadingexample1.lpr b/examples/multithreading/singlethreadingexample1.lpr new file mode 100644 index 0000000000..d3f93f4bc8 --- /dev/null +++ b/examples/multithreading/singlethreadingexample1.lpr @@ -0,0 +1,18 @@ +program SingleThreadingExample1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, ProcessMessagesUnit1; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/examples/multithreading/waitforexample1.lpi b/examples/multithreading/waitforexample1.lpi new file mode 100644 index 0000000000..aed2660d2e --- /dev/null +++ b/examples/multithreading/waitforexample1.lpi @@ -0,0 +1,244 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/multithreading/waitforexample1.lpr b/examples/multithreading/waitforexample1.lpr new file mode 100644 index 0000000000..0bf10e2935 --- /dev/null +++ b/examples/multithreading/waitforexample1.lpr @@ -0,0 +1,18 @@ +program WaitForExample1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, WaitForUnit1; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/examples/multithreading/waitforunit1.lfm b/examples/multithreading/waitforunit1.lfm new file mode 100644 index 0000000000..7c0e6ad244 --- /dev/null +++ b/examples/multithreading/waitforunit1.lfm @@ -0,0 +1,32 @@ +object Form1: TForm1 + ActiveControl = Button1 + Caption = 'Form1' + ClientHeight = 359 + ClientWidth = 394 + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 75 + HorzScrollBar.Page = 393 + VertScrollBar.Page = 358 + Left = 286 + Height = 359 + Top = 202 + Width = 394 + object Button1: TButton + BorderSpacing.InnerBorder = 4 + Caption = 'Start' + OnClick = Button1Click + TabOrder = 0 + Left = 32 + Height = 25 + Top = 16 + Width = 75 + end + object Memo1: TMemo + Align = alBottom + TabOrder = 1 + Height = 303 + Top = 56 + Width = 394 + end +end diff --git a/examples/multithreading/waitforunit1.lrs b/examples/multithreading/waitforunit1.lrs new file mode 100644 index 0000000000..68fdba2831 --- /dev/null +++ b/examples/multithreading/waitforunit1.lrs @@ -0,0 +1,13 @@ +{ Dies ist eine automatisch erzeugte Lazarus-Ressourcendatei } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1' + +#12'ClientHeight'#3'g'#1#11'ClientWidth'#3#138#1#8'OnCreate'#7#10'FormCreate' + +#9'OnDestroy'#7#11'FormDestroy'#13'PixelsPerInch'#2'K'#18'HorzScrollBar.Page' + +#3#137#1#18'VertScrollBar.Page'#3'f'#1#4'Left'#3#30#1#6'Height'#3'g'#1#3'Top' + +#3#202#0#5'Width'#3#138#1#0#7'TButton'#7'Button1'#25'BorderSpacing.InnerBord' + +'er'#2#4#7'Caption'#6#5'Start'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0 + +#4'Left'#2' '#6'Height'#2#25#3'Top'#2#16#5'Width'#2'K'#0#0#5'TMemo'#5'Memo1' + +#5'Align'#7#8'alBottom'#8'TabOrder'#2#1#6'Height'#3'/'#1#3'Top'#2'8'#5'Width' + +#3#138#1#0#0#0 +]); diff --git a/examples/multithreading/waitforunit1.pas b/examples/multithreading/waitforunit1.pas new file mode 100644 index 0000000000..e73a764fda --- /dev/null +++ b/examples/multithreading/waitforunit1.pas @@ -0,0 +1,162 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + Abstract: + Demo to show, how a Thread waits for another. +} +unit WaitForUnit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, + StdCtrls, LCLProc; + +type + + { TBaseThread } + + TBaseThread = class(TThread) + public + procedure Log(const Msg: string; AppendLineEnd: boolean = true); + end; + + { TThreadA } + + TThreadA = class(TBaseThread) + public + WaitForB: PRtlEvent; + procedure Execute; override; + end; + + { TThreadB } + + TThreadB = class(TBaseThread) + private + FCounter: integer; + public + procedure Execute; override; + property Counter: integer read FCounter write FCounter; + end; + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + Memo1: TMemo; + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + private + ACriticalSection: TRTLCriticalSection; + MsgText: string; + procedure AddMessage; + public + ThreadA: TThreadA; + ThreadB: TThreadB; + end; + +var + Form1: TForm1; + +implementation + +{ TForm1 } + +procedure TForm1.Button1Click(Sender: TObject); +begin + if ThreadA=nil then + ThreadA:=TThreadA.Create(false); +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + InitCriticalSection(ACriticalSection); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + DoneCriticalsection(ACriticalSection); +end; + +procedure TForm1.AddMessage; +begin + Memo1.Lines.Text:=MsgText; +end; + +{ TThreadA } + +procedure TThreadA.Execute; +begin + Form1.ThreadB:=TThreadB.Create(false); + // create event + WaitForB:=RTLEventCreate; + while not Application.Terminated do begin + Log('A: wait for B ...'); + // wait infinitely (until B wakes A) + RtlEventWaitFor(WaitForB); + Log('A: ThreadB.Counter='+IntToStr(Form1.ThreadB.Counter)); + end; +end; + +{ TThreadB } + +procedure TThreadB.Execute; +var + i: Integer; +begin + Counter:=0; + while not Application.Terminated do begin + Log('B: Working ...'); + for i:=1 to 5 do begin + Sleep(300); + Log('..... ',false); + end; + Log(''); + inc(Counter); + Log('B: Wake A'); + // wake A + RtlEventSetEvent(Form1.ThreadA.WaitForB); + end; +end; + +{ TBaseThread } + +procedure TBaseThread.Log(const Msg: string; AppendLineEnd: boolean); +var + s: String; +begin + EnterCriticalsection(Form1.ACriticalSection); + s:=Msg; + if AppendLineEnd then + s:=s+LineEnding; + dbgout(s); + Form1.MsgText:=Form1.MsgText+s; + Synchronize(@Form1.AddMessage); + LeaveCriticalsection(Form1.ACriticalSection); +end; + +initialization + {$I waitforunit1.lrs} + +end. +