Search code examples
delphicustom-controlsmousevclmousewheel

Ignore all new incoming mousewheel messages while event is being handled


I am using some custom combobox control derived from TCustomControl and I am handling mouse events. Let's call it TMyComboBox.

I am handling TMyComboBox.OnChange and doing some operations which takes some time to finish (approx. 200ms) (doing some external hardware changes).

Because I also implemented mouse wheel I am able to change items in my custom combobox with mouse wheel.

Here comes the problem. Mouse wheel event occurs very fast (when scrolling) and this raises OnChange event of my TMyComboBox.

Becuase OnChange takes so much time to finish I can not process all that messages so my combobox is still changing even after I am already not changing mouse wheel anymore. I guess message queue is emptying and sending all mouse wheel events....

So how can I prevent to receive mouse wheel message in message queue if my OnChange is still doing some work?

Pseudo code

function TMyComboBox.DoMouseWheelDown(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  Self.Cursor := crHourGlass;
  if (Self.Focused and (Self.IndexSelectData + 1 < FScaleCode.Count ) ) then Self.IndexSelectData := Self.IndexSelectData + 1;
  Self.Cursor := crArrow;
end;

function TMyComboBox.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Self.Cursor := crHourGlass;
  if (Self.Focused and (Self.IndexSelectData - 1 > -1 ) ) then Self.IndexSelectData := Self.IndexSelectData - 1;
  Self.Cursor := crArrow;
end;

procedure TMyComboBox.OnChange(Sender: TNotifyEvent);
begin
  -> MessageQueue.Lock; // stop receiving message into queue
  ProcessHardware; // long procedure (approx. 200ms)
  -> MessageQueue.Unlock; // continue recieving message into queue
end;

Remark: When setting IndexSelectData, OnChange will be raised.

I read something about PeekMessages but I am not sure how to use it... (if could be used at all)

Thank you for your help.


Solution

  • I don't think you can stop messages being added to the queue. But you could swallow any messages that are already in the queue:

    procedure SwallowPendingMessages(hWnd: HWND; MsgFilterMin, MsgFilterMax: UINT);
    var
      M: TMsg;
    begin
      while PeekMessage(M, hWnd, MsgFilterMin, MsgFilterMax, PM_REMOVE) do begin
        //gulp
      end;
    end;
    

    You'd call the function at the end of your OnChange handler.

    I'm not sure that I would go so far as to bless what you are proposing as being a good idea. I think I'd probably be looking for an alternative solution to the problem. Likely one that used threads in order to avoid blocking the UI thread.