Доброго всем дня.
Создаю компонент, наследник от TCustomTransparentControl. Необходимость следующая: в зависимости от InterceptMouse он будет прозрачен или реагировать на мышу. То чтобы он был прозрачен в самом TCustomTransparentControl поддерживается. Но вот реакции, когда он непрозрачен от него добиться не могу.
constructor TTransparentControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
Brush.Style := bsClear;
with Canvas do
begin
Pen.Style := psDash;
Pen.Color := clBlack;
Brush.Style := bsClear;
end;
end;
procedure TTransparentControl.Paint;
begin
inherited;
if csDesigning in ComponentState then
Canvas.Rectangle(0, 0, Width, Height);
if Assigned(FOnPaint) then FOnPaint(Self);
end;
то есть, когда он прозрачен контролы под ним реагируют на мышь. Когда ставлю программно ему флаг непрозрачности, контролы под ним перестают реагировать, но и он никаких признаков жизни не подаёт.
Все действия по реакции на мышь описаны в родителе TWinControl, поэтому он как наследник вроде должен уметь их обрабатывать, но что-то никак (((.
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
11-11-2009 04:15
В классе TCustomTransparentControl стоит неверная обработка сообщения
Я проверял на D2010, там все исправлено.
Кстати забыла сказать, что создала свой прозрачный контрол не от TCustomTransparentControl, а непосредственно от TCustomControl, продублировав большую часть кода от TCustomTransparentControl, с указаным измененим в обработчике сообщения WM_NCHITTEST, плюс небольшую свою функциональность. То есть получила гибрид
//------------------------------------------------------------------------------
constructor TTransparentControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable, csOpaque];
Brush.Style := bsClear;
with Canvas do
begin
Pen.Style := psDash;
Pen.Color := clBlack;
Brush.Style := bsClear;
end;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TTransparentControl.Paint;
begin
inherited;
if csDesigning in ComponentState then
Canvas.Rectangle(0, 0, Width, Height);
if Assigned(FOnPaint) then FOnPaint(Self);
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TTransparentControl.InvalidateControlsUnderneath;
var
I: Integer;
Invalidating: Boolean;
Control: TControl;
procedure DoInvalidate(AControl: TControl);
var
I: Integer;
Control: TControl;
begin
if AControl is TWinControl then
begin
if TWinControl(AControl).HandleAllocated then
with TWinControl(AControl) do
begin
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_FRAME);
InvalidateRect(Handle, nil, True);
end;
if (csAcceptsControls in AControl.ControlStyle) then
for I := 0 to TWinControl(AControl).ControlCount - 1 do
begin
Control := TWinControl(AControl).Controls[I];
DoInvalidate(Control);
end;
end else
AControl.Invalidate;
end;
begin
Invalidating := False;
if HandleAllocated then
begin
for I := Parent.ControlCount - 1 downto 0 do
begin
Control := Parent.Controls[I];
if Invalidating then
DoInvalidate(Control)
else if Control = Self then
Invalidating := True;
end;
InvalidateRect(Parent.Handle, nil, True);
end;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TTransparentControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TTransparentControl.WMNCHitTest(var Message: TWMNCHitTest);
begin
if not FInterceptMouse then
Message.Result := HTTRANSPARENT
else
inherited;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TTransparentControl.Invalidate;
begin
InvalidateControlsUnderneath;
inherited Invalidate;
end;
//------------------------------------------------------------------------------
PS. Если от первонального кода изменять обработчик сообщения, то результат не изменится, потому как он унаследован от TCustomTransparentControl с неправильной обработкой
Проблема разрешилась )))
В классе TCustomTransparentControl стоит неверная обработка сообщения
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
...
procedure TCustomTransparentControl.WMNCHitTest(var Message: TWMNCHitTest);
begin
if not FInterceptMouse then
Message.Result := HTTRANSPARENT;
end;
Её нужно скорректировать, и у себя добавить свой обработчик, но уже
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
...
procedure TTransparentControl.WMNCHitTest(var Message: TWMNCHitTest);
begin
if not FInterceptMouse then
Message.Result := HTTRANSPARENT
else
inherited;
end;
Я сбросила этот флаг и стало понятно зачем он был установлен. При устновленном флаге контролы, лежащие под такой панелькой не только реагируют на мышь, но и видны, а когда снять этот флаг, то они пропадают. А вот сбрасывание флага не помогло, всё равно панелька не реагирует на мышь (((
Кстати оговорюсь, что просвечивание контролов под панелькой мне как раз актуально.
TCategoryPanel и сопутствующие ему класы появились вроде только в D2009.
Вобщем суть такова, что WS_EX_TRANSPARENT полностью отключает у окна реакцию на мишь. Зачем это было реализовывать если есть InterceptMouse я не знаю. Но вы легко можете сбросить этот флаг если перекроете в своем наследнике CreateParams:
procedure TCategoryPanelSurface.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle and not WS_EX_TRANSPARENT;
end;
Я что-то в ExtCtrls не могу найти TCategoryPanelSurface (Делфи 2007) (((
А на счёт TCustomTransparentControl.CreateParams у меня тоже под подозрением, но я не совсем понимаю, как его сбросить и в какой момент. Мне казалось, что этот метод вызывается один раз при создании, а я программно меняю галку, то есть уже после создания. Хотя, скорее всего я ошибаюсь по части того, когда он вызывается. Подскажите, плз.
Гляньте метод TCustomTransparentControl.CreateParams, там устанавливается флаг WS_EX_TRANSPARENT. Я думаю, вам нужно его сбросить, по крайней мере ExtCtrls.TCategoryPanelSurface именно так и делает.
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
