Перехват сообщений

unit Unit1;
..............
 
type // Ïåðåõâàò âñòàâêè
  TEdit = class(StdCtrls.TEdit)
private
  procedure WMPaste(var Msg:TMessage); message WM_PASTE;
end;
 
type
  TForm1 = class(TForm)
.............

unit Unit1;
 
.....
 
type
  TForm1 = class(TForm)
.....
 
  public
    { Public declarations }
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
 
.....
 
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_PASTE then
    begin
      ShowMessage('Вставка!');
    end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage; // Перехватчик событий
end;

unit Unit1;
..............
 
type // Перехват вставки
  TEdit = class(StdCtrls.TEdit)
private
  procedure WMPaste(var Msg:TMessage); message WM_PASTE;
end;
 
type
  TForm1 = class(TForm)
.............

  TEdit = class(StdCtrls.TEdit)
  protected
    procedure WndProc( var Message: TMessage ); override;
  end;
 
// ...
 
procedure TEdit.WndProc(var Message: TMessage);
begin
   inherited;
   if Message.Msg = WM_PASTE then
   begin
      ShowMessage('Paste!!!');
   end;
end;

procedure TForm1.MsgHandler(var Msg: TMessage);
begin
  if Msg.Msg = WM_PASTE then
    ShowMessage('Paste!!!')
  else
    Msg.Result := CallWindowProc(OldProc, Edit1.Handle, Msg.Msg, Msg.wParam, Msg.LParam);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  OldProc:=pointer(GetWindowLong(Edit1.Handle, GWL_WndProc));
  WndFunc := MakeObjectInstance(MsgHandler);
  SetWindowLong(Edit1.Handle, GWL_WndProc, integer(WndFunc));
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(Edit1.Handle, GWL_WndProc, integer(OldProc));
  FreeObjectInstance(WndFunc);
end;

TEdit = class(StdCtrls.TEdit)
  protected
    procedure WndProc( var Message: TMessage ); override;
  end;
 
// ...
 
procedure TEdit.WndProc(var Message: TMessage);
begin
   if Message.Msg = WM_PASTE then
      ShowMessage('Paste!!!')
   else inherited;
end;