Форум: "Потрепаться";
Текущий архив: 2004.03.05;
Скачать: [xml.tar.bz2];
ВнизВопрос по 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;
Или что не работает?
← →
DiamondShark (2004-02-11 17:24) [11]добавить
TScrollingWinControl1 = class(TScrollingWinControl)
protected
procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
...
procedure TScrollingWinControl1.WMNCHitTest(var Message: TMessage);
begin
DefaultHandler(Message);
end;
и будет скролинг в дизайн-тайм
← →
Style (2004-02-12 09:14) [12]2 DiamondShark ©
Да не работал как контейнер! потому что в торопях забыл сделать Create - override;
Да собственно и TWinControl может двигать контролы, я незнаю чего это ты так решил что это реализовано на уровне TScrollingWinControl.
← →
Style (2004-02-13 00:03) [13]Так мне и не ответили, почему же тогда если 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?
← →
Style (2004-02-13 00:04) [14]Или я выпил мало пива? :lol:
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2004.03.05;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.006 c