Консультации Портала - Консультация #187549

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 187549

26.09.2013, 07:23

96.03 руб.

26.09.2013, 08:51

0 20 1

Компьютеры Программирование

Здравствуйте! Для оживления ветки такой вопрос:
Среда делфи 2010, для обработки момента прокрутки колеса мышки используется такие процедуры:

Код:

 private
    { Private declarations }

    // обработка движения колеса мыши
    {procedure MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);  }

    // обработка прокрутки колеса вниз
    procedure MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);

    // обработка прокрутки колеса вверх
    procedure MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Назначаем обработчики для событий:
  // движение колеса мыши
  {Form1.OnMouseWheel:= MouseWheel;}
  // прокрутка колеса вниз
  Form1.OnMouseWheelDown:= MouseWheelDown;
  // прокрутка колеса вверх
  Form1.OnMouseWheelUp:= MouseWheelUp;
end;

Процедуры работают, но на разных компьютерах при одном шаге прокрутки колесика мышки эта процедура вызывается разное количество раз, на моём получается три раза подряд. Изменения системных настроек колеса мышки на прокрутку всего одной строки или одного листа к ожидаемому эффекту в виде вызова только раз этой процедуры не приводит. Как можно с этим справиться?
Спасибо.

Обсуждение

давно

Вадим Исаев ака sir Henry

Мастер-Эксперт
425
4118

26.09.2013, 08:25

общий

26.09.2013, 08:31

Вы говорите про щелчёк колёсиком или всё же про прокрутку колёсика мыши? У Вас не описаны процедуры для щелчка и, поэтому, щелчёк отрабатывать не должен - просто нечему работать.
1. Вы уверены, что привели здесь правильный код?
2. Вы уверены, что при щелчке одновременно не прокручиваете колёсико мышки?

Изменения системных настроек колеса мышки на прокрутку всего одной строки или одного листа к ожидаемому эффекту в виде вызова только раз этой процедуры не приводит.

Колёсико крутится дискретно. Мышка посылает сигнал прокрутки каждый раз, как колесо прокручивается на один шаг. Срабатывание одного шага Вы можете почувствовать пальцем, когда медленно и вдумчиво крутите колесо. Так что сколько шагов колесо прокрутилось, столько раз событие и вызовется.

Об авторе:
Я только в одном глубоко убеждён - не надо иметь убеждений! :)

давно

Евгений/Genia007/

Профессионал
153662
1070

26.09.2013, 08:47

общий

26.09.2013, 08:50

Конечно же про однократный шаг колёсика мышки, а не щелчок по нему, увидел уже когда отправил сообщение, не могу отредактировать его.

У меня хорошо чувствуется шаг колёсика, но процедура вызвается при этом 3 раза, дома на компе вызывается 4 раза.
Вот собственно пример кода обработки прокрутки колеса вниз:

Код:

procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  // Детекция движения колеса вниз
  if ButtonStepMotor.Tag = 1  then
    begin
      reverschek:= 0;
      If CheckBoxMotor1.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $FE, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $FE,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      If CheckBoxMotor2.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $FD, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $FD,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      If CheckBoxMotor3.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $FB, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $FB,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      If CheckBoxMotor4.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $F7, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $F7,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      If CheckBoxMotor5.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $FE, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $FE,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      If CheckBoxMotor6.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $FD, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $FD,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      If CheckBoxMotor7.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $FB, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $FB,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      If CheckBoxMotor8.Checked Then
        Step(Blocks[TabControl1.TabIndex].motor, Blocks[TabControl1.TabIndex].RotateDirection and $F7, Blocks[TabControl1.TabIndex].motor2, Blocks[TabControl1.TabIndex].RotateDirection2 and $F7,
            1{Blocks[TabControl1.TabIndex].StepCount}, Blocks[TabControl1.TabIndex].StepLength);
      EditKolShag.Text:= IntToStr(KolvoShag);
    end;
end;

Так вот он вызывается подряд несколько раз при одном шаге колеса мышки. Поцедура должна пускать двигатель на один шаг, а вместо этого делается три - четыре шага движка на разных компах.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Вадим Исаев ака sir Henry

Мастер-Эксперт
425
4118

26.09.2013, 09:04

общий

26.09.2013, 09:05

Адресаты:

Клянусь своей треуголкой, у меня (сейчас специально проверил

) 1 шаг - ровно одно событие.
Давайте сделаем так:
1. Отключите событие OnMouseWheel (чтобы не мешалось).
2. Киньте на форму два TLabel. Один будет отслеживать кол-во шагов колеса вверх, а второй - кол-во шагов колеса вниз. В соответствующие события добавьте код подсчёта шагов:

Код:

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id1);
  label1.Caption:=IntToStr(id1);
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id2);
  Label2.Caption:=IntToStr(id2);
end;

И теперь проследите, сколько реально шагов делает колесо Вашей мыши.

Об авторе:
Я только в одном глубоко убеждён - не надо иметь убеждений! :)

давно

Евгений/Genia007/

Профессионал
153662
1070

26.09.2013, 09:18

общий

1. OnMouseWheel у меня закоментирована и в вопросе тоже.

показания 3, 6, 9, 12, 15 и так далее.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Евгений/Genia007/

Профессионал
153662
1070

26.09.2013, 09:46

общий

А вот в пустой форме и новом проекте работает по одному шагу.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Вадим Исаев ака sir Henry

Мастер-Эксперт
425
4118

26.09.2013, 11:01

общий

Серьёзный повод внимательно прошерстить код.

Об авторе:
Я только в одном глубоко убеждён - не надо иметь убеждений! :)

давно

Евгений/Genia007/

Профессионал
153662
1070

26.09.2013, 11:49

общий

Наверное придётся. Код не мой, я только пытаюсь прикрутить колесо мышки.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

26.09.2013, 14:44

общий

Адресаты:

Господи да что вы городите ерунду какую то?
Панель управления / Мышь / Закладка "Колесико" / Поворот на указанной количество строк.
Смотрите картинку...

Ну а в коде надо узнать какое значение установлено в системе... думаю сами справитесь ;)

Прикрепленные файлы:

7e97ba84332fc8fd2c7d0d8cdf32ea75.JPG

скачать (26.00 кБ)

давно

Евгений/Genia007/

Профессионал
153662
1070

26.09.2013, 15:14

общий

Цитата: 5994

Панель управления / Мышь / Закладка "Колесико" / Поворот на указанной количество строк.
Смотрите картинку...

Я про это писал в вопросе, что смена настроек не помогает.

Цитата: 5994

Ну а в коде надо узнать какое значение установлено в системе..

Интересно где и что надо добавить, решенрие этого пока не нашёл.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

26.09.2013, 16:14

общий

Адресаты:

Хмм запустил на WinXP под Delphi XE2...
И да! "Хватаю" приращение по 2 !!!???

sir код пустой, причем при первой компиляции на 7ке была 1, а теперь всегда 2

фигня какая то.

Неизвестный

26.09.2013, 16:21

общий

Адресаты:

Ха-ха

решение найдено... неполное но дальше поймете фишку...

Действительно добавляется по единичке!!!

Но...

Итак по порядку:

Делаем новый проект как сказал sir.

Кидаем на форму только ДВА Label.
Заменяем текст проекта на ниже следующий:

Код:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  id1:Integer = 0;
  id2:Integer = 0;

implementation

{$R *.dfm}

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id1);
  label1.Caption:=IntToStr(id1);
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id2);
  Label2.Caption:=IntToStr(id2);
end;

end.

При прокрутке получаем "1" отвечаю !!!

А теперь кидаем на форму ПУСТОЙ Button....

Запускаем и ОПА! получаем "2" :))))

Не знаю что еще кинуть чтобы ТРИ получить... но идея понятна куда "рыть"...

P.S.
Как получить сколько страниц НАДО прокручивать из системного окошка...

На нажатие Buttion1:

procedure TForm1.Button1Click(Sender: TObject);
function GetNumScrollLines: Integer;
begin
SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);
end;

begin
ShowMessage(IntToStr(GetNumScrollLines));

end;

давно

Евгений/Genia007/

Профессионал
153662
1070

26.09.2013, 16:44

общий

26.09.2013, 16:51

У меня такая форма. Это надо на все кнопари вешать .

Картинку не выводит.
URL >>

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

26.09.2013, 17:06

общий

Адресаты:

Евгений, насколько я понял просто сообщение о прокрутке колесика "хватают" несколько компонентов.
Поэтому и меняется число - так как "виртуально" колесо прокрутилось над несколькими объектами.

Значит всё просто вешаете в своём обработчике (MouseWheelDown / MouseWheelUp):
if (id mod 3 = 0) then ...

И кстати, зачем на каждый компонент повесьте 1 обработчик просто на форму... событие OnWheel срабатывает даже когда вы уведете мышь ЗА пределы вашего окна, лишь бы оно было активным...

