PostMessage, SendMessage example

git-svn-id: trunk@13390 -
2025-04-09 08:29:06 +02:00 · 2007-12-19 13:23:08 +00:00 · 2007-12-19 13:23:08 +00:00 · a91d1b1cf3
commit a91d1b1cf3
parent 7e67dd4a12
6 changed files with 331 additions and 0 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -1686,6 +1686,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/messages/project1.lpi svneol=native#text/plain
+examples/messages/project1.lpr svneol=native#text/pascal
+examples/messages/unit1.lfm svneol=native#text/plain
+examples/messages/unit1.lrs svneol=native#text/pascal
+examples/messages/unit1.pas 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
--- a/examples/messages/project1.lpi
+++ b/examples/messages/project1.lpi
@ -0,0 +1,140 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="6"/>
+    <General>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet 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="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="project1"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="unit1.lrs"/>
+        <UnitName Value="Unit1"/>
+        <CursorPos X="4" Y="65"/>
+        <TopLine Value="48"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit1>
+    </Units>
+    <JumpHistory Count="9" HistoryIndex="8">
+      <Position1>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="19" Column="45" TopLine="18"/>
+      </Position1>
+      <Position2>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="24" Column="67" TopLine="17"/>
+      </Position2>
+      <Position3>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="49" Column="5" TopLine="21"/>
+      </Position3>
+      <Position4>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="50" Column="16" TopLine="32"/>
+      </Position4>
+      <Position5>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="46" Column="48" TopLine="34"/>
+      </Position5>
+      <Position6>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="9" Column="12" TopLine="1"/>
+      </Position6>
+      <Position7>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="57" Column="43" TopLine="36"/>
+      </Position7>
+      <Position8>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="39" Column="14" TopLine="27"/>
+      </Position8>
+      <Position9>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="58" Column="27" TopLine="47"/>
+      </Position9>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <LCLWidgetType Value="gtk2"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="2">
+      <Item1>
+        <Source Value="..\..\..\lazarus\lcl\include\winapi.inc"/>
+        <Line Value="79"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\..\..\lazarus\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/project1.lpr
+++ b/examples/messages/project1.lpr
@ -0,0 +1,18 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { you can add units after this }, Unit1;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/examples/messages/unit1.lfm
+++ b/examples/messages/unit1.lfm
@ -0,0 +1,54 @@
+object Form1: TForm1
+  Left = 290
+  Height = 300
+  Top = 155
+  Width = 400
+  HorzScrollBar.Page = 399
+  VertScrollBar.Page = 299
+  Caption = 'Messages example'
+  ClientHeight = 300
+  ClientWidth = 400
+  object Button1: TButton
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    Left = 4
+    Height = 25
+    Top = 4
+    Width = 104
+    BorderSpacing.Around = 4
+    Caption = 'Send Message'
+    OnClick = Button1Click
+    TabOrder = 0
+  end
+  object Button2: TButton
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Button1
+    AnchorSideTop.Side = asrBottom
+    Left = 4
+    Height = 25
+    Top = 33
+    Width = 104
+    BorderSpacing.Around = 4
+    Caption = 'PostMessage'
+    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 = 112
+    Height = 292
+    Top = 4
+    Width = 284
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderSpacing.Around = 4
+    ReadOnly = True
+    ScrollBars = ssAutoBoth
+    TabOrder = 2
+  end
+end
--- a/examples/messages/unit1.lrs
+++ b/examples/messages/unit1.lrs
@ -0,0 +1,22 @@
+{ 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#16'Messages example'#12'ClientHeight'#3','#1#11'ClientWidth'#3
+  +#144#1#0#7'TButton'#7'Button1'#22'AnchorSideLeft.Control'#7#5'Owner'#21'Anch'
+  +'orSideTop.Control'#7#5'Owner'#4'Left'#2#4#6'Height'#2#25#3'Top'#2#4#5'Width'
+  +#2'h'#20'BorderSpacing.Around'#2#4#7'Caption'#6#12'Send Message'#7'OnClick'#7
+  +#12'Button1Click'#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#22'AnchorSideLef'
+  +'t.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#7'Button1'#18'AnchorSideT'
+  +'op.Side'#7#9'asrBottom'#4'Left'#2#4#6'Height'#2#25#3'Top'#2'!'#5'Width'#2'h'
+  +#20'BorderSpacing.Around'#2#4#7'Caption'#6#11'PostMessage'#7'OnClick'#7#12'B'
+  +'utton2Click'#8'TabOrder'#2#1#0#0#5'TMemo'#5'Memo1'#22'AnchorSideLeft.Contro'
+  +'l'#7#7'Button1'#19'AnchorSideLeft.Side'#7#9'asrBottom'#21'AnchorSideTop.Con'
+  +'trol'#7#5'Owner'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.'
+  +'Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#5'Owner'#21'AnchorSideB'
+  +'ottom.Side'#7#9'asrBottom'#4'Left'#2'p'#6'Height'#3'$'#1#3'Top'#2#4#5'Width'
+  +#3#28#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#20'BorderS'
+  +'pacing.Around'#2#4#8'ReadOnly'#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'
+  +#2#2#0#0#0
+]);
--- a/examples/messages/unit1.pas
+++ b/examples/messages/unit1.pas
@ -0,0 +1,92 @@
+unit Unit1; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  LMessages, LCLIntf;
+
+const
+  LM_MY_MESSAGE = LM_USER + 1;
+  
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Button1: TButton;
+    Button2: TButton;
+    Memo1: TMemo;
+    procedure Button1Click(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
+  private
+    procedure MyMessageHandler(var Message: TLMessage); message LM_MY_MESSAGE;
+  public
+    { public declarations }
+  end; 
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  {
+   SendMessage sends it directly to control without waiting while other events
+   become processed. So SendMessage acts as Control.Perform()
+
+   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 <SendMessage>');
+  SendMessage(Handle, LM_MY_MESSAGE, 1, 0);
+  Memo1.Lines.Add('Exiting Button.Click()');
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+  {
+   PostMessage add message at the bottom of message queue, so you will get it only
+   after other events become processed. You can use PostMessage to postpone some
+   operations.
+
+   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 <PostMessage>');
+  PostMessage(Handle, LM_MY_MESSAGE, 2, 0);
+  Memo1.Lines.Add('Exiting Button.Click()');
+end;
+
+procedure TForm1.MyMessageHandler(var Message: TLMessage);
+var
+  S: String;
+begin
+  {
+   Message handler
+  }
+  case Message.wParam of
+    1: S := '<SendMessage>';
+    2: S := '<PostMessage>';
+  else
+    S := '<unknown>'
+  end;
+  Memo1.Lines.Add('got message from: ' + S);
+end;
+
+initialization
+  {$I unit1.lrs}
+
+end.
+