Переслать сообщение с помощью SendMessage

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{

This is useful if you want to send a message from your DLL back

to the calling application.

}

const

MY_MESSAGE = WM_USER 4242;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

// Handler that receive the Message

procedure MessageReceiver(var msg: TMessage); message MY_MESSAGE;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

txt: string;

begin

txt := ‘Hello World’;

SendMessage(Form1.Handle, MY_MESSAGE, 0, DWORD(PChar(txt)));

end;

// To receive this custom Message that is addressed to form1.handle

// you need a message handler.

procedure TForm1.MessageReceiver(var msg: TMessage);

var

txt: PChar;

begin

txt := PChar(msg.lParam);

msg.Result := 1;

ShowMessage(txt);

end;

end.

{/codecitation}

Отслеживать имя текущего компонента

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

— Что общего между Женщиной и Windows?

— И с тем, и с другим приходится трахаться.

— А в чем различие?

— С Женщиной, приятней. Но с Windows’ом зато без проблем. Нет месячных перерывов и жалоб на головную боль.

unit FCForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, StdCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

StatusBar1: TStatusBar;

public

procedure CmFocusChanged (var Msg: TCmFocusChanged);

message cm_FocusChanged;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CmFocusChanged (var Msg: TCmFocusChanged);

begin

StatusBar1.SimpleText := Msg.Sender.Name;

end;

end.

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

{/codecitation}

Отправление сообщения сразу всем элементам управления формы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Вы слишком много работаете за компьютером, если:

— Вспоминаете про антивирусные пакеты всякий раз, когда открываете консервы, книги, двери

— Вспоминаете про архивирование, когда:

— идете с тяжелыми сумками домой

— несете свою жену на руках

— Вспоминаете операцию «удалить», когда: — видите тещу

— инспектора ГИБДД

— Подсознательно ненавидите женщин с именами

— Ася

— Клава

— Вспоминаете про разархивирование, когда получаете зарплату.

Вы слишком мало работаете за компьютером, если:

— позволяете себе заниматься сексом без предохранения, даже с надежным партнером

— позволяете себе заниматься сексом

— позволяете себе.

Можно использовать

Screen.Forms[i].BroadCast(msg);

где [i] — индекс той формы, которой Вы хотите переслать сообщение. BroadCast работает со всеми компонентами, потомками TWinControls и отправляет сообщение всем дочерним компонентам из массива Controls. Если один из дочерних компонентов обрабатывает это сообщение и устанавливает Msg.Result в ненулевое значение — дальнейшая рассылка сообщения останавливается.

{/codecitation}

Отловить сообщение в компоненте

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Кот схватил мышку за хвост…

… и своротил со стола комп!

{*************************************************************************}

{

TApplication besitzt eine Methode HookMainWindow.

Damit kann man in die Windows Prozedur (WndProc) «einhaken» und Nachrichten,

welche an die Applikation geschickt werden, abfangen und behandeln.

HookMainWindow is wie folgt deklariert:

}

procedure HookMainWindow(Hook : TWindowHook);

{ Und der Parameter TWindowHook (Methoden Pointer) so: }

type

TWindowHook = function(var Message : TMessage) : Boolean of object;

{*************************************************************************}

unit MessageReceiver;

interface

uses

Windows, Messages, SysUtils, Classes, Forms, Dialogs;

type

TOnReceiveUserMessage = procedure(Msg: Cardinal; wParam, lParam: Integer;

var Handled: Boolean) of object;

TOnReceiveOtherMessage = procedure(var Handled: Boolean) of object;

TMessageReceiver = class(TComponent)

private

{ Private declarations }

FHooked: Boolean;

FOnReceiveUserMessage: TOnReceiveUserMessage;

FOnDateTimeChange: TOnReceiveOtherMessage;

function MessageHook(var Msg: TMessage): Boolean;

protected

function DoDateTimeChange(Msg: TMessage): Boolean; dynamic;

function DoUserMessage(Msg: TMessage): Boolean; dynamic;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

{ Published declarations }

