Տուն
Top.Mail.Ru Moscow
Ֆորում: «Գլխավոր»;
Ընթացիկ արխիվը `2002.01.08;
Բեռնել: [xml.tar.bz2];

Down

Բաղադրիչը գծված չէ, և դա այն է ... Գտնել նմանատիպ մասնաճյուղեր


Aleksandr   (2001-12-18 13:03) [0]

Հարգելի գործընկերներ:
Понадобилось это мне создать компоненту. Создал, породив от TGraphicControl. Ставлю на форму - все в порядке, проперти видны, но вот не рисуется, и все тут... Код таков

տիպ
TWayTree = class(TGraphicControl)
անձնական
...
պաշտպանված
procedure Paint;override;
հասարակություն
constructor Create(AOwner : TComponent);
լույս
...
property Color default clWhite;
property Visible default true;
վերջը.

ընթացակարգի գրանցում;

իրականացում

procedure TWayTree.Paint;
էր
ARect : TRect;
սկսել
Ժառանգված;
Canvas.Brush.Color:=Color;
ARect.Left:=Left;
ARect.Top:=Top;
ARect.Bottom:=Top+Height;
ARect.Right:=Left+Width;
Canvas.FillRect(ARect)
վերջը.

constructor TWayTree.Create;
սկսել
Մնացած Ստեղծեք (AOwner);
...
վերջը.

ընթացակարգի գրանցում;
սկսել
RegisterComponents("WayTrees", [TWayTree])
վերջը.

վերջ:

Мало того, когда я еще пытаюсь добавить свойства FPen и FBrush (для отдельного доступа в дизайн-тайме):

TWayTree = class(TGraphicControl)
անձնական
FPen : TPen;
FBrush : TBrush;
procedure RePaintRequest(Sender : TObject);
procedure SetBrush(Value : TBrush);
procedure SetPen(Value : TPen);
պաշտպանված
procedure Paint;override;
հասարակություն
constructor Create(AOwner : TComponent);
destructor Destroy;
լույս
property Color default clWhite;
սեփականության տեսանելի;
property Brush : TBrush read FBrush write SetBrush;
property Pen : TPen read FPen write SetPen;
վերջը.

ընթացակարգի գրանցում;

իրականացում

procedure TWayTree.Paint;
էր
ARect : TRect;
սկսել
Ժառանգված;
Canvas.Pen:=FPen;
Canvas.Brush:=FBrush;
Canvas.Brush.Color:=Color;
ARect.Left:=Left;
ARect.Top:=Top;
ARect.Bottom:=Top+Height;
ARect.Right:=Left+Width;
Canvas.FillRect(ARect);
Canvas.TextOut(ARect.Left,ARect.Top,"AAA");
վերջը.

կործանիչ TWayTree.Destroy;
սկսել
FPen.Free;
FBrush.Free;
ժառանգել Destroy
վերջը.

constructor TWayTree.Create;
սկսել
Մնացած Ստեղծեք (AOwner);
FPen:=TPen.Create;
FBrush:=TBrush.Create;
FPen.OnChange:=RepaintRequest;
FBrush.OnChange:=RepaintRequest
վերջը.

procedure TWayTree.SetBrush;
սկսել
if Value=nil then
Ելք.
FBrush.Assign(Value);
Անօրինականություն
վերջը.

procedure TWayTree.SetPen;
սկսել
if Value=nil then
Ելք.
FPen.Assign(Value);
Անօրինականություն
վերջը.

procedure TWayTree.RePaintRequest;
սկսել
Անօրինականություն
վերջը.

ընթացակարգի գրանցում;
սկսել
RegisterComponents("WayTrees", [TWayTree]);
վերջը.

վերջ:
компонента при вставлении в форму ругается, что не может установить Pen в nil. Pen и Brush в Инспекторе появляются, но при нажатии на + нифига не выпадает, при изменении размеров компоненты та же ошибка... Чего я тут не так делаю?



csf   (2001-12-18 13:09) [1]

Перезапусти Delphi, говорят, помогает.
Մոտ պահվում можно еще почитать...



Aleksandr   (2001-12-18 13:11) [2]

Сорри, мне пора на свалку... Разобрался, что забыл override напротив констрактора с дестрактором нарисовать... Интересно, как можно к этой компоненте подключить вертикальный ScrollBar...



csf   (2001-12-18 13:19) [3]

... хорошо бы проверять при Paint FPen & FBrush на nil...



Юрий Зотов   (2001-12-18 14:30) [4]

> csf

1. > Перезапусти Delphi, говорят, помогает.
Ценнейший совет.

2. > Про stored можно еще почитать...
Можно. Только к сабжу это не имеет никакого отношения.

3. > ... хорошо бы проверять при Paint FPen & FBrush на nil...
Зачем? Oни созданы в конструкторе компонента. Nil там быть никак не может.

Итого: Вы написали 3 фразы и все 3, извините, чушь. Стоило ли писать? Стоит ли вообще отвечать на вопросы, тема которых Вам, мягко говоря, не очень хорошо знакома?


> Aleksandr

С override Вы уже сами разобрались, но это еще не все - у Вас идет двойная перерисовка:

procedure TWayTree.SetBrush;
սկսել
if Value=nil then // Это лишнее и даже вредно - маскирует ошибки юзера
Ելք.
FBrush.Assign(Value); // Генерит FBrush.OnChange и вызов RePaintRequest
Invalidate // Это лишнее - идет повторная перерисовка
վերջը.

И то же самое в SetPen. Кроме того, переменная ARect в Paint совершенно не нужна - используйте ClientRect или Canvas.ClipRect.

Наконец, главное - свои FBrush и FPen абсолютно ни к чему - только лишние ресурсы гробят. Используйте встроенные в Canvas:

լույս
property Pen: TPen read GetPen write SetPen;
...

function ...GetPen: TPen;
սկսել
Result := Canvas.Pen
վերջը.

procedure ...SetPen(const Value: TPen);
սկսել
Canvas.Pen.Assign(Value)
վերջը.

Вывод - даже такие простейшие компоненты надо продумывать более тщательно и делать более акккуратно.



Aleksandr   (2001-12-18 15:50) [5]

2 Юрий Зотов
Спасибо за инфу. Однако, прямое обращение к свойствам канвы вызовет то, что не будет "стандартов" по умолчанию - она всегда будет продолжать рисовать тем цветом, который использовался последним. И, соответственно, на OnChange ничего посадить нельзя - будет происходить элементарное зацикливание - установка цвета канвы вызывает OnChange, он вызывает перерисовку, а в перерисовке опять меняется цвет Canvas.
Остался один вопрос на повестке: как засобачить в компоненту TScrollBar? Что-то у меня не получается нифига сделать двойное наследование - от TGraphicControl и от TScrollBar...



DieHard   (2001-12-18 16:01) [6]

Двойное наследование не пройдет.
Попробуй наследовать от TScrollBox.



MBo   (2001-12-18 16:02) [7]

двойного наследования нет.
может, наследовать от TWinControl?



Polevi   (2001-12-18 16:19) [8]

TCustomControl- ը



Aleksandr   (2001-12-18 16:19) [9]

Հըմ ... լավ, հիմա թողնենք սա ... Ահա, թե ինչպես կարելի է խուսափել ձևերը չափափոխելիս անընդհատ թարթող բաղադրիչներից:



panov   (2001-12-18 16:31) [10]

> Ալեքսանդր © (18.12.01 16: 19)
Попробуй указать Enabled := False перед изменением размеров



Юрий Зотов   (2001-12-18 17:25) [11]

> Aleksandr © (18.12.01 15:50)

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

Что и требуется.


> И, соответственно, на OnChange ничего посадить нельзя

И не нужно. Ваш метод Paint будет вызван автоматически, а больше ничего и не требуется.

> будет происходить элементарное зацикливание - установка цвета канвы
> вызывает OnChange, он вызывает перерисовку, а в перерисовке опять
> меняется цвет Canvas.

Во-первых, Вы сами подтверждаете, что смена свойств канвы автоматически вызывает Ваш метод Paint. Значит, Вы должны согласиться с предыдущим пунктом - никакие обработчики OnChange Вам не нужны (обработчики OnChange дают только лишнюю перерисовку - отсюда и лишнее моргание).

Во-вторых, в перерисовке НЕ НУЖНО менять свойств канвы. Зачем? Ведь если Вы завяжете свойства компонента на свойства канвы, то при вызове метода Paint эти свойства канвы УЖЕ будут установлены, как надо. С ними и рисуйте, ничего не меняя. И тогда не будет никакого зацикливания.

В общем, советую попробовать - увидите сами. Думаю, и мерцание значительно уменьшится.

Далее, по поводу мерцания и ScrollBar - прислушайтесь к совету Polevi. TCustomControl - это окно. ScrollBar"ы туда вставляются простым выставлением стилей WS_HSCROLL/WS_VSCROLL в CreateParams, а уменьшить мерцание можно установкой свойства DoubleBuffered.



Էջեր: 1 ամբողջ ճյուղը

Ֆորում: «Գլխավոր»;
Ընթացիկ արխիվը `2002.01.08;
Բեռնել: [xml.tar.bz2];

