mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 02:36:23 +02:00
examples: Added Application.QueueAsyncCall example as alternative for using PostMessage
git-svn-id: trunk@14039 -
This commit is contained in:
parent
ae7e221cc7
commit
806b9cac81
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -1719,9 +1719,14 @@ examples/memotest.lpi svneol=native#text/plain
|
|||||||
examples/memotest.pp svneol=native#text/pascal
|
examples/memotest.pp svneol=native#text/pascal
|
||||||
examples/messagedialogs.lpi svneol=native#text/plain
|
examples/messagedialogs.lpi svneol=native#text/plain
|
||||||
examples/messagedialogs.pp svneol=native#text/pascal
|
examples/messagedialogs.pp svneol=native#text/pascal
|
||||||
|
examples/messages/asynccall.lpi svneol=native#text/plain
|
||||||
|
examples/messages/asynccall.lpr svneol=native#text/plain
|
||||||
examples/messages/project1.lpi svneol=native#text/plain
|
examples/messages/project1.lpi svneol=native#text/plain
|
||||||
examples/messages/project1.lpr svneol=native#text/pascal
|
examples/messages/project1.lpr svneol=native#text/pascal
|
||||||
examples/messages/readme.txt svneol=native#text/plain
|
examples/messages/readme.txt svneol=native#text/plain
|
||||||
|
examples/messages/uasynccall.lfm svneol=native#text/plain
|
||||||
|
examples/messages/uasynccall.lrs svneol=native#text/plain
|
||||||
|
examples/messages/uasynccall.pas svneol=native#text/plain
|
||||||
examples/messages/unit1.lfm svneol=native#text/plain
|
examples/messages/unit1.lfm svneol=native#text/plain
|
||||||
examples/messages/unit1.lrs svneol=native#text/pascal
|
examples/messages/unit1.lrs svneol=native#text/pascal
|
||||||
examples/messages/unit1.pas svneol=native#text/pascal
|
examples/messages/unit1.pas svneol=native#text/pascal
|
||||||
|
65
examples/messages/asynccall.lpi
Normal file
65
examples/messages/asynccall.lpi
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Version Value="6"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InIDEConfig"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<IconPath Value="./"/>
|
||||||
|
<TargetFileExt Value=".exe"/>
|
||||||
|
<Title Value="AsyncCall"/>
|
||||||
|
</General>
|
||||||
|
<VersionInfo>
|
||||||
|
<ProjectVersion Value=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<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="asynccall.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="asynccall"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="uasynccall.pas"/>
|
||||||
|
<ComponentName Value="Form1"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="uasynccall.lrs"/>
|
||||||
|
<UnitName Value="uasynccall"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Generate Value="Faster"/>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
</CONFIG>
|
19
examples/messages/asynccall.lpr
Normal file
19
examples/messages/asynccall.lpr
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
program asynccall;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms
|
||||||
|
{ you can add units after this }, uasynccall;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Title:='AsyncCall';
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
@ -4,15 +4,13 @@
|
|||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<Version Value="6"/>
|
<Version Value="6"/>
|
||||||
<General>
|
<General>
|
||||||
|
<SessionStorage Value="InIDEConfig"/>
|
||||||
<MainUnit Value="0"/>
|
<MainUnit Value="0"/>
|
||||||
<IconPath Value="./"/>
|
<IconPath Value="./"/>
|
||||||
<TargetFileExt Value=".exe"/>
|
<TargetFileExt Value=".exe"/>
|
||||||
<ActiveEditorIndexAtStart Value="0"/>
|
|
||||||
</General>
|
</General>
|
||||||
<VersionInfo>
|
<VersionInfo>
|
||||||
<ProjectVersion Value=""/>
|
<ProjectVersion Value=""/>
|
||||||
<Language Value=""/>
|
|
||||||
<CharSet Value=""/>
|
|
||||||
</VersionInfo>
|
</VersionInfo>
|
||||||
<PublishOptions>
|
<PublishOptions>
|
||||||
<Version Value="2"/>
|
<Version Value="2"/>
|
||||||
@ -36,7 +34,6 @@
|
|||||||
<Filename Value="project1.lpr"/>
|
<Filename Value="project1.lpr"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="project1"/>
|
<UnitName Value="project1"/>
|
||||||
<UsageCount Value="20"/>
|
|
||||||
</Unit0>
|
</Unit0>
|
||||||
<Unit1>
|
<Unit1>
|
||||||
<Filename Value="unit1.pas"/>
|
<Filename Value="unit1.pas"/>
|
||||||
@ -44,14 +41,8 @@
|
|||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<ResourceFilename Value="unit1.lrs"/>
|
<ResourceFilename Value="unit1.lrs"/>
|
||||||
<UnitName Value="Unit1"/>
|
<UnitName Value="Unit1"/>
|
||||||
<CursorPos X="20" Y="50"/>
|
|
||||||
<TopLine Value="48"/>
|
|
||||||
<EditorIndex Value="0"/>
|
|
||||||
<UsageCount Value="20"/>
|
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit1>
|
</Unit1>
|
||||||
</Units>
|
</Units>
|
||||||
<JumpHistory Count="0" HistoryIndex="-1"/>
|
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
<Version Value="5"/>
|
<Version Value="5"/>
|
||||||
@ -70,32 +61,4 @@
|
|||||||
<CompilerPath Value="$(CompPath)"/>
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
</Other>
|
</Other>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Debugging>
|
|
||||||
<BreakPoints Count="2">
|
|
||||||
<Item1>
|
|
||||||
<Source Value="..\..\lcl\include\winapi.inc"/>
|
|
||||||
<Line Value="79"/>
|
|
||||||
</Item1>
|
|
||||||
<Item2>
|
|
||||||
<Source Value="..\..\lcl\include\winapi.inc"/>
|
|
||||||
<Line Value="87"/>
|
|
||||||
</Item2>
|
|
||||||
</BreakPoints>
|
|
||||||
<Watches Count="2">
|
|
||||||
<Item1>
|
|
||||||
<Expression Value="x"/>
|
|
||||||
</Item1>
|
|
||||||
<Item2>
|
|
||||||
<Expression Value="y"/>
|
|
||||||
</Item2>
|
|
||||||
</Watches>
|
|
||||||
<Exceptions Count="2">
|
|
||||||
<Item1>
|
|
||||||
<Name Value="ECodetoolError"/>
|
|
||||||
</Item1>
|
|
||||||
<Item2>
|
|
||||||
<Name Value="EFOpenError"/>
|
|
||||||
</Item2>
|
|
||||||
</Exceptions>
|
|
||||||
</Debugging>
|
|
||||||
</CONFIG>
|
</CONFIG>
|
||||||
|
@ -1,5 +1,7 @@
|
|||||||
This example demonstrates the usage of PostMessage, SendMessage and the message methods in Lazarus and FreePascal.
|
These example demonstrates the usage of PostMessage, SendMessage and the message methods in Lazarus and FreePascal and its widgetset independent counterpart, the direct method call and QueueAsyncCall
|
||||||
|
|
||||||
|
SendMessage and PostMessage
|
||||||
|
===========================
|
||||||
PostMessage and SendMessage are not fully compatible with windows. For example passing windows messages to
|
PostMessage and SendMessage are not fully compatible with windows. For example passing windows messages to
|
||||||
controls will not do anything except pass the message along to a message handler (for example if you pass
|
controls will not do anything except pass the message along to a message handler (for example if you pass
|
||||||
WM_PAINT to a control it will not paint itself).
|
WM_PAINT to a control it will not paint itself).
|
||||||
@ -12,4 +14,10 @@ be processed.
|
|||||||
|
|
||||||
Please do not use any messages in the Windows system range. Use only messages >= LM_USER.
|
Please do not use any messages in the Windows system range. Use only messages >= LM_USER.
|
||||||
|
|
||||||
|
Direct method call and QueueAsyncCall
|
||||||
|
=====================================
|
||||||
|
If all you are interested it to delay the execution of a method until after an event handler has finished, then Application.QueueAsyncCall is a good alternative. More information about QueueAsyncCall can be found at http://wiki.lazarus.freepascal.org/Asynchronous_Calls
|
||||||
|
|
||||||
|
The AsyncCall example shows the use of QueueAsyncCall.
|
||||||
|
|
||||||
For more info read the comments in the code.
|
For more info read the comments in the code.
|
||||||
|
86
examples/messages/uasynccall.lfm
Normal file
86
examples/messages/uasynccall.lfm
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 290
|
||||||
|
Height = 300
|
||||||
|
Top = 155
|
||||||
|
Width = 400
|
||||||
|
HorzScrollBar.Page = 399
|
||||||
|
VertScrollBar.Page = 299
|
||||||
|
Caption = 'QueueAsyncCall example'
|
||||||
|
ClientHeight = 300
|
||||||
|
ClientWidth = 400
|
||||||
|
object Button1: TButton
|
||||||
|
AnchorSideLeft.Control = Owner
|
||||||
|
AnchorSideTop.Control = Owner
|
||||||
|
Left = 4
|
||||||
|
Height = 25
|
||||||
|
Top = 4
|
||||||
|
Width = 124
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Direct call'
|
||||||
|
OnClick = Button1Click
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object Button2: TButton
|
||||||
|
AnchorSideLeft.Control = Owner
|
||||||
|
AnchorSideTop.Control = Button1
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = Button1
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 4
|
||||||
|
Height = 25
|
||||||
|
Top = 33
|
||||||
|
Width = 124
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
Caption = 'Async call'
|
||||||
|
OnClick = Button2Click
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object Memo1: TMemo
|
||||||
|
AnchorSideLeft.Control = Button1
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = Owner
|
||||||
|
AnchorSideRight.Control = Owner
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = Owner
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 132
|
||||||
|
Height = 292
|
||||||
|
Top = 4
|
||||||
|
Width = 264
|
||||||
|
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
ReadOnly = True
|
||||||
|
ScrollBars = ssAutoBoth
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object RadioGroup1: TRadioGroup
|
||||||
|
AnchorSideLeft.Control = Button2
|
||||||
|
AnchorSideRight.Control = Button2
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 4
|
||||||
|
Height = 72
|
||||||
|
Top = 75
|
||||||
|
Width = 124
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
AutoFill = True
|
||||||
|
Caption = 'Parameters'
|
||||||
|
ChildSizing.LeftRightSpacing = 6
|
||||||
|
ChildSizing.TopBottomSpacing = 6
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 54
|
||||||
|
ClientWidth = 120
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'Integer (simple)'
|
||||||
|
'Record (advanced)'
|
||||||
|
)
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
end
|
35
examples/messages/uasynccall.lrs
Normal file
35
examples/messages/uasynccall.lrs
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
{ This is an automatically generated lazarus resource file }
|
||||||
|
|
||||||
|
LazarusResources.Add('TForm1','FORMDATA',[
|
||||||
|
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#155#0#5'Wi'
|
||||||
|
+'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#7
|
||||||
|
+'Caption'#6#22'QueueAsyncCall example'#12'ClientHeight'#3','#1#11'ClientWidt'
|
||||||
|
+'h'#3#144#1#0#7'TButton'#7'Button1'#22'AnchorSideLeft.Control'#7#5'Owner'#21
|
||||||
|
+'AnchorSideTop.Control'#7#5'Owner'#4'Left'#2#4#6'Height'#2#25#3'Top'#2#4#5'W'
|
||||||
|
+'idth'#2'|'#20'BorderSpacing.Around'#2#4#7'Caption'#6#11'Direct call'#7'OnCl'
|
||||||
|
+'ick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#22'Anchor'
|
||||||
|
+'SideLeft.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#7'Button1'#18'Anch'
|
||||||
|
+'orSideTop.Side'#7#9'asrBottom'#23'AnchorSideRight.Control'#7#7'Button1'#20
|
||||||
|
+'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#2#4#6'Height'#2#25#3'Top'#2'!'
|
||||||
|
+#5'Width'#2'|'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#18'BorderSpacin'
|
||||||
|
+'g.Left'#2#4#17'BorderSpacing.Top'#2#4#7'Caption'#6#10'Async call'#7'OnClick'
|
||||||
|
+#7#12'Button2Click'#8'TabOrder'#2#1#0#0#5'TMemo'#5'Memo1'#22'AnchorSideLeft.'
|
||||||
|
+'Control'#7#7'Button1'#19'AnchorSideLeft.Side'#7#9'asrBottom'#21'AnchorSideT'
|
||||||
|
+'op.Control'#7#5'Owner'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSide'
|
||||||
|
+'Right.Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#5'Owner'#21'Ancho'
|
||||||
|
+'rSideBottom.Side'#7#9'asrBottom'#4'Left'#3#132#0#6'Height'#3'$'#1#3'Top'#2#4
|
||||||
|
+#5'Width'#3#8#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#20
|
||||||
|
+'BorderSpacing.Around'#2#4#8'ReadOnly'#9#10'ScrollBars'#7#10'ssAutoBoth'#8'T'
|
||||||
|
+'abOrder'#2#2#0#0#11'TRadioGroup'#11'RadioGroup1'#22'AnchorSideLeft.Control'
|
||||||
|
+#7#7'Button2'#23'AnchorSideRight.Control'#7#7'Button2'#20'AnchorSideRight.Si'
|
||||||
|
+'de'#7#9'asrBottom'#4'Left'#2#4#6'Height'#2'H'#3'Top'#2'K'#5'Width'#2'|'#7'A'
|
||||||
|
+'nchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'AutoFill'#9#7'Caption'#6#10'Pa'
|
||||||
|
+'rameters'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpac'
|
||||||
|
+'ing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27
|
||||||
|
+'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.'
|
||||||
|
+'ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14
|
||||||
|
+'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'
|
||||||
|
+#27'ChildSizing.ControlsPerLine'#2#1#12'ClientHeight'#2'6'#11'ClientWidth'#2
|
||||||
|
+'x'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#16'Integer (simple)'#6#17'Record '
|
||||||
|
+'(advanced)'#0#8'TabOrder'#2#3#0#0#0
|
||||||
|
]);
|
130
examples/messages/uasynccall.pas
Normal file
130
examples/messages/uasynccall.pas
Normal file
@ -0,0 +1,130 @@
|
|||||||
|
unit uasynccall;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
ExtCtrls;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
Button1: TButton;
|
||||||
|
Button2: TButton;
|
||||||
|
Memo1: TMemo;
|
||||||
|
RadioGroup1: TRadioGroup;
|
||||||
|
procedure Button1Click(Sender: TObject);
|
||||||
|
procedure Button2Click(Sender: TObject);
|
||||||
|
private
|
||||||
|
procedure SimpleMethod(Data: PtrInt);
|
||||||
|
procedure ComplexMethod(Data: PtrInt);
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
type
|
||||||
|
TMyData = record
|
||||||
|
S: string;
|
||||||
|
data: longint;
|
||||||
|
end;
|
||||||
|
PMyData = ^TMyData;
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
procedure TForm1.Button1Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
MyData: PMyData;
|
||||||
|
begin
|
||||||
|
{
|
||||||
|
A direct call, calls the method directly and is executed before the
|
||||||
|
Button1Click is finished.
|
||||||
|
|
||||||
|
As result you will see in memo such lines:
|
||||||
|
1. Sending message
|
||||||
|
2. Got message
|
||||||
|
3. Exiting Button.Click()
|
||||||
|
}
|
||||||
|
Memo1.Lines.Add('--------------------------------');
|
||||||
|
Memo1.Lines.Add('Sending message by <Direct call>');
|
||||||
|
case RadioGroup1.ItemIndex of
|
||||||
|
0 : SimpleMethod(1);
|
||||||
|
1 :
|
||||||
|
begin
|
||||||
|
new(MyData);
|
||||||
|
MyData^.data:=1;
|
||||||
|
MyData^.S:= 'direct call';
|
||||||
|
ComplexMethod(PtrInt(MyData));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Memo1.Lines.Add('Exiting Button.Click()');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button2Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
MyData: PMyData;
|
||||||
|
begin
|
||||||
|
{
|
||||||
|
QueueAsyncCall queues the method call, so you will get it only
|
||||||
|
after other events have been processed.
|
||||||
|
You can use QueueAsyncCall to postpone some
|
||||||
|
operations, for example until the application is idle.
|
||||||
|
|
||||||
|
As result you will see in memo such lines:
|
||||||
|
1. Sending message
|
||||||
|
2. Exiting Button.Click()
|
||||||
|
3. Got message
|
||||||
|
}
|
||||||
|
Memo1.Lines.Add('--------------------------------');
|
||||||
|
Memo1.Lines.Add('Sending message by QueueAsyncCall');
|
||||||
|
case RadioGroup1.ItemIndex of
|
||||||
|
0 : Application.QueueAsyncCall(@SimpleMethod, 2);
|
||||||
|
1 :
|
||||||
|
begin
|
||||||
|
new(MyData);
|
||||||
|
MyData^.data:=1;
|
||||||
|
MyData^.S:= 'QueueAsyncCall call';
|
||||||
|
Application.QueueAsyncCall(@ComplexMethod, PtrInt(MyData));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Memo1.Lines.Add('Exiting Button.Click()');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.SimpleMethod(Data: PtrInt);
|
||||||
|
var
|
||||||
|
S: String;
|
||||||
|
begin
|
||||||
|
case Data of
|
||||||
|
1: S := '<DirectCall>';
|
||||||
|
2: S := '<QueueAsyncCall>';
|
||||||
|
else
|
||||||
|
S := '<unknown>'
|
||||||
|
end;
|
||||||
|
Memo1.Lines.Add('SimpleMethod got called using: ' + S);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ComplexMethod(Data: PtrInt);
|
||||||
|
var
|
||||||
|
MyData: TMyData;
|
||||||
|
begin
|
||||||
|
MyData:=PMyData(Data)^;
|
||||||
|
Memo1.Lines.Add(
|
||||||
|
format('Complex got called using %s and data %d',
|
||||||
|
[MyData.S, MyData.Data]));
|
||||||
|
Dispose(PMyData(Data));
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I uasynccall.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -1,5 +1,3 @@
|
|||||||
{ This is an automatically generated lazarus resource file }
|
|
||||||
|
|
||||||
LazarusResources.Add('TForm1','FORMDATA',[
|
LazarusResources.Add('TForm1','FORMDATA',[
|
||||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#155#0#5'Wi'
|
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#155#0#5'Wi'
|
||||||
+'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#7
|
+'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#7
|
||||||
|
Loading…
Reference in New Issue
Block a user