property OnDateTimeChange: TOnReceiveOtherMessage

read FOnDateTimeChange write FOnDateTimeChange;

property OnReceiveUserMessage: TOnReceiveUserMessage

read FOnReceiveUserMessage write FOnReceiveUserMessage;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents(‘System’, [TMessageReceiver]);

end;

function TMessageReceiver.MessageHook(var Msg: TMessage): Boolean;

begin

Result := False;

// User defined messages

if (Msg.Msg >= WM_USER) then

Result := DoUserMessage(Msg)

else

// Other messages

case Msg.Msg of

WM_TIMECHANGE: Result := DoDateTimeChange(Msg);

// …

end;

end;

function TMessageReceiver.DoDateTimeChange(Msg : TMessage): Boolean;

begin

Result := False;

if Assigned(FOnDateTimeChange) then

FOnDateTimeChange(Result);

end;

function TMessageReceiver.DoUserMessage(Msg: TMessage): Boolean;

begin

Result := False;

if Assigned(FOnReceiveUserMessage) then

FOnReceiveUserMessage(Msg.Msg, Msg.wParam, Msg.LParam, Result);

end;

constructor TMessageReceiver.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FHooked := False;

if not (csDesigning in ComponentState) then

begin

Application.HookMainWindow(MessageHook);

FHooked := True;

end;

end;

destructor TMessageReceiver.Destroy;

begin

if FHooked then Application.UnhookMainWindow(MessageHook);

inherited Destroy;

end;

end.

{/codecitation}

Оповещение всей системы о изменении WIN.INI

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Hа pаботе пpопал пpогpамеp. День нету, два. Hа звонки не отвечает. Hу pешили пpовеpить что да как. Пpишли к нему домой, а там в холодной ванне сидит лысый пpогpамист с полупустой бутылкой шампуня в pуке. Отняли у него бутылку и читают инстpукцию:

1. Hанести на влажные волосы. 2. Hамылить. 3. Подождать. 4. Смыть. 5. Повтоpить.

Оповещение приложения (или всей системы) о изменении WIN.INI. При изменении WIN.INI (например, изменении настроек хранителя экрана) необходимо уведомить систему (или конкретное приложение) о том, что WIN.INI изменен. Это можно сделать при помощи передачи приложению сообщения WM_WININICHANGE SendMessage(HANDLE, WM_WININICHANGE, 0, PCHAR(SECT_NAME)); При этом HANDLE равен или HANDLE приложения, или HWND_BROADCAST — рассылка всем приложениям. SECT_NAME задает имя секции WIN.INI, в которой произошли изменения. Если указать пустую строку (#0), то считается, что изменялись все секции, что естественно увеличивает время обработки и нагрузку на систему

VAR S : ARRAY[0..40] OF Char;

StrCopy(S, ‘Desktop’);

SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S));

{/codecitation}

Обработка WM_SysCommand

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Neil J. Rubenking

Системное меню в приложениях Delphi ведет двойную жизнь — когда основная форма активна, работает системное меню главной формы, но когда приложение минимизировано, работает системное меню объекта Applictaion. Этот код может оказаться полезным:

CONST

SC_UDF = $EFF0; {должен быть < $F000 и делиться на 16}

procedure TForm1.FormCreate(Sender: TObject);

begin

