From 806b9cac814a26f7f2e0b841b6ab2c587efb83fa Mon Sep 17 00:00:00 2001 From: vincents Date: Sat, 9 Feb 2008 10:28:14 +0000 Subject: [PATCH] examples: Added Application.QueueAsyncCall example as alternative for using PostMessage git-svn-id: trunk@14039 - --- .gitattributes | 5 ++ examples/messages/asynccall.lpi | 65 ++++++++++++++++ examples/messages/asynccall.lpr | 19 +++++ examples/messages/project1.lpi | 39 +--------- examples/messages/readme.txt | 10 ++- examples/messages/uasynccall.lfm | 86 ++++++++++++++++++++ examples/messages/uasynccall.lrs | 35 +++++++++ examples/messages/uasynccall.pas | 130 +++++++++++++++++++++++++++++++ examples/messages/unit1.lrs | 2 - 9 files changed, 350 insertions(+), 41 deletions(-) create mode 100644 examples/messages/asynccall.lpi create mode 100644 examples/messages/asynccall.lpr create mode 100644 examples/messages/uasynccall.lfm create mode 100644 examples/messages/uasynccall.lrs create mode 100644 examples/messages/uasynccall.pas diff --git a/.gitattributes b/.gitattributes index 437137ba4f..b6fed8ef33 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1719,9 +1719,14 @@ 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/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.lpr svneol=native#text/pascal 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.lrs svneol=native#text/pascal examples/messages/unit1.pas svneol=native#text/pascal diff --git a/examples/messages/asynccall.lpi b/examples/messages/asynccall.lpi new file mode 100644 index 0000000000..8b01442ea9 --- /dev/null +++ b/examples/messages/asynccall.lpi @@ -0,0 +1,65 @@ + + + + + + + + + + + + </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> diff --git a/examples/messages/asynccall.lpr b/examples/messages/asynccall.lpr new file mode 100644 index 0000000000..9e557a2f22 --- /dev/null +++ b/examples/messages/asynccall.lpr @@ -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. + diff --git a/examples/messages/project1.lpi b/examples/messages/project1.lpi index 33be52dfed..4b884e3b6b 100644 --- a/examples/messages/project1.lpi +++ b/examples/messages/project1.lpi @@ -4,15 +4,13 @@ <PathDelim Value="\"/> <Version Value="6"/> <General> + <SessionStorage Value="InIDEConfig"/> <MainUnit Value="0"/> <IconPath Value="./"/> <TargetFileExt Value=".exe"/> - <ActiveEditorIndexAtStart Value="0"/> </General> <VersionInfo> <ProjectVersion Value=""/> - <Language Value=""/> - <CharSet Value=""/> </VersionInfo> <PublishOptions> <Version Value="2"/> @@ -36,7 +34,6 @@ <Filename Value="project1.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="project1"/> - <UsageCount Value="20"/> </Unit0> <Unit1> <Filename Value="unit1.pas"/> @@ -44,14 +41,8 @@ <IsPartOfProject Value="True"/> <ResourceFilename Value="unit1.lrs"/> <UnitName Value="Unit1"/> - <CursorPos X="20" Y="50"/> - <TopLine Value="48"/> - <EditorIndex Value="0"/> - <UsageCount Value="20"/> - <Loaded Value="True"/> </Unit1> </Units> - <JumpHistory Count="0" HistoryIndex="-1"/> </ProjectOptions> <CompilerOptions> <Version Value="5"/> @@ -70,32 +61,4 @@ <CompilerPath Value="$(CompPath)"/> </Other> </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> diff --git a/examples/messages/readme.txt b/examples/messages/readme.txt index 9c0e610692..f490550e7e 100644 --- a/examples/messages/readme.txt +++ b/examples/messages/readme.txt @@ -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 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). @@ -12,4 +14,10 @@ be processed. 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. diff --git a/examples/messages/uasynccall.lfm b/examples/messages/uasynccall.lfm new file mode 100644 index 0000000000..b1319cde01 --- /dev/null +++ b/examples/messages/uasynccall.lfm @@ -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 diff --git a/examples/messages/uasynccall.lrs b/examples/messages/uasynccall.lrs new file mode 100644 index 0000000000..cfe6cf06a0 --- /dev/null +++ b/examples/messages/uasynccall.lrs @@ -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 +]); diff --git a/examples/messages/uasynccall.pas b/examples/messages/uasynccall.pas new file mode 100644 index 0000000000..d73668de65 --- /dev/null +++ b/examples/messages/uasynccall.pas @@ -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. + diff --git a/examples/messages/unit1.lrs b/examples/messages/unit1.lrs index 02d5ec9d72..1dfaa8ac14 100644 --- a/examples/messages/unit1.lrs +++ b/examples/messages/unit1.lrs @@ -1,5 +1,3 @@ -{ 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