Вопсчем, у меня что-то получилось. Не знаю, насколько это правильно, но по крайней мере, используются штатные средства ББ.
Суть вот какая (жалко, ДРАКОНом не владею - нарисовал бы схему! Ничего, вот устаканятся дела - возьмём на вооружение).
На форме лежит кнопка (отображение-контейнер).
Код:
CONST
hoverDelay = 40;
TYPE
ActionHover = POINTER TO RECORD (Services.Action)
b: Button;
END;
Button = POINTER TO RECORD (Views.View)
control: ButtonContext;
bitmap: ButtonContext;
selected: BOOLEAN;
ident: Identity; (* temporary dummy model *)
focus: ButtonContext; (* current focus; either top or bottom *)
path: Path;
picw, pich: INTEGER; (* пользовательские габариты картинки *)
flat: BOOLEAN;
hover: BOOLEAN; (* признак "зависания" курсора над контролом *)
ahover: ActionHover;
END;
В обработчике сообщений контроллера, при получении сообщения
Controllers.CursorMessage взводится флаг "ховер", отображение обновляется и запускается отложенное действие:
Код:
| msg: Controllers.CursorMessage DO
IF ~b.hover THEN
b.hover := TRUE; b.Update; (* первоначальное включение ховера *)
IF b.ahover = NIL THEN (* запустить периодическую проверку ховера *)
NEW(b.ahover); b.ahover.b := b; Services.DoLater(b.ahover, Services.Ticks() + hoverDelay);
END
END
Процедура этого самого отложенного действия, периодически отсылает отображению сообщение HoverMsg. Ну и проверяет режим "ховера" - если таковой включён, то регистрируется заново, обеспечивая периодичность. А если "ховер" выключен, то процедура делает обновление отображения и вырубается.
Код:
(* Периодическая проверка ховера. Если курсор вне контрола, то ховер вырубается. Если нет, проверка запускается вновь.*)
PROCEDURE (a: ActionHover) Do;
VAR hoverMsg: HoverMsg;
BEGIN
Views.Broadcast(a.b, hoverMsg);
IF a.b.hover THEN Services.DoLater(a, Services.Ticks() + hoverDelay) ELSE Views.Update(a.b, Views.keepFrames) END
END Do;
Ну а в обработчике сообщений отображения, ловится сообщение HoverMsg, и запускается проверка координат курсора. То есть, в случае вылета курсора за пределы рамки отображения, отложенное действие отработает минимум два раза. Один раз отошлёт сообщение (при обработке которого выяснится, что курсор вне рамки), а второй раз - обнаружит выключение ховера и вырубится.
Код:
PROCEDURE (b: Button) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
BEGIN
WITH msg: HoverMsg DO
CheckHover(f, b);
ELSE
END
END HandleViewMsg;
Ну и вот сама проверка координат курсора:
Код:
PROCEDURE CheckHover(f: Views.Frame; b: Button);
VAR w, h, x, y: INTEGER; modifiers: SET; isDown: BOOLEAN;
BEGIN
b.context.GetSize(w, h); f.Input(x, y, modifiers, isDown);
IF ((x > 0) & (x < w)) & ((y > 0) & (y <h)) THEN
IF ~b.hover THEN
b.hover := TRUE;
END
ELSE
IF b.hover THEN b.hover := FALSE; b.ahover := NIL END
END;
END CheckHover;
Вход
FAQ
Поиск