AppendMenu(GetSystemMenu(Handle, False), MF_STRING, SC_UDF, ‘Всегда на

Новая WinProc

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Xavier Pacheco

unit Scwndprc;

interface

uses Forms, Messages;

const

DDGM_FOOMSG = WM_USER;

implementation

uses Windows, SysUtils, Dialogs;

var

WProc: Pointer;

function NewWndProc(Handle: hWnd; Msg, wParam, lParam: Longint): Longint;

stdcall;

{ This is a Win32 API-level window procedure. It handles the messages }

{ received by the Application window. }

begin

if Msg = DDGM_FOOMSG then

{ If it’s our user-defined message, then alert the user. }

ShowMessage(Format(‘Message seen by WndProc! Value is: $%x’, [Msg]));

{ Pass message on to old window procedure }

Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

initialization

{ Set window procedure of Application window. }

WProc := Pointer(SetWindowLong(Application.Handle, gwl_WndProc,

Integer(@NewWndProc)));

end.

unit Main;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TMainForm = class(TForm)

SendBtn: TButton;

PostBtn: TButton;

procedure SendBtnClick(Sender: TObject);

procedure PostBtnClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

OldWndProc: Pointer;

WndProcPtr: Pointer;

procedure WndMethod(var Msg: TMessage);

procedure HandleAppMessage(var Msg: TMsg; var Handled: Boolean);

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses ScWndPrc;

procedure TMainForm.HandleAppMessage(var Msg: TMsg; var Handled: Boolean);

{ OnMessage handler for Application object. }

begin

if Msg.Message = DDGM_FOOMSG then

{ if it’s the user-defined message, then alert the user. }

ShowMessage(Format(‘Message seen by OnMessage! Value is: $%x’,

[Msg.Message]));

end;

procedure TMainForm.WndMethod(var Msg: TMessage);

begin

if Msg.Msg = DDGM_FOOMSG then

{ if it’s the user-defined message, then alert the user. }

ShowMessage(Format(‘Message seen by WndMethod! Value is: $%x’, [Msg.Msg]));

with Msg do

{ Pass message on to old window procedure. }

Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam,

lParam);

end;

procedure TMainForm.SendBtnClick(Sender: TObject);

begin

SendMessage(Application.Handle, DDGM_FOOMSG, 0, 0);

end;

procedure TMainForm.PostBtnClick(Sender: TObject);

begin

PostMessage(Application.Handle, DDGM_FOOMSG, 0, 0);

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

Application.OnMessage := HandleAppMessage; // set OnMessage handler

WndProcPtr := MakeObjectInstance(WndMethod); // make window proc

{ Set window procedure of application window. }

OldWndProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC,

Integer(WndProcPtr)));

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

{ Restore old window procedure for Application window }

SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));

{ Free our user-created window procedure }

FreeObjectInstance(WndProcPtr);

end;

end.

{/codecitation}

Несколько методов, обрабатывающих одно сообщение

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

unit ManyForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TFormManyMess = class(TForm)

LBox: TListBox;

Label1: TLabel;

Button1: TButton;

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Button1Click(Sender: TObject);

