Casa
Top.Mail.Ru Yandeks.Metrika
Foro: "Principal";
Archivo actual: 2002.01.08;
Descargar: [xml.tar.bz2];
abajo

El componente no está dibujado, y eso es todo ... Encontrar ramas similares


Aleksandr (2001-12-18 13:03) (1)

Estimados colegas!
Понадобилось это мне создать компоненту. Создал, породив от TGraphicControl. Ставлю на форму - все в порядке, проперти видны, но вот не рисуется, и все тут... Код таков

tipo
TWayTree = class(TGraphicControl)
privada
...
protegido
procedure Paint;override;
público
constructor Create(AOwner : TComponent);
publicado
...
property Color default clWhite;
property Visible default true;
fin;

procedimiento de registro;

implementación

procedure TWayTree.Paint;
var
ARect : TRect;
comenzar
Inherited;
Canvas.Brush.Color:=Color;
ARect.Left:=Left;
ARect.Top:=Top;
ARect.Bottom:=Top+Height;
ARect.Right:=Left+Width;
Canvas.FillRect(ARect)
fin;

constructor TWayTree.Create;
comenzar
Inherited Create(AOwner);
...
fin;

procedimiento de registro;
comenzar
RegisterComponents("WayTrees", [TWayTree])
fin;

fin.

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

TWayTree = class(TGraphicControl)
privada
FPen : TPen;
FBrush : TBrush;
procedure RePaintRequest(Sender : TObject);
procedure SetBrush(Value : TBrush);
procedure SetPen(Value : TPen);
protegido
procedure Paint;override;
público
constructor Create(AOwner : TComponent);
destructor destruye;
publicado
property Color default clWhite;
property Visible;
property Brush : TBrush read FBrush write SetBrush;
property Pen : TPen read FPen write SetPen;
fin;

procedimiento de registro;

implementación

procedure TWayTree.Paint;
var
ARect : TRect;
comenzar
Inherited;
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");
fin;

destructor TWayTree.Destroy;
comenzar
FPen.Free;
FBrush.Free;
inherited Destroy
fin;

constructor TWayTree.Create;
comenzar
Inherited Create(AOwner);
FPen:=TPen.Create;
FBrush:=TBrush.Create;
FPen.OnChange:=RepaintRequest;
FBrush.OnChange:=RepaintRequest
fin;

procedure TWayTree.SetBrush;
comenzar
if Value=nil then
Salida
FBrush.Assign(Value);
Invalidar
fin;

procedure TWayTree.SetPen;
comenzar
if Value=nil then
Salida
FPen.Assign(Value);
Invalidar
fin;

procedure TWayTree.RePaintRequest;
comenzar
Invalidar
fin;

procedimiento de registro;
comenzar
RegisterComponents("WayTrees", [TWayTree]);
fin;

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


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

Перезапусти Delphi, говорят, помогает.
Про almacenados можно еще почитать...


Aleksandr (2001-12-18 13:11) (1)

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


csf (2001-12-18 13:19) (1)

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


Yuri Zotov (2001-12-18 14:30) (1)

> csf

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

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

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

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


> Aleksandr

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

procedure TWayTree.SetBrush;
comenzar
if Value=nil then // Это лишнее и даже вредно - маскирует ошибки юзера
Salida
FBrush.Assign(Value); // Генерит FBrush.OnChange и вызов RePaintRequest
Invalidate // Это лишнее - идет повторная перерисовка
fin;

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

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

publicado
property Pen: TPen read GetPen write SetPen;
...

function ...GetPen: TPen;
comenzar
Result := Canvas.Pen
fin;

procedure ...SetPen(const Value: TPen);
comenzar
Canvas.Pen.Assign(Value)
fin;

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



Aleksandr (2001-12-18 15:50) (1)

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


DieHard (2001-12-18 16:01) (1)

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


MBo (2001-12-18 16:02) (1)

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


Polevi (2001-12-18 16:19) (1)

TCustomControl


Aleksandr (2001-12-18 16:19) (1)

Мда... ладно, оставим сие пока... Вот как истчо избежать постоянного мерцания компоненты при изменении размеров формы?



panov2001-12-18 16:31) (1)

>Aleksandr © (18.12.01 16:19)
Попробуй указать Enabled := False перед изменением размеров


Yuri Zotov (2001-12-18 17:25) (1)

> Aleksandr © (18.12.01 15:50)

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

Lo que se requiere.


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

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

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

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

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

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

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



Páginas: 1 rama entera

Foro: "Principal";
Archivo actual: 2002.01.08;
Descargar: [xml.tar.bz2];

arriba















Memoria: 0.86 MB
Tiempo: 0.032 c
3-21917
Termik
2001-12-04 11:43
2002.01.08
Обращение к таблице по имени, записнному в переменной


3-21931
SklifF
2001-12-04 15:59
2002.01.08
¿Qué es este error? Capacidad no suppoted


4-22509
Karan
2001-11-08 12:50
2002.01.08
GetkeyboardState- ¿Qué hace?


4-22456
RedMax
2001-11-01 11:10
2002.01.08
COM объекты NetMeeting


1-22142
Principiante
2001-12-20 10:42
2002.01.08
ReplaceDialog





africaans albanés Arabic armenio Azerbaiyán vasco Bielorruso Bulgarian Catalán Chino (simplificado) Chino (tradicional) Croata Checo Danés Dutch Inglés Estonia filipina Finnish Francés
gallego georgiano Alemán Griego criollo haitiano hebreo hindi Húngaro islandés Indonesian irlandés Italiano Japonés Korean letón lituano macedonio Malay maltés Noruego
persa polaco Portuguese rumano Ruso Serbio Slovak Esloveno Español swahili Sueco Thai turco ucranio Urdu vietnamita galés yídish bengalí bosnio
cebuano esperanto gujarati hausa hmong igbo javanés kannada khmer lao latín maorí marathi mongol nepali punjabi somalí Tamil telugu yoruba
zulú
Английский Francés Alemán Italiano portugués Русский Español