mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 05:59:28 +02:00
added multithreading example
git-svn-id: trunk@8790 -
This commit is contained in:
mattias
parent
a43501c484
commit
3d972e14a4
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -886,6 +886,11 @@ 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/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/notebk.lpi svneol=native#text/plain
|
||||
examples/notebk.pp svneol=native#text/pascal
|
||||
examples/notebku.pp svneol=native#text/pascal
|
||||
|
||||
13
examples/multithreading/mainunit.lfm
Normal file
13
examples/multithreading/mainunit.lfm
Normal file
@ -0,0 +1,13 @@
|
||||
object Form1: TForm1
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 73
|
||||
ClientWidth = 408
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 112
|
||||
HorzScrollBar.Page = 407
|
||||
VertScrollBar.Page = 72
|
||||
Left = 290
|
||||
Height = 73
|
||||
Top = 163
|
||||
Width = 408
|
||||
end
|
||||
8
examples/multithreading/mainunit.lrs
Normal file
8
examples/multithreading/mainunit.lrs
Normal file
@ -0,0 +1,8 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#7'Caption'#6#5'Form1'#12'ClientHeight'#2'I'#11'Clie'
|
||||
+'ntWidth'#3#152#1#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'p'#18'Hor'
|
||||
+'zScrollBar.Page'#3#151#1#18'VertScrollBar.Page'#2'H'#4'Left'#3'"'#1#6'Heigh'
|
||||
+'t'#2'I'#3'Top'#3#163#0#5'Width'#3#152#1#0#0
|
||||
]);
|
||||
108
examples/multithreading/mainunit.pas
Normal file
108
examples/multithreading/mainunit.pas
Normal file
@ -0,0 +1,108 @@
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
* 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 <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
}
|
||||
unit MainUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;
|
||||
|
||||
type
|
||||
|
||||
{ TMyThread }
|
||||
|
||||
TMyThread = class(TThread)
|
||||
private
|
||||
fStatusText: string;
|
||||
procedure ShowStatus;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(CreateSuspended: boolean);
|
||||
end;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
public
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
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;
|
||||
|
||||
// Here the code initialises anything required before the threads starts executing
|
||||
|
||||
MyThread.Resume;
|
||||
end;
|
||||
|
||||
{ TMyThread }
|
||||
|
||||
procedure TMyThread.ShowStatus;
|
||||
begin
|
||||
Form1.Caption := fStatusText;
|
||||
end;
|
||||
|
||||
procedure TMyThread.Execute;
|
||||
var
|
||||
newStatus : string;
|
||||
begin
|
||||
fStatusText := 'Starting...';
|
||||
Synchronize(@Showstatus);
|
||||
fStatusText := '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);
|
||||
|
||||
if NewStatus <> fStatusText then begin
|
||||
fStatusText := newStatus;
|
||||
Synchronize(@Showstatus);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TMyThread.Create(CreateSuspended: boolean);
|
||||
begin
|
||||
FreeOnTerminate := True;
|
||||
inherited Create(CreateSuspended);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I mainunit.lrs}
|
||||
|
||||
end.
|
||||
|
||||
63
examples/multithreading/multithreadingexample1.lpi
Normal file
63
examples/multithreading/multithreadingexample1.lpi
Normal file
@ -0,0 +1,63 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="5"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<TargetFileExt Value=""/>
|
||||
</General>
|
||||
<LazDoc Paths=""/>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="multithreadingexample1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="MultiThreadingExample1"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainunit.pas"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceFilename Value="mainunit.lrs"/>
|
||||
<UnitName Value="MainUnit"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<SearchPaths>
|
||||
<SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
18
examples/multithreading/multithreadingexample1.lpr
Normal file
18
examples/multithreading/multithreadingexample1.lpr
Normal file
@ -0,0 +1,18 @@
|
||||
program MultiThreadingExample1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms
|
||||
{ add your units here }, MainUnit;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user