procedure FormCreate(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;

end.

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

{/codecitation}

Мониторинг сообщений

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Жуткокристалический монитор.

unit Mlist;

interface

uses

SysUtils, Classes, Messages, Controls;

var

MsgList: TStringList;

function GetMessageName (Msg: Integer): string;

implementation

function GetMessageName (Msg: Integer): string;

var

N: Integer;

begin

N := MsgList.IndexOfObject (TObject(Msg));

if N >= 0 then

Result := MsgList.Strings [N]

else if (Msg >= wm_User) and

(Msg <= $7FFF) then

Result := Format (

‘wm_User message (%d)’, [Msg])

else

Result := Format (

‘Undocumented (%d)’, [Msg]);

end;

initialization

MsgList := TStringList.Create;

MsgList.AddObject (‘wm_Null’, TObject($0000));

MsgList.AddObject (‘wm_Create’, TObject($0001));

MsgList.AddObject (‘wm_Destroy’, TObject($0002));

MsgList.AddObject (‘wm_Move’, TObject($0003));

MsgList.AddObject (‘wm_Size’, TObject($0005));

MsgList.AddObject (‘wm_Activate’, TObject($0006));

MsgList.AddObject (‘wm_SetFocus’, TObject($0007));

MsgList.AddObject (‘wm_KillFocus’, TObject($0008));

MsgList.AddObject (‘wm_Enable’, TObject($000A));

MsgList.AddObject (‘wm_SetRedraw’, TObject($000B));

MsgList.AddObject (‘wm_SetText’, TObject($000C));

MsgList.AddObject (‘wm_GetText’, TObject($000D));

MsgList.AddObject (‘wm_GetTextLength’, TObject($000E));

MsgList.AddObject (‘wm_Paint’, TObject($000F));

MsgList.AddObject (‘wm_Close’, TObject($0010));

MsgList.AddObject (‘wm_QueryEndSession’, TObject($0011));

MsgList.AddObject (‘wm_Quit’, TObject($0012));

MsgList.AddObject (‘wm_QueryOpen’, TObject($0013));

MsgList.AddObject (‘wm_EraseBkGnd’, TObject($0014));

MsgList.AddObject (‘wm_SysColorChange’, TObject($0015));

MsgList.AddObject (‘wm_EndSession’, TObject($0016));

MsgList.AddObject (‘wm_SystemError’, TObject($0017));

MsgList.AddObject (‘wm_ShowWindow’, TObject($0018));

MsgList.AddObject (‘wm_CtlColor’, TObject($0019));

MsgList.AddObject (‘wm_WinIniChange’, TObject($001A));

MsgList.AddObject (‘wm_DevModeChange’, TObject($001B));

MsgList.AddObject (‘wm_ActivateApp’, TObject($001C));

MsgList.AddObject (‘wm_FontChange’, TObject($001D));

MsgList.AddObject (‘wm_TimeChange’, TObject($001E));

MsgList.AddObject (‘wm_CancelMode’, TObject($001F));

MsgList.AddObject (‘wm_SetCursor’, TObject($0020));

MsgList.AddObject (‘wm_MouseActivate’, TObject($0021));

MsgList.AddObject (‘wm_ChildActivate’, TObject($0022));

MsgList.AddObject (‘wm_QueueSync’, TObject($0023));

MsgList.AddObject (‘wm_GetMinMaxInfo’, TObject($0024));

MsgList.AddObject (‘wm_PaintIcon’, TObject($0026));

MsgList.AddObject (‘wm_IconEraseBkGnd’, TObject($0027));

MsgList.AddObject (‘wm_NextDlgCtl’, TObject($0028));

MsgList.AddObject (‘wm_SpoolerStatus’, TObject($002A));

MsgList.AddObject (‘wm_DrawItem’, TObject($002B));

MsgList.AddObject (‘wm_MeasureItem’, TObject($002C));

MsgList.AddObject (‘wm_DeleteItem’, TObject($002D));

MsgList.AddObject (‘wm_VKeyToItem’, TObject($002E));

MsgList.AddObject (‘wm_CharToItem’, TObject($002F));

MsgList.AddObject (‘wm_SetFont’, TObject($0030));

MsgList.AddObject (‘wm_GetFont’, TObject($0031));

MsgList.AddObject (‘wm_QueryDragIcon’, TObject($0037));

MsgList.AddObject (‘wm_CompareItem’, TObject($0039));

MsgList.AddObject (‘wm_Compacting’, TObject($0041));

MsgList.AddObject (‘wm_CommNotify’, TObject($0044));

MsgList.AddObject (‘wm_WindowPosChanging’, TObject($0046));

MsgList.AddObject (‘wm_WindowPosChanged’, TObject($0047));

MsgList.AddObject (‘wm_Power’, TObject($0048));

MsgList.AddObject (‘wm_CopyData’, TObject($004A));

MsgList.AddObject (‘wm_CancelJournal’, TObject($004B));

MsgList.AddObject (‘wm_Notify’, TObject($004E));

MsgList.AddObject (‘wm_StyleChanging’, TObject($007C));

MsgList.AddObject (‘wm_StyleChanged’, TObject($007D));

MsgList.AddObject (‘wm_GetIcon’, TObject($007F));

MsgList.AddObject (‘wm_SetIcon’, TObject($0080));

MsgList.AddObject (‘wm_NCCreate’, TObject($0081));

MsgList.AddObject (‘wm_NCDestroy’, TObject($0082));

MsgList.AddObject (‘wm_NCCalcSize’, TObject($0083));

MsgList.AddObject (‘wm_NCHitTest’, TObject($0084));

MsgList.AddObject (‘wm_NCPaint’, TObject($0085));

MsgList.AddObject (‘wm_NCActivate’, TObject($0086));

MsgList.AddObject (‘wm_GetDlgCode’, TObject($0087));

MsgList.AddObject (‘wm_NCMouseMove’, TObject($00A0));

MsgList.AddObject (‘wm_NCLButtonDown’, TObject($00A1));

MsgList.AddObject (‘wm_NCLButtonUp’, TObject($00A2));

MsgList.AddObject (‘wm_NCLButtonDblClk’, TObject($00A3));

MsgList.AddObject (‘wm_NCRButtonDown’, TObject($00A4));

MsgList.AddObject (‘wm_NCRButtonUp’, TObject($00A5));

MsgList.AddObject (‘wm_NCRButtonDblClk’, TObject($00A6));

MsgList.AddObject (‘wm_NCMButtonDown’, TObject($00A7));

MsgList.AddObject (‘wm_NCMButtonUp’, TObject($00A8));

MsgList.AddObject (‘wm_NCMButtonDblClk’, TObject($00A9));

MsgList.AddObject (‘wm_KeyDown’, TObject($0100));

MsgList.AddObject (‘wm_KeyUp’, TObject($0101));

MsgList.AddObject (‘wm_Char’, TObject($0102));

MsgList.AddObject (‘wm_DeadChar’, TObject($0103));

MsgList.AddObject (‘wm_SysKeyDown’, TObject($0104));

MsgList.AddObject (‘wm_SysKeyUp’, TObject($0105));

MsgList.AddObject (‘wm_SysChar’, TObject($0106));

MsgList.AddObject (‘wm_SysDeadChar’, TObject($0107));

MsgList.AddObject (‘wm_InitDialog’, TObject($0110));

MsgList.AddObject (‘wm_Command’, TObject($0111));

MsgList.AddObject (‘wm_SysCommand’, TObject($0112));

MsgList.AddObject (‘wm_Timer’, TObject($0113));

MsgList.AddObject (‘wm_HScroll’, TObject($0114));

MsgList.AddObject (‘wm_VScroll’, TObject($0115));

MsgList.AddObject (‘wm_InitMenu’, TObject($0116));

MsgList.AddObject (‘wm_InitMenuPopup’, TObject($0117));

MsgList.AddObject (‘wm_MenuSelect’, TObject($011F));

MsgList.AddObject (‘wm_MenuChar’, TObject($0120));

MsgList.AddObject (‘wm_EnterIdle’, TObject($0121));

MsgList.AddObject (‘wm_CtlColorMsgbox’, TObject($0132));

MsgList.AddObject (‘wm_CtlColorEdit’, TObject($0133));

MsgList.AddObject (‘wm_CtlColorListbox’, TObject($0134));

MsgList.AddObject (‘wm_CtlColorBtn’, TObject($0135));

MsgList.AddObject (‘wm_CtlColorDlg’, TObject($0136));

MsgList.AddObject (‘wm_CtlColorScrollbar’, TObject($0137));

MsgList.AddObject (‘wm_CtlColorStatic’, TObject($0138));

MsgList.AddObject (‘wm_MouseMove’, TObject($0200));

MsgList.AddObject (‘wm_LButtonDown’, TObject($0201));

MsgList.AddObject (‘wm_LButtonUp’, TObject($0202));

MsgList.AddObject (‘wm_LButtonDblClk’, TObject($0203));

MsgList.AddObject (‘wm_RButtonDown’, TObject($0204));

MsgList.AddObject (‘wm_RButtonUp’, TObject($0205));

MsgList.AddObject (‘wm_RButtonDblClk’, TObject($0206));

MsgList.AddObject (‘wm_MButtonDown’, TObject($0207));

MsgList.AddObject (‘wm_MButtonUp’, TObject($0208));

MsgList.AddObject (‘wm_MButtonDblClk’, TObject($0209));

MsgList.AddObject (‘wm_ParentNotify’, TObject($0210));

MsgList.AddObject (‘wm_MDICreate’, TObject($0220));

MsgList.AddObject (‘wm_MDIDestroy’, TObject($0221));

MsgList.AddObject (‘wm_MDIActivate’, TObject($0222));

MsgList.AddObject (‘wm_MDIRestore’, TObject($0223));

MsgList.AddObject (‘wm_MDINext’, TObject($0224));

MsgList.AddObject (‘wm_MDIMaximize’, TObject($0225));

MsgList.AddObject (‘wm_MDITile’, TObject($0226));

MsgList.AddObject (‘wm_MDICascade’, TObject($0227));

MsgList.AddObject (‘wm_MDIIconArrange’, TObject($0228));

MsgList.AddObject (‘wm_MDIGetActive’, TObject($0229));

MsgList.AddObject (‘wm_MDISetMenu’, TObject($0230));

MsgList.AddObject (‘wm_DropFiles’, TObject($0233));

MsgList.AddObject (‘wm_MDIRefreshMenu’, TObject($0234));

MsgList.AddObject (‘wm_Cut’, TObject($0300));

MsgList.AddObject (‘wm_Copy’, TObject($0301));

MsgList.AddObject (‘wm_Paste’, TObject($0302));

MsgList.AddObject (‘wm_Clear’, TObject($0303));

MsgList.AddObject (‘wm_Undo’, TObject($0304));

MsgList.AddObject (‘wm_RenderFormat’, TObject($0305));

MsgList.AddObject (‘wm_RenderAllFormats’, TObject($0306));

MsgList.AddObject (‘wm_DestroyClipboard’, TObject($0307));

MsgList.AddObject (‘wm_DrawClipboard’, TObject($0308));

MsgList.AddObject (‘wm_PaintClipboard’, TObject($0309));

MsgList.AddObject (‘wm_VScrollClipboard’, TObject($030A));

MsgList.AddObject (‘wm_SizeClipboard’, TObject($030B));

MsgList.AddObject (‘wm_AskCBFormatName’, TObject($030C));

MsgList.AddObject (‘wm_ChangeCBChain’, TObject($030D));

MsgList.AddObject (‘wm_HScrollClipboard’, TObject($030E));

MsgList.AddObject (‘wm_QueryNewPalette’, TObject($030F));

MsgList.AddObject (‘wm_PaletteIsChanging’, TObject($0310));

MsgList.AddObject (‘wm_PaletteChanged’, TObject($0311));

// Delphi notifications and messages

MsgList.AddObject (‘CM_ACTIVATE’, TObject(CM_BASE 0));

MsgList.AddObject (‘CM_DEACTIVATE’, TObject(CM_BASE 1));

MsgList.AddObject (‘CM_GOTFOCUS’, TObject(CM_BASE 2));

MsgList.AddObject (‘CM_LOSTFOCUS’, TObject(CM_BASE 3));

MsgList.AddObject (‘CM_CANCELMODE’, TObject(CM_BASE 4));

MsgList.AddObject (‘CM_DIALOGKEY’, TObject(CM_BASE 5));

MsgList.AddObject (‘CM_DIALOGCHAR’, TObject(CM_BASE 6));

MsgList.AddObject (‘CM_FOCUSCHANGED’, TObject(CM_BASE 7));

MsgList.AddObject (‘CM_PARENTFONTCHANGED’, TObject(CM_BASE 8));

MsgList.AddObject (‘CM_PARENTCOLORCHANGED’, TObject(CM_BASE 9));

MsgList.AddObject (‘CM_HITTEST’, TObject(CM_BASE 10));

MsgList.AddObject (‘CM_VISIBLECHANGED’, TObject(CM_BASE 11));

MsgList.AddObject (‘CM_ENABLEDCHANGED’, TObject(CM_BASE 12));

MsgList.AddObject (‘CM_COLORCHANGED’, TObject(CM_BASE 13));

MsgList.AddObject (‘CM_FONTCHANGED’, TObject(CM_BASE 14));

MsgList.AddObject (‘CM_CURSORCHANGED’, TObject(CM_BASE 15));

MsgList.AddObject (‘CM_CTL3DCHANGED’, TObject(CM_BASE 16));

MsgList.AddObject (‘CM_PARENTCTL3DCHANGED’, TObject(CM_BASE 17));

MsgList.AddObject (‘CM_TEXTCHANGED’, TObject(CM_BASE 18));

MsgList.AddObject (‘CM_MOUSEENTER’, TObject(CM_BASE 19));

MsgList.AddObject (‘CM_MOUSELEAVE’, TObject(CM_BASE 20));

MsgList.AddObject (‘CM_MENUCHANGED’, TObject(CM_BASE 21));

MsgList.AddObject (‘CM_APPKEYDOWN’, TObject(CM_BASE 22));

MsgList.AddObject (‘CM_APPSYSCOMMAND’, TObject(CM_BASE 23));

MsgList.AddObject (‘CM_BUTTONPRESSED’, TObject(CM_BASE 24));

MsgList.AddObject (‘CM_SHOWINGCHANGED’, TObject(CM_BASE 25));

MsgList.AddObject (‘CM_ENTER’, TObject(CM_BASE 26));

MsgList.AddObject (‘CM_EXIT’, TObject(CM_BASE 27));

MsgList.AddObject (‘CM_DESIGNHITTEST’, TObject(CM_BASE 28));

MsgList.AddObject (‘CM_ICONCHANGED’, TObject(CM_BASE 29));

MsgList.AddObject (‘CM_WANTSPECIALKEY’, TObject(CM_BASE 30));

MsgList.AddObject (‘CM_INVOKEHELP’, TObject(CM_BASE 31));

MsgList.AddObject (‘CM_WINDOWHOOK’, TObject(CM_BASE 32));

MsgList.AddObject (‘CM_RELEASE’, TObject(CM_BASE 33));

MsgList.AddObject (‘CM_SHOWHINTCHANGED’, TObject(CM_BASE 34));

MsgList.AddObject (‘CM_PARENTSHOWHINTCHANGED’, TObject(CM_BASE 35));

MsgList.AddObject (‘CM_SYSCOLORCHANGE’, TObject(CM_BASE 36));

MsgList.AddObject (‘CM_WININICHANGE’, TObject(CM_BASE 37));

MsgList.AddObject (‘CM_FONTCHANGE’, TObject(CM_BASE 38));

MsgList.AddObject (‘CM_TIMECHANGE’, TObject(CM_BASE 39));

MsgList.AddObject (‘CM_TABSTOPCHANGED’, TObject(CM_BASE 40));

MsgList.AddObject (‘CM_UIACTIVATE’, TObject(CM_BASE 41));

MsgList.AddObject (‘CM_UIDEACTIVATE’, TObject(CM_BASE 42));

MsgList.AddObject (‘CM_DOCWINDOWACTIVATE’, TObject(CM_BASE 43));

MsgList.AddObject (‘CM_CONTROLLISTCHANGE’, TObject(CM_BASE 44));

MsgList.AddObject (‘CM_GETDATALINK’, TObject(CM_BASE 45));

MsgList.AddObject (‘CM_CHILDKEY’, TObject(CM_BASE 46));

MsgList.AddObject (‘CM_DRAG’, TObject(CM_BASE 47));

MsgList.AddObject (‘CM_HINTSHOW’, TObject(CM_BASE 48));

MsgList.AddObject (‘CM_DIALOGHANDLE’, TObject(CM_BASE 49));

MsgList.AddObject (‘CM_ISTOOLCONTROL’, TObject(CM_BASE 50));

MsgList.AddObject (‘CM_EXECPROC’, TObject($8FFF));

MsgList.AddObject (‘CM_TABFONTCHANGED’, TObject(CM_BASE 100));

MsgList.AddObject (‘CM_DEFERLAYOUT’, TObject(WM_USER 100));

MsgList.AddObject (‘CN_CHARTOITEM’, TObject(CN_BASE WM_CHARTOITEM));

MsgList.AddObject (‘CN_COMMAND’, TObject(CN_BASE WM_COMMAND));

MsgList.AddObject (‘CN_COMPAREITEM’, TObject(CN_BASE WM_COMPAREITEM));

MsgList.AddObject (‘CN_CTLCOLORBTN’, TObject(CN_BASE WM_CTLCOLORBTN));

MsgList.AddObject (‘CN_CTLCOLORDLG’, TObject(CN_BASE WM_CTLCOLORDLG));

MsgList.AddObject (‘CN_CTLCOLOREDIT’, TObject(CN_BASE WM_CTLCOLOREDIT));

MsgList.AddObject (‘CN_CTLCOLORLISTBOX’, TObject(CN_BASE WM_CTLCOLORLISTBOX));

MsgList.AddObject (‘CN_CTLCOLORMSGBOX’, TObject(CN_BASE WM_CTLCOLORMSGBOX));

MsgList.AddObject (‘CN_CTLCOLORSCROLLBAR’, TObject(CN_BASE WM_CTLCOLORSCROLLBAR));

MsgList.AddObject (‘CN_CTLCOLORSTATIC’, TObject(CN_BASE WM_CTLCOLORSTATIC));

MsgList.AddObject (‘CN_DELETEITEM’, TObject(CN_BASE WM_DELETEITEM));

MsgList.AddObject (‘CN_DRAWITEM’, TObject(CN_BASE WM_DRAWITEM));

MsgList.AddObject (‘CN_HSCROLL’, TObject(CN_BASE WM_HSCROLL));

MsgList.AddObject (‘CN_MEASUREITEM’, TObject(CN_BASE WM_MEASUREITEM));

MsgList.AddObject (‘CN_PARENTNOTIFY’, TObject(CN_BASE WM_PARENTNOTIFY));

MsgList.AddObject (‘CN_VKEYTOITEM’, TObject(CN_BASE WM_VKEYTOITEM));

MsgList.AddObject (‘CN_VSCROLL’, TObject(CN_BASE WM_VSCROLL));

MsgList.AddObject (‘CN_KEYDOWN’, TObject(CN_BASE WM_KEYDOWN));

MsgList.AddObject (‘CN_KEYUP’, TObject(CN_BASE WM_KEYUP));

MsgList.AddObject (‘CN_CHAR’, TObject(CN_BASE WM_CHAR));

MsgList.AddObject (‘CN_SYSKEYDOWN’, TObject(CN_BASE WM_SYSKEYDOWN));

MsgList.AddObject (‘CN_SYSCHAR’, TObject(CN_BASE WM_SYSCHAR));

MsgList.AddObject (‘CN_NOTIFY’, TObject(CN_BASE WM_NOTIFY));

end.

unit ViewMsg;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm2 = class(TForm)

ListBox1: TListBox;

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.DFM}

