Вопрос по TWinControl

← →
Style © (2004-02-11 13:00) [0]

Пытаюсь использовать линейки прокрутки TWinControl
В общем они у меня рисуются, и прекрасно работают в RunTime, но в DesignTime не хотят реагировать на мышь, т.е. не кнопочки не сама прокрутка не работают.
Что делать?

вот пример кода:

unit ScrollingControl; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth); TScrollingControl = class(TWinControl) private FBorderStyle: TBorderStyle; FScrollBars: TScrollStyle; procedure SetBorderStyle(Value: TBorderStyle); procedure SetScrollBars(Value: TScrollStyle); { Private declarations } protected { Protected declarations } public procedure CreateParams(var Params: TCreateParams); override; { Public declarations } published property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents("Samples", [TScrollingControl]); end; procedure TScrollingControl.SetBorderStyle(Value: TBorderStyle); begin if FBorderStyle <> Value then begin FBorderStyle := Value; RecreateWnd; end; end; procedure TScrollingControl.SetScrollBars(Value: TScrollStyle); begin if FScrollBars <> Value then begin FScrollBars := Value; RecreateWnd; end; end; procedure TScrollingControl.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := Style or WS_TABSTOP; if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; WindowClass.style := CS_DBLCLKS; if FBorderStyle = bsSingle then if NewStyleControls and Ctl3D then begin Style := Style and not WS_BORDER; ExStyle := ExStyle or WS_EX_CLIENTEDGE; end else Style := Style or WS_BORDER; end; end; end.

← →
NAlexey © (2004-02-11 13:16) [1]

Ну так кажись все честно:
procedure TWinControl.WMNCHitTest(var Message: TWMNCHitTest); begin with Message do if (csDesigning in ComponentState) and (FParent <> nil) then Result := HTCLIENT else inherited; end;

← →
Style © (2004-02-11 14:49) [2]

Так вот в Grid"е они работают в DesignTime.
Чета я совсем запутался.. Можеть кто знает как заставить их работать???

← →
Style © (2004-02-11 14:58) [3]

Все понял!

Просто случайно забыл добавить message WM_NCHITTEST;
в конце объявления процедуры и долго мучался.
type TScrollingControl = class(TWinControl) ..... protected procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; ... end; procedure TScrollingControl.WMNCHitTest(var Message: TWMNCHitTest); begin DefaultHandler(Message); end;

← →
Юрий Зотов © (2004-02-11 15:04) [4]

В принципе, в VCL есть готовый класс TScrollingWinControl. Не будет ли проще отнаследоваться от него?

← →
Style © (2004-02-11 15:19) [5]

Юрий Зотов ©

Интересно почему же тогда TCustomGrid не наследуется от TScrollingWinControl, а сам TScrollingWinControl
не входит в состав юнита Controls?
TCustomGrid, и большинство других визуальных компонентов с ScrollBars наследуются от TCustomControl.

Можеть действительно было бы проще TCustomControl Наследовать от TScrollingWinControl?

← →
DiamondShark © (2004-02-11 16:08) [6]

> Интересно почему же тогда TCustomGrid не наследуется от
> TScrollingWinControl

Потому что TScrollingWinControl -- контейнер.

← →
Style © (2004-02-11 16:32) [7]

TScrollingWinControl -- контейнер.

Что то я этого не вижу?

TScrollingControl = class(TScrollingWinControl) private { Private declarations } protected { Protected declarations } public { Public declarations } published { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents("Samples", [TScrollingControl]); end;

← →
DiamondShark © (2004-02-11 16:43) [8]

Да, так он не контейнер, надо добавить csAcceptControls в ControlStyle.
Но умеет двигать вложенные контролы, если его сделать контейнером.

← →
Style © (2004-02-11 16:54) [9]

DiamondShark ©

constructor TScrollingControl.Create(AOwner: TComponent); begin ControlStyle := [csAcceptsControls]; end;

не работает..

← →
DiamondShark © (2004-02-11 17:12) [10]

Что не работает? Как контейнер не работает?

constructor TScrollingWinControl1.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csAcceptsControls];
end;

Или что не работает?

добавить

TScrollingWinControl1 = class(TScrollingWinControl)
protected
procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
...

procedure TScrollingWinControl1.WMNCHitTest(var Message: TMessage);
begin
DefaultHandler(Message);
end;

и будет скролинг в дизайн-тайм

2 DiamondShark ©
Да не работал как контейнер! потому что в торопях забыл сделать Create - override;

Да собственно и TWinControl может двигать контролы, я незнаю чего это ты так решил что это реализовано на уровне TScrollingWinControl.

Так мне и не ответили, почему же тогда если TScrollingWinConrol
не контейнер, такие компоненты как TDrawGrid наследуются от TCustomControl.
То есть получается какая то странная иерархическая структура у VCL.

TControl /\ TWinControl TGraphicsControl /\ TScrollingWinControl TCustomControl | | TScrollBox TCustomGrid TFrame TDrawGrid TForm TListView ..... ......

TFrom имеет канву и имеет ScrollBars, но наследуется от TScrollingWinControl, в то время как TGrid имеет те же свой-ва, но наследуется от TCustomControl?

Может действительно было бы проще объединить CustomControl и ScrollingWinControl,
учитывая что код CustomControl не так уж и велик и в тех случаях когда ScrollBars не нужны наследоваться напрямую от TWinControl?

Или я выпил мало пива? :lol:

Вопрос по TWinControl Найти похожие ветки