Многоразовая обработка сообщения





unit PostForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TFormManyMess = class(TForm)
LBox: TListBox;
Button1: TButton;
ButtonPost: TButton;
ButtonSend: TButton;
ButtonPerform: TButton;
ButtonMouseDown: TButton;
ButtonOnMouseDown: TButton;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonPostClick(Sender: TObject);
procedure ButtonSendClick(Sender: TObject);
procedure ButtonPerformClick(Sender: TObject);
procedure ButtonMouseDownClick(Sender: TObject);
procedure ButtonOnMouseDownClick(Sender: TObject);
private
{ Private declarations }
public
procedure WndProc(var Message: TMessage); override;
procedure DefaultHandler(var Message); override;
procedure WmLButtonDown (var Message: TWMMouse);
message wm_lButtonDown;
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); override;
procedure ApplicationMessage (var Msg: TMsg;
var Handled: Boolean);
end;
var
FormManyMess: TFormManyMess;
implementation
{$R *.DFM}
procedure TFormManyMess.FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Button = mbLeft then
LBox.Items.Add (Format ('%s in (%d, %d)',
['FormMouseDown', X, Y]));
end;
procedure TFormManyMess.WndProc(var Message: TMessage);
begin
if Message.Msg = wm_LButtonDown then
LBox.Items.Add (Format ('%s in (%d, %d)',
['WndProc', LoWord (Message.LParam),
HiWord (Message.LParam)]));
inherited;
end;
procedure TFormManyMess.DefaultHandler(var Message);
begin
with TMessage (Message) do
if Msg = wm_LButtonDown then
LBox.Items.Add (Format ('%s in (%d, %d)',
['DefaultHandler', LoWord (LParam),
HiWord (LParam)]));
inherited;
end;
procedure TFormManyMess.WmLButtonDown (var Message: TWMMouse);
begin
LBox.Items.Add (Format ('%s in (%d, %d)',
['WmLButtonDown', Message.XPos, Message.YPos]));
inherited;
end;
procedure TFormManyMess.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
LBox.Items.Add (Format ('%s in (%d, %d)',
['MouseDown', X, Y]));
inherited;
end;
procedure TFormManyMess.ApplicationMessage (var Msg: TMsg;
var Handled: Boolean);
begin
if (Msg.Message = wm_LButtonDown) and
(Msg.hWnd = Handle) then
LBox.Items.Add (Format ('%s in (%d, %d)',
['ApplicationMessage', LoWord (Msg.LParam),
HiWord (Msg.LParam)]));
Handled := False;
end;
procedure TFormManyMess.FormCreate(Sender: TObject);
begin
Application.OnMessage := ApplicationMessage;
end;
procedure TFormManyMess.Button1Click(Sender: TObject);
begin
LBox.Clear;
end;
procedure TFormManyMess.ButtonPostClick(Sender: TObject);
begin
LBox.Items.Add (' --- PostMessage ---');
PostMessage (Handle, wm_lButtonDown,
0, MakeLong (10, 10));
PostMessage (Handle, wm_lButtonUp,
0, MakeLong (10, 10));
end;
procedure TFormManyMess.ButtonSendClick(Sender: TObject);
begin
LBox.Items.Add (' --- SendMessage ---');
SendMessage (Handle, wm_lButtonDown,
0, MakeLong (10, 10));
SendMessage (Handle, wm_lButtonUp,
0, MakeLong (10, 10));
end;
procedure TFormManyMess.ButtonPerformClick(Sender: TObject);
begin
LBox.Items.Add (' --- Perform ---');
Perform (wm_lButtonDown,
0, MakeLong (10, 10));
Perform (wm_lButtonUp,
0, MakeLong (10, 10));
end;
procedure TFormManyMess.ButtonMouseDownClick(Sender: TObject);
begin
LBox.Items.Add (' --- MouseDown ---');
MouseDown (mbLeft, [], 10, 10);
end;
procedure TFormManyMess.ButtonOnMouseDownClick(Sender: TObject);
begin
LBox.Items.Add (' --- OnMouseDown ---');
OnMouseDown (self, mbLeft, [], 10, 10);
end;
end.

Загрузить исходный код проекта


Далее: Мониторинг сообщений »»