end.

unit WndProForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls, Buttons;

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

Label1: TLabel;

CheckBox1: TCheckBox;

CheckBox2: TCheckBox;

RadioButton1: TRadioButton;

RadioButton2: TRadioButton;

ListBox1: TListBox;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

SpeedButton3: TSpeedButton;

SpeedButton4: TSpeedButton;

SpeedButton5: TSpeedButton;

SpeedButton6: TSpeedButton;

Bevel1: TBevel;

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure SpeedButton5Click(Sender: TObject);

private

Last: Integer;

public

procedure WndProc (var Message: TMessage); override;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses

ViewMsg, MList;

procedure TForm1.WndProc (var Message: TMessage);

begin

if not (Message.Msg = Last) then

begin

with Form2.Listbox1 do

ItemIndex := Items.Add (GetMessageName (Message.Msg));

Last := Message.Msg;

end;

inherited WndProc (Message);

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

Color := clBlue;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);

begin

Color := clRed;

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);

begin

Color := clLtGray;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Caption := Edit1.Text;

end;

procedure TForm1.SpeedButton5Click(Sender: TObject);

var

Pos: Integer;

begin

// exchange Left and Top

Pos := (Sender as TControl).Left;

(Sender as TControl).Left := (Sender as TControl).Top;

(Sender as TControl).Top := Pos;

end;

end.

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

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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.

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

{/codecitation}