traping WM_RBUTTONDBLCLK message in a component

hi all
 I want to write a component that catch the WM_RBUTTONDBLCLK message.
The final goal is a non visual component providing an OnRightDbClick event.
So, how my component can catch it's owner's message ?

hope it's clear.

Thanks

Mike
EKIMAsked:
Who is Participating?
 
JaccoConnect With a Mentor Commented:
Hi Mike,

Here is yet another solution. This one is selective for one TControl. So this is not the owner but a setable control. This method works by extending the msg-handling chain of a control by setting the WindowProc property.

Regards Jacco

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TRDBLClickComp = class(TComponent)
  private
    fControl: TControl;
    fOldProc: TWndMethod;
    fOnRightDblClick: TNotifyEvent;
    procedure SubClassWndProc(var Message: TMessage);
    procedure SetControl(const Value: TControl);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    destructor Destroy; override;
    property Control: TControl read fControl write SetControl;
    property OnRightDblClick: TNotifyEvent read fOnRightDblClick write fOnRightDblClick;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    btnCreateCatcher: TButton;
    btnReroute: TButton;
    procedure btnCreateCatcherClick(Sender: TObject);
    procedure btnRerouteClick(Sender: TObject);
    procedure ReportClick(Sender: TObject);
  private
    { Private declarations }
    fTest: TRDBLClickComp;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

destructor TRDBLClickComp.Destroy;
begin
  Control := nil;
  inherited Destroy;
end;

procedure TRDBLClickComp.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (AComponent = fControl) and (Operation = opRemove) then
    Control := nil;
end;

procedure TRDBLClickComp.SetControl(const Value: TControl);
begin
  if fControl <> Value then
  begin
    if Assigned(fControl) then
    begin
      fControl.WindowProc := fOldProc;
      if fControl.Owner <> Owner then
        fControl.RemoveFreeNotification(Self);
    end;
    fControl := Value;
    if Assigned(fControl) then
    begin
      fOldProc := fControl.WindowProc;
      fControl.WindowProc := SubClassWndProc;
      if fControl.Owner <> Owner then
        fControl.FreeNotification(Self);
    end;
  end;
end;

procedure TRDBLClickComp.SubClassWndProc(var Message: TMessage);

begin
  if Message.Msg = WM_RBUTTONDBLCLK then
  begin
    if Assigned(fOnRightDblClick) then
      fOnRightDblClick(fControl);
  end else
    fOldProc(Message);
end;

procedure TForm1.btnCreateCatcherClick(Sender: TObject);
begin
  fTest := TRDBLClickComp.Create(Self);
  fTest.Control := Self;
  fTest.OnRightDblClick := ReportClick;
end;

procedure TForm1.btnRerouteClick(Sender: TObject);
begin
  fTest.Control := btnReroute;
end;

procedure TForm1.ReportClick(Sender: TObject);
begin
  Memo1.Lines.Add('RightDblClick on ' + TComponent(Sender).Name);
end;

end.
0
 
edeyCommented:
I think you have to subclass the owner.

GL
Mike
0
 
robert_marquardtCommented:
Application.HookMainWindow allows to get your private message feed.
0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
Slick812Commented:
hello EKIM, here's the code for a component that will do the right mouse button double click thing. It uses the Application.OnMessage to get the WM_RBUTTONDBLCLK. You should look into the Application.OnMessage if you are going to deal with windows messages. Oh, and in a component, it might be really UNwise to set the Handled to True, since it will knockout that message in ALL the forms of that app.

- - - - - - - - - - - - - - - - - -

unit RButDblClk;
interface
uses
  SysUtils, Windows, Messages, Classes, Forms;

type
  TOnRightDlbClick = procedure(Sender:TObject)of Object;
  TRButDblClk = class( TComponent )
  private
     FOnRightDlbClick: TOnRightDlbClick;
  protected
     procedure AppMessage(var Mesg: TMsg; var Handled: Boolean);
  public
     constructor Create( AOwner: TComponent ); override;
     destructor Destroy; override;
  published
     property OnRightDlbClick: TOnRightDlbClick read FOnRightDlbClick write FOnRightDlbClick;
  end;

procedure Register;

implementation

constructor TRButDblClk.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  Application.OnMessage := AppMessage;
end;

destructor TRButDblClk.Destroy;
  begin
  inherited Destroy;
  end;

procedure TRButDblClk.AppMessage(var Mesg: TMsg; var Handled: Boolean);
begin
Handled := False;
if Mesg.message = WM_RBUTTONDBLCLK then
  begin
  if Assigned(FOnRightDlbClick) then FOnRightDlbClick(Self);
  end;
end;

procedure Register;
begin
  RegisterComponents('Additional', [TRButDblClk]);
end;

end.
0
 
robert_marquardtCommented:
Slick812, using Application.OnMessage in a component is unwise. Application.HookMainWindow is the way to go because it installs and handles a handler chain.
0
 
EKIMAuthor Commented:
robert : With ApplicationHookMainWindow, what happen if the db right click occurs not on the main form, but on another application's form ? and if this form is not modal ?

regards

Mike
0
 
robert_marquardtCommented:
Nothing happens. Application.HookMainWindow is local to the application. It is like Application.OnMessage, only that a component should not occupy Application.OnMessage.
0
 
EKIMAuthor Commented:
robert : ok, give me just some time to have a look on your solution.

Slick812 : thanks a lot for this full comment. Even it will maybe not the best solution, I do appreciate such comments.

regards

Mike
0
 
EKIMAuthor Commented:
hi jacco !

Nice job ! It works fine, and I just had to copy/paste your example to be sure that it was what I need.

Points have been increased up to 150 for "really complete-full-working-answer".  :-)

Regards.

Mike
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.