mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-17 17:39:20 +02:00
PostMessage, SendMessage example
git-svn-id: trunk@13390 -
This commit is contained in:
paul
parent
7e67dd4a12
commit
a91d1b1cf3
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -1686,6 +1686,11 @@ 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/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.lpi svneol=native#text/plain
|
||||||
examples/multithreading/criticalsectionexample1.lpr svneol=native#text/plain
|
examples/multithreading/criticalsectionexample1.lpr svneol=native#text/plain
|
||||||
examples/multithreading/criticalsectionunit1.lfm svneol=native#text/plain
|
examples/multithreading/criticalsectionunit1.lfm svneol=native#text/plain
|
||||||
|
|||||||
140
examples/messages/project1.lpi
Normal file
140
examples/messages/project1.lpi
Normal file
@ -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>
|
||||||
18
examples/messages/project1.lpr
Normal file
18
examples/messages/project1.lpr
Normal file
@ -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.
|
||||||
|
|
||||||
54
examples/messages/unit1.lfm
Normal file
54
examples/messages/unit1.lfm
Normal file
@ -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
|
||||||
22
examples/messages/unit1.lrs
Normal file
22
examples/messages/unit1.lrs
Normal file
@ -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
|
||||||
|
]);
|
||||||
92
examples/messages/unit1.pas
Normal file
92
examples/messages/unit1.pas
Normal file
@ -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.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user