Pergunta

I need to disable scrolling of items with mouse wheel for all combo components on the form. Best of all is to have more or less general solution, because design of the form may change, it would be nice if new combo components will be ignored without any additional work with sourcecode. I have two types of combo: TComboBox and TcxComboBox (from DevExpress ExpressBars Suit). I tried to go this way:

procedure TSomeForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
begin
  if (Screen.ActiveControl is TComboBox) or (Screen.ActiveControl is TcxComboBox) then
    Handled := True;
end;

It works fine for TComboBox, but this event handler never triggered when TcxComboBox has focus. I tried to catch corresponding messages on the level of the form like this:

procedure TSomeForm.WndProc(var m: TMessage);
begin
  if (m.Msg = WM_VSCROLL) or (m.Msg = WM_HSCROLL) or (m.msg = WM_Mousewheel) then
    m.Msg := 0;
  inherited;
end;

But such messages never come to this handler. I tried to directly disable mouse wheel handling for TcxComboBox, because it has such property:

procedure TSomeForm.FormCreate(Sender: TObject);
begin
  cxComboBox1.Properties.UseMouseWheel := False;
end;

But it doesn't work, it is still possible to scroll items with mouse wheel. I posted support ticket for this issue, but even if they fix it in next release i need some solution now.

Any ideas, maybe someone solved it somehow ?

Foi útil?

Solução

Instead of hooking on the form you might inherit own components or use interposer classes overriding DoMouseWheel. You might bind the handling on an additional property.

type
  TcxComboBox = Class(cxDropDownEdit.TcxComboBox)
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
  private
    FUseMouseWheel: Boolean;
  public
    Property UseMouseWheel: Boolean Read FUseMouseWheel Write FUseMouseWheel;
  End;

  TComboBox = Class(Vcl.StdCtrls.TComboBox)
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
  private
    FUseMouseWheel: Boolean;
  public
    Property UseMouseWheel: Boolean Read FUseMouseWheel Write FUseMouseWheel;
  End;

  TForm3 = class(TForm)
    ComboBox1: TComboBox;
    cxComboBox1: TcxComboBox;
    cxComboBox2: TcxComboBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}
{ TComboBox }

function TComboBox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
 if FUseMouseWheel then inherited
 else Result := true;
end;

{ TcxComboBox }

function TcxComboBox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
 if FUseMouseWheel then inherited
 else Result := true;

end;

procedure TForm3.FormCreate(Sender: TObject);
begin
    cxComboBox2.UseMouseWheel := true;
end;
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top