PHP DM Gate v0.9 » Компонент на осн. TPanel, как управлять событиям дочерних ком-в?

TheEd (05.04.11 10:54) [0]

Суть в следующем: нужен компонент с поведением TSpeedButton (не имеющий фокуса), но чтобы на него можно было накидать другие объекты, напр. анимированный гив + пару ТиЛэйблов и т.д.

Не стал искать готового, пишу свой на основе TPanel примерно вот что получилось:

unit ButtonPanel;
interface
uses
SysUtils, Classes, Controls, Windows, ExtCtrls;

type
TButtonPanel = class(TPanel)
private
FWasDown : boolean;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure AdjustClientRect(var Rect: TRect); override;
public
constructor Create(AOwner: TComponent); override;
end;

procedure Register;

implementation

uses Types;

procedure Register;
begin
RegisterComponents('Ed', [TButtonPanel]);
end;

procedure TButtonPanel.AdjustClientRect(var Rect: TRect);
var
BevelSize: Integer;
begin {это для того, чтобы слиентская область смещалась во время нажатия}
inherited;
BevelSize := 0;
if BevelOuter <> bvNone then Inc(BevelSize, BevelWidth);
if BevelInner <> bvNone then Inc(BevelSize, BevelWidth);
if not (csDesigning in ComponentState) then
if FWasDown then
begin
Rect.Left := Rect.Left + BevelSize + BorderWidth;
Rect.Top := Rect.Top + BevelSize + BorderWidth;
end
else
begin
Rect.Right := Rect.Right - BevelSize - BorderWidth;
Rect.Bottom := Rect.Bottom - BevelSize - BorderWidth;
end
else
begin {в дизайнтайме - работаетм без смещения вниз}
Rect.Right := Rect.Right - BevelSize - BorderWidth;
Rect.Bottom := Rect.Bottom - BevelSize - BorderWidth;
end;
end;

constructor TButtonPanel.Create(AOwner: TComponent);
begin
inherited;
BevelInner := bvRaised;
FWasDown := false;
end;

procedure TButtonPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
FWasDown := true;
BevelOuter := bvLowered;
if BevelInner = bvRaised then
BevelInner := bvLowered;
Invalidate;
end;

procedure TButtonPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
FWasDown := false;
BevelOuter := bvRaised;
if BevelInner = bvLowered then
BevelInner := bvRaised;
Invalidate;
end;
end.

но вот трабл - если на такой "кнопарь" положить компонент, то он начинает принимать события OnMouseUp/Down и кнопка не нажимается. Есть конечно мысль переписать OnShow и назначить всем дочерним компонентам соответствующие события, но чувствую что это не совсем правильно - юзер же может их переопределить...
Подскажите как сделать правильно?

<Цитата>
DimaBr © (05.04.11 11:37) [1]

Переназначьте всем компонентам лежащим на вашей панели события MouseUp, MouseDown

<Цитата>
DimaBr © (05.04.11 11:39) [2]

Запретите закидывать TWinControl-ы на вашу панель

<Цитата>
помогите новичку (05.04.11 20:55) [3]

> Переназначьте всем компонентам лежащим на вашей панели события
> MouseUp, MouseDown

Да, но есть косячок: у TControl'а OnMouseUp и OnMouseDown описаны как Protected и к ним не доберёшься, а перебирать все возможные компоненты, которые открывают эти свойства - не вариант.

> Запретите закидывать TWinControl-ы на вашу панель

дык это не надо запрещать - это то что предполагается делать...

ps: у формы есть такая фишка как KeyPreview - т.е. прежде чем нажатие клавиши отработает на компоненте с фокусом, это нажатие отработает событие формы. Нет ли возможности сделать МаусПревью для ТиПанели?

<Цитата>
TheEd (05.04.11 22:09) [4]

Ладно, фиг с ним, обошелся ручным назначением событий всем компонентам которые на subj ложатся:

procedure TMyForm.BtnPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
ctrl : TWinControl;
begin
inherited;
ctrl := TControl(Sender).Parent;
while (ctrl <> nil) do
if ctrl is TButtonPanel
then break
else ctrl := ctrl.Parent;
with TButtonPanel(ctrl) do
TransferMouseUp(Button, Shift, Left + X, Top + Y);
end;

