Пользовательский OnMouseDown, который не будет тормозить клик

Question

Хорошо, у меня есть функция, которая возвращает мне TMouseEvent тип

Мне нужно выполнить возвращенное TMouseEvent, но я не знаю как.

Простая функция, возвращающая событие:

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

В настоящее время для события установлено значение OMDnew, которое выглядит следующим образом:

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;

---

Чего я пытаюсь достичь:

1. Получение по умолчанию события кнопки OnMouseDown и сохранение его в некоторых данных записи

2. Изменение события ONMouseDown на пользовательское

3. Во время процедуры пользовательского события возникает условие - если нажатие мыши было перетаскиванием, я выполняю код перетаскивания, если бы не было, я бы продолжил с обычным щелчком

4. Для выполнения обычным щелчком я хотел восстановить событие по умолчанию и повторить его, чтобы можно было выполнить щелчок

Вот так

Answer 1

Просто назовите его, передавая параметр:

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;

Вам может потребоваться изменить Button, Shift, X, Y, хотя, если вы используете их в своем OMDOld и вам нужно значение, отличное от текущего значения в dragEvent, например, удаление ssShift или около того.

Если ваш OMDold хранится как TMethod, вы можете использовать:

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

Ниже приведен полный пример теста, настроенный для демонстрации того, чего вы хотите достичь подобным образом:

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.

Answer 2

Адресация ко всем частям вопроса отдельно:

1. Получение кнопки по умолчанию OnMouseDown событие и сохранение ее в некоторых данных записи

   Добавить личноеполе для объявления формы и назначьте ему старое событие:

     private
       FOldButtonOnMouseDown: TMouseEvent;
     end;
   
   ...
   
     FOldButtonOnMouseDown := Button.OnMouseDown;
   

2. Изменение события OnMouseDown на пользовательское

   Назначьте свой пользовательскийОбработчик события для свойства OnMouseDown:

     private
       procedure NewButtonMouseDown(Sender: TObject; Button: TMouseButton;
         Shift: TShiftState; X, Y: Integer);
     end;
   
   ...
   
     Button.OnMouseDown := NewButtonMouseDown;
   

3. Во время пользовательской процедуры события возникает условие - если нажатие мыши было перетаскиванием, я выполняю код перетаскивания,если бы это было не так, я бы продолжил с обычным щелчком

   Проверьте, было ли назначено исходное событие, и если да, назовите его:

   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. Для обработки обычным щелчком я хотел восстановить событие по умолчанию и запустить его повторно, чтобы можно было выполнить щелчок

   Восстановить событие:

   Button.OnMouseDown := FOldButtonOnMouseDown;
   

Объединение всего этого - ваша следующая задача.Особенно это зависит от того, как реализован перетаскиватель, но вы можете взглянуть на этот ответ , в котором я также временно обмениваю событие OnMouseUp для отмены всех изменений.

Answer 3

Пример процедуры, которая останавливает OnMouseDown от запуска события CLick:

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) запускает клик, поэтому, если мы не хотим перетаскивать его, клики.