Jacek Kwiecień
Jacek Kwiecień

Reputation: 12637

Custom OnMouseDown that won't brake the click

Ok I have a function that returns to me a TMouseEvent type

I need to execute returned TMouseEvent but I dont know how.

Simple function returning an event:

function OMDold(obj: TObject): TMouseEvent
  begin
  ... //some operations on obj 
  result := obj.OnMouseDown; //there is casting necessary, I skip it for simplify
end; 

Currently the event is set to OMDnew which looks like:

procedure TfmAPRBasedForm.TSDragEvent(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if something then dosomething
  else
    begin
      Sender.OnMouseDOwn := OMDold // OMDold in most cases returns null but its ok I just want to clear custom event from the object 
      //line below is a point of my question - the one I used doesnt work
      TButton(Sender).OnMouseDown(Sender,Button,Shift,X,Y) //this line throws Access viloation at me
    end;
end;

What I'm trying to achieve:

  1. Geting button default OnMouseDown event and storing it in some record data

  2. Changing ONMouseDown event to custom

  3. During the custom event procedure there is a condition - if the mouse press was a drag, I execute drag code, if it wasn't I'd proceed with common click

  4. To procced with common click I wanted to restore the default event and reeru it so the click could be executed

Thats it

Upvotes: 0

Views: 1948

Answers (3)

NGLN
NGLN

Reputation: 43649

Addressing all question parts separately:

  1. Geting button default OnMouseDown event and storing it in some record data

    Add a private field to your form declaration and assign the old event to it:

      private
        FOldButtonOnMouseDown: TMouseEvent;
      end;
    
    ...
    
      FOldButtonOnMouseDown := Button.OnMouseDown;
    
  2. Changing OnMouseDown event to custom

    Assign your custom event handler to the OnMouseDown property:

      private
        procedure NewButtonMouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
      end;
    
    ...
    
      Button.OnMouseDown := NewButtonMouseDown;
    
  3. During the custom event procedure there is a condition - if the mouse press was a drag, I execute drag code, if it wasn't I'd proceed with common click

    Test if the original event was assigned and if so, call it:

    procedure TForm1.NewButtonMouseDown(Sender: TObject; 
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      if DragCondition then
        ExecuteDragCode
      else
        if Assigned(FOldButtonOnMouseDown) then
          FOldButtonOnMouseDown(Sender, Button, Shift, X, Y);
    end;
    
  4. To procced with common click I wanted to restore the default event and rerun it so the click could be executed

    Restore the event:

    Button.OnMouseDown := FOldButtonOnMouseDown;
    

Combining this all together is your next challenge. It depends especially on how the drag stuf is implemented, but you could take a look at this answer in which I also temporarily exchange the OnMouseUp event for undoing all changes.

Upvotes: 0

Justmade
Justmade

Reputation: 1496

Just call it directly passing the param :

procedure TfmAPRBasedForm.TSDragEvent(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if something then dosomething
  else
    begin
      TButton(Sender.OnMouseDOwn) := OMDold // OMDold in most cases returns nil (not null) but its ok I just want to clear custom event from the object 
      //line below is a point of my question - the one I used doesnt work
      If Assigned(TButton(Sender).OnMouseDown) then // Check if there is really an TMouseEvent
        TButton(Sender).OnMouseDown(Sender,Button,Shift,X,Y) //Call only when Event exist
    end;
end;

You may need to changed the Button, Shift, X, Y though if you are using them in your OMDOld and you need the value other then current value in the dragEvent, like removing ssShift or so.

If your OMDold is stored as TMethod then you can use :

TMouseEvent(OMDOld)(Sender,Button,Shift,X,Y);

Below is a full test example adjusted to show what you want to achieve in similar fashion :

Unit Unit4;

interface

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

type
  TForm4 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btn1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btn2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    procedure NewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  public
    { Public declarations }
    OMDold : TMouseEvent;
    IsNew : Boolean;
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.FormCreate(Sender: TObject);
begin
  OMDold := btn1.OnMouseDown;
  btn1.OnMouseDown := NewMouseDown;
  IsNew := True;
end;

procedure TForm4.NewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if IsNew then
    ShowMessage('New Method!')
  else if Assigned(OMDold) then
    OMDold(Sender,Button,Shift,X,Y);
end;

procedure TForm4.btn1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShowMessage('Original Method!');
end;

procedure TForm4.btn2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsNew := not IsNew;
end;

end.

Upvotes: 3

Jacek Kwiecień
Jacek Kwiecień

Reputation: 12637

The sample procedure that stops OnMouseDown from runing the CLick event:

procedure TForm1.CustomowyEvent(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (DragDetectPlus(TWinControl(Sender))) then ShowMessage('detected drag!')

else
  begin
    TButton(Sender).OnMouseDown := DME;
    TButton(Sender).OnClick(Sender);
  end;
end;

TButton(Sender).OnClick(Sender) runs the click so basically if we didn't want to drag it clicks.

Upvotes: 0

Related Questions