P.S. ладно мне надо уезжать... могу сказать еще фишку, которую нашел... кидаем ListBox (и Edit) на нашу форму с 2 Label 1 Button...
"Тыкаем" в ListBox и крутим мышь... черти приращение идёт по 1.
"Тыкаем" в Edit или в саму форму и крутим мышь... приращение идёт по 2.

Надеюсь дальше сами докопаетесь до истины...
УДАЧИ!

P.S. По крайней мере понятно куда рыть... в наследование и количество объектов, которые перехватывают это сообщение.
Если очень хочется надо просто "отбить" обработку этого сообщения т.е. установить свой перехватчик, как Вы делали ранее... всё опаздываю извините встреча.

давно

Вадим Исаев ака sir Henry

Мастер-Эксперт
425
4118

26.09.2013, 18:15

общий

Проделал то же самое, что Вы описали, в Lazarus (не в Delphi!!!) - у меня всегда, при любой комбинации компонентов, ровно одно событие на один шаг колеса мышки.

Предлагаю переходить с нелицензионного Delphi на свободный Lazarus.

Об авторе:
Я только в одном глубоко убеждён - не надо иметь убеждений! :)

Неизвестный

27.09.2013, 10:33

общий

Адресаты:

Что значит нелицензионный??
У меня есть лицензии на Delphi5, 7 и XE2

.
И windows oracle mssql...
Понятно, что в Lazarus будет работать по другому...

А это похоже просто глюк причем который тянется из недр ядра дельфи...

Придумал пока такое решение... отобрать у формы событие OnWheel...
В таком же ключе можно отобрать и у других "лишних" компонентов.
Либо уже ставить перехват сообщения для всего приложения, так тоже можно...

Надеюсь задача решена?

Код:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Procedure WMMOUSEWHEEL (Var Msg: TWMMOUSEWHEEL );
    Message WM_MOUSEWHEEL ;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  id1:Integer = 0;
  id2:Integer = 0;

implementation

{$R *.dfm}

Procedure TForm1.WMMOUSEWHEEL(Var Msg: TWMMOUSEWHEEL );
Begin
{
	//если нужно... что то делать...
  //в общем, мы просто отобрали у самой формы это событие
  //и теперь OnWheel есть только у самих компонентов...
	If Msg.WheelDelta > 0 Then
		Label3.Caption:='UP'
	Else
		Label3.Caption:='DOWN';
}
End;

procedure TForm1.Button1Click(Sender: TObject);
	function GetNumScrollLines: Integer;
	begin
	  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);
  end;

begin
	//по хорошему это надо знать и "крутить" в соответствии с этим количеством:
  ShowMessage(IntToStr(GetNumScrollLines));
end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id1);
  label1.Caption:=IntToStr(id1);
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id2);
  Label2.Caption:=IntToStr(id2);
end;

end.

давно

Евгений/Genia007/

Профессионал
153662
1070

27.09.2013, 10:58

общий

27.09.2013, 10:59

Задачу решил, только немного другим способом. Можете оформить ответом. Спасибо.

Код:

function GetNumScrollLines: Integer;
begin
  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);
end;

procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  // Детекция движения колеса вниз
  inc(idscrol);
  if (idscrol mod GetNumScrollLines) <> 0 then
    exit;
....
end;

procedure TForm1.MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  // Детекция движения колеса вверх
  inc(idscrol);
  if (idscrol mod GetNumScrollLines) <> 0 then
    exit;
....
end;

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

27.09.2013, 11:14

общий

Адресаты:

Евгений неверно Ваше решение...

Мы же выяснили, что "3"-ка получается не от значения SPI_GETWHEELSCROLLLINES, а от количества обработчиков этого сообщения.

Т.е. в Вашем случае оно просто совпало..., поменяйте на "1" в свойствах мышки - и Ваше приложение "рухнет".
Т.е. либо Вы в лоб пишете "mod 3" либо нужно "отсекать" НЕ нужных обработчиков, как это показано в моём примере.

P.S.
Пока не получу от Вас подтверждения, что предложенный мной способ решает поставленную Вами задачу... повременю с оформлением :).

давно

Евгений/Genia007/

Профессионал
153662
1070

27.09.2013, 11:49

общий

Сейчас нет времени посидеть с прогой, пока оставлю так,

Код:

procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  // Детекция движения колеса вниз
  inc(idscrol);
  if (idscrol mod 3) <> 0 then
    exit;
....
end;

, потом как будет время попробую поискать ещё ненужный обработчик, от формы отвязывается и прокручивает уже на два шага.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

27.09.2013, 11:53

общий

Адресаты:

Ок. Тогда оформляю.

Неизвестный

27.09.2013, 12:27

общий

это ответ

Здравствуйте, Евгений/Genia007/!

Вопрос оказался не из простых, как кажется на первый взгляд.
Внимание! Проблема проявляется только в продуктах Delphi (!) и не проявляется в Lazarus.

Похоже это "глюк" который тянется из недр ядра Delphi... (проверялось на Delphi 7 и XE2)

Проблема заключается в том, что событие OnMouseWheel "перехватывают" несколько компонентов, начиная с самой формы, так и объектов Button, ListView и т.д. Каждый объект считает что событие OnMouseWheel произошло на нем и "увеличивает" счетчик срабатывания. В результате вместо прокрутки на один шаг, происходит прокрутка на 2, 3 шага.

Для того чтобы продемонстрировать указанную ошибку необходимо создать новый проект (на Delphi 7 - XE2).
Разместить на форму два Label (Label1, Label2).
Разместить на форму один Button (Button1).
Заменить текст unit1 на прилагаемый:

Код:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  id1:Integer = 0;
  id2:Integer = 0;

implementation

{$R *.dfm}

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id1);
  label1.Caption:=IntToStr(id1);
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(id2);
  Label2.Caption:=IntToStr(id2);
end;

end.

Запустив проект и прокрутив колесо увидим приращения по ДВЕ цифры, а не по одной.
Удалив Button1 - приращение будет по ОДНОЙ цифре.

Предложенное решение - отобрать у формы событие OnMouseWheel...

(В таком же ключе можно в дальнейшем отобрать и у других "лишних" компонентов.
Либо поставить перехват сообщения OnMouseWheel для всего приложения)

Необходимо снова разместить Button1 на форму, добавить Label3 и заменить текст Unit1 на ниже следующий:

Код:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }

//КЛЮЧЕВОЕ добавление:
    Procedure WMMOUSEWHEEL (Var Msg: TWMMOUSEWHEEL );
    Message WM_MOUSEWHEEL ;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  id1:Integer = 0;
  id2:Integer = 0;

implementation

{$R *.dfm}

Procedure TForm1.WMMOUSEWHEEL(Var Msg: TWMMOUSEWHEEL );
Begin
{
  //"захватили" сообщение и ничего по нему не делаем...
  //но если нужно... что то делать...
  //в общем, мы просто отобрали у самой формы это событие
  //и теперь OnWheel есть только у самих компонентов...
  //тем не менее если необходимо далее с этим сообщением работать
  //используйте код:
	If Msg.WheelDelta > 0 Then
		Label3.Caption:='UP'
	Else
		Label3.Caption:='DOWN';
}
End;

procedure TForm1.Button1Click(Sender: TObject);
  //функция позволяющая узнать что установлено в свойствах системы - 
  //Панель управления / Мышь / Закладка "Колесико" / Поворот на указанное количество строк.
  //т.е. как пользователь хотел... бы чтобы работало колесико:
  function GetNumScrollLines: Integer;
  begin
    SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);
  end;

begin
  //по хорошему это надо знать и "крутить" в соответствии с этим количеством:
  ShowMessage(IntToStr(GetNumScrollLines));
end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  //увеличиваем счетчик срабатывания и выводим значение в label1:
  Inc(id1);
  label1.Caption:=IntToStr(id1);
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  //увеличиваем счетчик срабатывания и выводим значение в label2:
  Inc(id2);
  Label2.Caption:=IntToStr(id2);
end;

end.

В результате указанных изменений событие OnMouseWheel больше не обрабатывается Form, при этом по прежнему обрабатывается Button и мы получаем приращение по "1".

Повторюсь, аналогично можно "отобрать" это событие у "не нужных компонентов".

P.S. Если Вам не хочется искать "не нужные компоненты" и отключать у них это событие...
Можно поступить проще - решение "в лоб":

Добавить Label1 Label2 посмотреть цифру приращения и заменить обработчик:

Код:


procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  inc(id1);
  if (id1 mod 2) <> 0 then exit;  //или 3... сколько у вас будет. Суть - "убрать" лишние срабатывания.
//Ниже ВАШ код который Вы хотите чтобы выполнялся с приращением "1":
//.....
end;

procedure TForm1.MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  inc(id2);
  if (id2 mod 2) <> 0 then exit;  //или 3... сколько у вас будет.
//Ниже ВАШ код который Вы хотите чтобы выполнялся:
//.....
end;

Всем УДАЧИ в борьбе

Спасибо за подробное объяснение.

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.