Мышь над формой? - PullRequest
       3

Мышь над формой?

0 голосов
/ 14 декабря 2010

Этот код не работает для меня в Delphi XE:

http://delphi.about.com/cs/adptips2000/a/bltip0800_5.htm

procedure TForm1.FormDeactivate(Sender: TObject) ;
begin
   ReleaseCapture;
end;

procedure TForm1.FormMouseMove
(Sender: TObject; Shift: TShiftState; X,Y: Integer) ;
begin
  If GetCapture = 0 then
    SetCapture(Form1.Handle) ;
    if PtInRect(Rect(Form1.Left,
                    Form1.Top,
                    Form1.Left + Form1.Width,
                    Form1.Top + Form1.Height),
                    ClientToScreen(Point(x, y))) then
     Form1.Caption := 'Mouse is over form' else
     Form1.Caption := 'Mouse is outside of form';
end;

Нет ошибок - он просто не действует.

Пожалуйста, помогите.

РЕДАКТИРОВАТЬ 1

Оказалось, что проблема не в коде, даже мышь FormMouseEnter и FormMouseLeave не работают, потому что я передаю форму в модуль Iсоздан с помощью такой функции:

процедура Slide (Form: TForm; Show: Boolean);

Я вызываю метод Show изнутри этой процедуры.Как я могу решить эту проблему?

Спасибо.

РЕДАКТИРОВАТЬ 2

Я не хочу использовать функцию, которую я разместил сейчас.Я хочу использовать то, что люди предложили ниже (FormMouseEnter и FormMouseLeave), но это не работает и в моем случае.

Ответы [ 4 ]

5 голосов
/ 14 декабря 2010

Вы можете использовать события OnMouseEnter и OnMouseLeave, чтобы отслеживать, находится ли мышь над формой или нет, без захвата курсора мыши.

3 голосов
/ 14 декабря 2010

Это всего лишь вопрос ввода необходимого кода в события OnMouseEnter и OnMouseLeave соответствующей формы. В моем случае все, что я сделал, было:

Создать новый проект в Delphi
Выберите форму, с которой вы работаете
Перейти к Инспектору объектов
При необходимости перейдите на вкладку «События» в инспекторе объектов
Прокрутите вниз до события OnMouseEnter, дважды щелкните пустое пространство рядом с ним, что сгенерирует EventHandler. Убедитесь, что вы получили следующий код в обработчике событий:

procedure TForm1.FormMouseEnter(Sender: TObject);
begin
  Self.Caption := 'Mouse in form';
end;

Снова перейдите к Инспектору объектов
Найдите событие OnMouseLeave и дважды щелкните в белой области справа от него, чтобы сгенерировать новый обработчик события, и добавьте в него следующий код

procedure TForm1.FormMouseLeave(Sender: TObject);
begin
  Self.Caption := 'Mouse outside form';
end;

Запустите приложение ... наведите указатель мыши на форму, и заголовок изменится на «Мышь внутри формы», переместите его за пределы формы, и на заголовке появится надпись «Мышь вне формы»

Работает как брелок (протестировано в Delphi 2010)

1 голос
/ 14 декабря 2010

Насколько я понимаю, использование SetCapture для этого плохая идея.Если бы он функционировал так, как вам хотелось бы, вы бы ограбили все остальные сообщения мыши только потому, что не знаете лучшего способа отслеживания мыши.

Но MSDN говорит (http://msdn.microsoft.com/en-us/library/ms646262(VS.85).aspx), что даже с SetCapture, mouseсообщения извне не будут перенаправлены в ваше окно, если кнопка мыши не нажата (возможно, это мера, предотвращающая то, что вы пытаетесь достичь: воровство мыши без уважительной причины).

Неважно, где находятсявы вызываете Show () из, так что ваша проблема не в этом.

0 голосов
/ 16 января 2014

Мне нужна форма (frmTasks) с сильно измененным заголовком.Поэтому я создал форму со скрытой подписью.Я моделирую подпись с помощью изображения (imgRedLogo), на котором я рисую то, что мне нужно.Этот код позволяет пользователю щелкнуть поддельную подпись (изображение) и переместить форму.Работает как шарм БЕЗ захвата мыши.Он работает даже с правой кнопкой мыши (вам нужно проверить параметр «Button» в imgRedLogoMouseDown, если вы хотите отключить эту «функцию»).

ПОЛНЫЙ КОД РАБОТЫ:

VAR
  Dragged  : Boolean= FALSE;
  IsOverImg: Boolean= FALSE;  { True if mouse if over the image }
  OldPos   : TPoint;

procedure TfrmTasks.imgRedLogoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 Dragged:= True;
 GetCursorPos(OldPos);
end;

procedure TfrmTasks.imgRedLogoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
VAR NewPos: TPoint;
begin
 if Dragged AND IsOverImg then
  begin
    GetCursorPos(NewPos);
    frmTasks.Left:= frmTasks.Left- OldPos.X + NewPos.X;
    frmTasks.Top := frmTasks.Top - OldPos.Y + NewPos.Y;
    OldPos:= NewPos;
  end;
end;

procedure TfrmTasks.imgRedLogoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if Dragged
 then Dragged:= False;
end;

procedure TfrmTasks.imgRedLogoMouseEnter(Sender: TObject);
begin
 IsOverImg:= TRUE;
end;

procedure TfrmTasks.imgRedLogoMouseLeave(Sender: TObject);
begin
 IsOverImg:= FALSE;
end;

Наслаждайтесь.

...