|
Вопрос # 4 260/ вопрос открыт / |
|
Доброго времени суток, уважаемые эксперты!
Задача:
сделать так, чтобы при "уходе" мыши с формы она становилась полупрозрачной. А при "возвращении" становилась опять нормальной.
Решение:
обрабатываю события OnMouseLeave и OnMouseMove, ставлю соответсвенно
AlphaBlend:=True и AlphaBlend:=False(AlphaBlendValue:=125);
Проблема:
при наведении мыши на компоненты на форме, она тоже становится полупрозрачной.
Как сделать, чтобы на внутренние компоненты реакции не было, а только на выход за границы формы?
Заранее спасибо.
 |
Вопрос задал: Muratov Radik (статус: Посетитель)
Вопрос отправлен: 1 июня 2010, 16:28
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: min@y™
Измени обработчик OnMouseLeave формы так, чтобы AlphaBlend устанавливался равным 125 только тогда, когда курсор мыши в глобальных координатах находится вне пределов формы. Положение курсора: Mouse.CursorPos: TPoint (delphi) или GetCursorPos (WinAPI). Прямоугольник формы известен: TForm.BoundsRect: TRect. Функция определения вхождения точки в прямоугольник:
function PointInRect(const P: TPoint; const R: TRect): Boolean;
begin
with R do
Result := (Left <= P.X) and (Top <= P.Y) and
(Right >= P.X) and (Bottom >= P.Y);
end;
 |
Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 1 июня 2010, 16:46
Оценка за ответ: 5
|
Мини-форум вопроса
Всего сообщений: 9; последнее сообщение — 2 июня 2010, 09:46; участников в обсуждении: 2.
|
|
Muratov Radik (статус: Посетитель), 1 июня 2010, 16:57 [#1]:
Все равно при наведении на компоненты внутри тоже становится полупрозр.
function PointInRect(const P: TPoint; const R: TRect): Boolean;
begin
with R do
Result := (Left <= P.X) and (Top <= P.Y) and
(Right >= P.X) and (Bottom >= P.Y);
end;
procedure TForm1.FormMouseLeave(Sender: TObject);
begin
if PointInRect(Mouse.CursorPos, Form1.BoundsRect) then
AlphaBlendValue := 125
else
AlphaBlendValue := 255;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
AlphaBlendValue := 255;
end;
|
|
|
Muratov Radik (статус: Посетитель), 1 июня 2010, 17:02 [#2]:
ПРошу прощения, условие надо поправить
if not PointInRect(Mouse.CursorPos, Form1.BoundsRect) then
и тогда работает, но как-то не стабильно. Через раз, через два и т.д. Всегда по-разному
|
|
|
min@y™ (статус: Доктор наук), 1 июня 2010, 17:06 [#3]:
procedure TForm1.FormMouseLeave(Sender: TObject);
begin
if not PointInRect(Mouse.CursorPos, Self.BoundsRect)
then AlphaBlendValue := 125;
end;
Поставь точку останова на if и посмотри, значения Mouse.CursorPos и Self.BoundsRect.
Надеюсь этот обработчик только для формы, а не для дочерник компонентов.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Muratov Radik (статус: Посетитель), 2 июня 2010, 08:19 [#4]:
Получается вот что:
когда мышь покидает границы формы, последние считанные координаты частенько бывают < границ формы, поэтому условие не срабатывает.
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 449
CursorPos.Y - 389
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 547
CursorPos.Y - 317
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 580
CursorPos.Y - 318
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 581
CursorPos.Y - 472
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 644
CursorPos.Y - 471
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 638
CursorPos.Y - 472
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 625
CursorPos.Y - 471
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 629
CursorPos.Y - 474
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 661
CursorPos.Y - 482
Self.Left - 450
Self.Top - 192
Self.Right - 938
Self.Bottom - 473
CursorPos.X - 586
CursorPos.Y - 315
|
|
|
min@y™ (статус: Доктор наук), 2 июня 2010, 08:31 [#5]:
Ну тогда положь на форму таймер и прицепи ему на OnTimer обработчик FormMouseLeave.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Muratov Radik (статус: Посетитель), 2 июня 2010, 08:47 [#6]:
Проблему решил введением допуска на отклонение.
function PointInRect(const P: TPoint; const R: TRect): Boolean;
var
f1, f2: Boolean;
begin
with R do
begin
f1 := (P.X >= Left) and (P.X <= Right) and (P.Y >= Top) and (P.Y <= Bottom);
//
f2 := (abs(P.X - Left) <= 5) or (abs(P.X - Right) <= 5) or (abs(P.Y - Top) <= 5) or
(abs(P.Y - Bottom) <= 5);
end;
//
if (f1 and f2) then Result := false
else Result := f1;
end;
|
|
|
min@y™ (статус: Доктор наук), 2 июня 2010, 09:01 [#7]:
Короче, выкидывай всё нафиг. Мне в башку пришло более простое решение - использовать событие Application.OnIdle:
procedure TMainForm.AppEventsIdle(Sender: TObject; var Done: Boolean);
begin
if PointInRect(...)
then // сделать форму непрозрачной
else // сделать форму прозрачной
end;
Всякие OnMouseEnter и OnMouseLeave можно теперь выкинуть.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
min@y™ (статус: Доктор наук), 2 июня 2010, 09:13 [#8]:
var
MainForm: TMainForm;
implementation
{$R *.dfm}
function PointInRect(const P: TPoint; const R: TRect): Boolean;
begin
with R do
Result := (Left <= P.X) and (Top <= P.Y) and
(Right >= P.X) and (Bottom >= P.Y);
end;
procedure TMainForm.ApplicationIdle(Sender: TObject;
var Done: Boolean);
begin
SetTransparent(not PointInRect(Mouse.CursorPos, Self.BoundsRect));
Done:= True;
end;
procedure TMainForm.SetTransparent(const ATransparent: Boolean);
begin
// Установка прозрачности
if ATransparent <> Self.AlphaBlend
then begin
Self.AlphaBlend:= ATransparent;
if ATransparent
then Self.AlphaBlendValue:= 128;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnIdle:= Self.ApplicationIdle;
end;
end.
Тут, правда, есть один нюанс: форма будет менять прозрачность, даже если она перекрыта другими окнами. Но и эта проблема решаема.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