procedure TMyForm.BtnPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
ctrl : TWinControl;
begin
inherited;
ctrl := TControl(Sender).Parent;
while (ctrl <> nil) do
if ctrl is TButtonPanel
then break
else ctrl := ctrl.Parent;
with TButtonPanel(ctrl) do
TransferMouseDown(Button, Shift, Left + X, Top + Y);
end;

не так удобно, но мириться можно...

<Цитата>
DimaBr © (06.04.11 01:14) [5]

> нужен компонент с поведением TSpeedButton (не имеющий фокуса), но чтобы на него можно было накидать другие объекты, напр. анимированный гив + пару ТиЛэйблов.

Про TWinControl - ничего не сказано. Если вы закините на свою панель TWinControl (например TEdit, TMemo, TListBox), то он сможет получить фокус, а это противоречит первоначальной логике.

> Да, но есть косячок: у TControl'а OnMouseUp и OnMouseDown описаны как Protected и к ним не доберёшься, а перебирать все возможные компоненты, которые открывают эти свойства - не вариант.

Нет никакого косячка. Перекрываете событие CM_ControlChange и переназначаем события мышки

type
THaskControl = class(TControl);
procedure TMyControl.CMControlChange(var Message: TMessage);
var AControl: TControl;
begin
AControl := THaskControl(Message.WParam);
inherited;
AControl.OnMouseDown := MyMoyseDown;
AControl.OnMouseUp := MyMoyseUp;
end;

<Цитата>
TheEd (06.04.11 11:44) [6]

> Если вы закините на свою панель TWinControl (например TEdit,
> TMemo, TListBox), то он сможет получить фокус, а это противоречит
> первоначальной логике.

Предполагается что это будут рисунки, лэйблы, причие украшения, в которые можно ткнуть пальцем на тачскрине.

> Перекрываете событие CM_ControlChange и переназначаем события
> мышки

За пример 10 баллов! Спасибо, попробую! :))

<Цитата>
TheEd (06.04.11 14:21) [7]

type THaskControl = class(TControl);
procedure TMyControl.CMControlChange(var Message: TMessage);
var AControl: TControl;
begin
AControl := THaskControl(Message.WParam);
inherited;
AControl.OnMouseDown := MyMoyseDown;
AControl.OnMouseUp :=MyMoyseUp;
end;

нет, не то:
AControl := THaskControl(Message.WParam);
а на THaskControl могут кинуть TPanel, TLabel и прочие компоненты, а не самого себя.
сработает только ручной вариант перебора что же положили типа:

AControl := TControl(Message.WParam);
if AControl is TPanel then
with AControl as TPanel do
begin
AControl.OnMouseDown := MyMoyseDown;
AControl.OnMouseUp :=MyMoyseUp;
end
else if AControl is TLabel then
with AControl as TLabel do
begin
AControl.OnMouseDown := MyMoyseDown;
AControl.OnMouseUp :=MyMoyseUp;
end
else if AControl is T... then
with AControl as T... do
begin
AControl.OnMouseDown := MyMoyseDown;
AControl.OnMouseUp :=MyMoyseUp;
end
...

но все компоненты не перебрать...

<Цитата>
DimaBr © (07.04.11 01:09) [8]

procedure DoControls(AControl: TControl);
var i: integer;
begin
if AControl is TControl then
with THaskControl(AControl) do begin
OnMouseDown := MyMouseDown;
OnMouseUp :=MyMouseUp;
end
else
if AControl is TWinControl do
with THaskControl(AControl) do begin
OnMouseDown := MyMouseDown;
OnMouseUp :=MyMouseUp;
for i := 0 to ControlCount-1 do
DoControls(Controls[i]);
end;
end;

<Цитата>
TheEd (09.04.11 01:21) [9]

> THaskControl(AControl)

Уважаемый DimaBr, не могу понять корректно ли преобразовывать AControl к THaskControl, если он заведомо потомок или TControl или TWinControl, но не THaskControl, и не известно, открыты ли его protected-свойства в published области или нет. Не вызовет ли исключения такое присвоение:
THaskControl(SomeControlWithProtectedMouseProperties).OnMouseDown := SomethingProcedure?
Ведь protected-свойства доступны только для наследников?

<Цитата>
DimaBr © (10.04.11 00:02) [10]

Вот именно по этому мы и объявляем наследника TControl, чтобы получить доступ к protected свойствам. Никакого горя не будет. Если эти свойства описаны в родителе, обрабатываются в родителе, то повышение их видимости ничем не грозит.

<Цитата>