Однако, не всё так однозначно оказалось.
Пишу на javascript под Photoshop, в диалоговом окне с настройками скрипта есть функционал, аналогичный ранее
описанному тут: несколько кнопок для настройки цветов, по клику вызывается диалог. Кнопки (в скрипте) сделаны через стандартные Button с перехваченным onDraw (стандартно цветом фона кнопок не оперирует javascript в фотошоповской реализации), выглядят внешне плоскими прямоугольниками, как и Shape в Lazarus, и размещены в контейнере типа panel, который выглядит так же, как GroupBox, порождённый стандартными компонентами Delphi или Lazarus. Так вот, решил я, что удобнее одинаковый цвет разным кнопкам определять не через диалог, а через drag-and-drop. Штатного механизма не предусмотрено, значит, надо работать через onmousedown/onmouseup. Вначале проверяю, могу ли я получить объект (button, statictext и т.п.) на котором событие мышиное вызвано, если обработчик через addEventListener к окну назначен. Проверяю выводом через alert мессаги (по сути - окна) с сообщением о параметрах объекта. И вот тут получаю: на первое mousedown объект определяется правильное, а все последующие упрямо повторяют информацию об этом первом объекте. Почти так, как в
описанном мною случае с шейпами на групбоксе в Лазарусе, только клик по свободному месту на форме не исправляет ситуацию - требуется перезапуск скрипта.
Что общего у javascript в Photoshop и Lazarus? Вроде бы ничего. А вот у моих программ общее есть: из обработчика mousedown вызывается новое окно (alert в скрипте, ColorDialog в lazarus-программе).
Проверяю в скрипте: делаю вывод информации не в новое окно через alert, а в statictext на основной форме - и работает правильно! Теперь проверка в Lazarus. Повторюсь: на форме в GroupBox размещены несколько объектов TShape с одинаковыми обработчиками onMouseDown/onMouseUp, плюс ColorDialog:TColorDialog; ещё одна используемая глобальная переменная упомянута в первой строчке прилагаемого кода.
- Код: Выделить всё
var ObjMouseDown: TObject = nil;
procedure TForm1.ShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ObjMouseDown:=Sender;
end;
procedure TForm1.ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ObjMouseDown=Sender then begin
ColorDialog.Color:=TShape(Sender).Brush.Color;
if ColorDialog.Execute then
TShape(Sender).Brush.Color:=ColorDialog.Color;
end;
ObjMouseDown:=nil;
end;
Работает. А если нажатие и отпускание кнопки происходят над одним и тем же шейпом, то работает правильно. А вот если нажать кнопку (MouseDown) над шейпом1, а отпустить (MouseUp) над шейпом2 (или любым другим визуальным объектом - хоть бы по пустому месту формы или вовсе за пределами окна программы), то Sender в onMouseUp будет не шейпом2, а всё тем же шейпом1. Как замена onClick такая связка двух обработчиков, может, и сгодится, но как попытка реализовать таким способом drag-and-drop - нет.
Может, это не следствие бага в реализации TGroupBox в Lazarus, а фича (т.е. особенность). Но чтобы быть особенностью, фича должна быть документирована. Мне же не попалось пока такой документации. Да и с поведением аналогичных объектов в Delphi не совпадает (правда, упомянутую связку двух обработчиков я в Delphi не проверил ещё). Не исключаю, что таки можно получить желаемую функциональность без правки исходных кодов стандартных компонентов, но пока этого не достиг. Попробовал заменить GroupBox через связки Panel+StaticText и Bevel+StaticText - визуально похоже получилось, да и подобных проблем, похоже, нет...
Кстати если кликать по Shape не левой кнопкой, а правой то Shape - вызываются правильно... 