Up









Հիշողություն `0.61 ՄԲ
Ժամանակը `0.045 գ
3-21952
S_King
2001-12-04 10:18
2002.01.08
Որոշեք առաջին ազատ ID- ն


1-22242
Թթու
2001-12-14 11:00
2002.01.08
POP3


3-21951
բալանսը
2001-12-05 11:07
2002.01.08
Օգտագործեք QuantumGrid


3-21950
Հերմիտ
2001-12-05 11:38
2002.01.08
Անուղղակի սկսված գործարքներ


14-22373
panov
2001-11-08 18:34
2002.01.08
Մրցակցային ծրագրի դեմ հատուկ նախագծի մշակում:





afrikaans ալբանական արաբական հայերեն ադրբեջանական Բասկերի Բելառուսի Բուլղարիայի catalan Չինարեն (պարզեցված) Չինարեն (ավանդական) Խորվաթիայի չեխ դանիերեն հոլանդական Անգլերեն
Էստոնիայի filipino ֆիններեն ֆրանսերեն
galician վրացական գերմանական հունարեն haitian Creole եբրայերեն հինդի հունգարերեն icelandic հայերեն իռլանդական իտալական ճապոնացի Կորեայի Լատվիայի Լիտվայի մակեդոներեն Մալայերեն մալթերեն նորվեգական
պարսկական Լեհաստանի պորտուգալացի ռումինական ռուսական սերբերեն Սլովակիայի Սլովենիայի իսպաներեն սուահիլի շվեդերեն թայերեն թուրքական ուկրաինական ուրդու վիետնամերեն ուելսերեն հայերեն bengali բոսնիերեն
Cebuano Esperanto գուջարաթի հաուսա Hmong Igbo ճավաերեն kannada Khmer Lao լատիներեն մաորի մարաթի մոնղոլական նեպալերեն Punjabi Somali tamil telugu յորուբա
զուլուսերեն
Անգլերեն Французский Немецкий Итальянский Португальский Русский Испанский