examples: Added Application.QueueAsyncCall example as alternative for using PostMessage

git-svn-id: trunk@14039 -
2025-08-10 18:17:18 +02:00 · 2008-02-09 10:28:14 +00:00 · 2008-02-09 10:28:14 +00:00 · 806b9cac81
commit 806b9cac81
parent ae7e221cc7
9 changed files with 350 additions and 41 deletions
--- 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
--- a/examples/messages/asynccall.lpi
+++ b/examples/messages/asynccall.lpi
@ -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>
--- a/examples/messages/asynccall.lpr
+++ 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.
+
--- 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>
--- 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.
--- a/examples/messages/uasynccall.lfm
+++ 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
--- a/examples/messages/uasynccall.lrs
+++ 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
+]);
--- a/examples/messages/uasynccall.pas
+++ 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.
+
--- 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