Головна сторінка
Top.Mail.Ru Яндекс.Метрика
Форум: "Основна";
Поточний архів: 2002.01.08;
Завантажити: [xml.tar.bz2];

Вниз

Чи не малюється компонента, і все тут ... Знайти схожі гілки


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;
end;

procedure Register;

реалізація

procedure TWayTree.Paint;
було
ARect : TRect;
починати
Inherited;
Canvas.Brush.Color:=Color;
ARect.Left:=Left;
ARect.Top:=Top;
ARect.Bottom:=Top+Height;
ARect.Right:=Left+Width;
Canvas.FillRect(ARect)
end;

constructor TWayTree.Create;
починати
Inherited Create (AOwner);
...
end;

procedure Register;
починати
RegisterComponents("WayTrees", [TWayTree])
end;

end.

Мало того, когда я еще пытаюсь добавить свойства 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 Visible;
property Brush : TBrush read FBrush write SetBrush;
property Pen : TPen read FPen write SetPen;
end;

procedure Register;

реалізація

procedure TWayTree.Paint;
було
ARect : TRect;
починати
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");
end;

destructor TWayTree.Destroy;
починати
FPen.Free;
FBrush.Free;
inherited Destroy
end;

constructor TWayTree.Create;
починати
Inherited Create (AOwner);
FPen:=TPen.Create;
FBrush:=TBrush.Create;
FPen.OnChange:=RepaintRequest;
FBrush.OnChange:=RepaintRequest
end;

procedure TWayTree.SetBrush;
починати
if Value=nil then
Exit;
FBrush.Assign(Value);
Invalidate
end;

procedure TWayTree.SetPen;
починати
if Value=nil then
Exit;
FPen.Assign(Value);
Invalidate
end;

procedure TWayTree.RePaintRequest;
починати
Invalidate
end;

procedure Register;
починати
RegisterComponents("WayTrees", [TWayTree]);
end;

end.
компонента при вставлении в форму ругается, что не может установить 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 // Это лишнее и даже вредно - маскирует ошибки юзера
Exit;
FBrush.Assign(Value); // Генерит FBrush.OnChange и вызов RePaintRequest
Invalidate // Это лишнее - идет повторная перерисовка
end;

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

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

опублікований
property Pen: TPen read GetPen write SetPen;
...

function ...GetPen: TPen;
починати
Result := Canvas.Pen
end;

procedure ...SetPen(const Value: TPen);
починати
Canvas.Pen.Assign(Value)
end;

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



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]

>Aleksandr © (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];

наверх









Пам'ять: 0.87 MB
Час: 0.032 c
1-22055
walker_ag
2001-12-19 03:27
2002.01.08
Як це зробити ?


3-21908
Dup
2001-11-28 13:27
2002.01.08
Звісно додатки


14-22361
Микола
2001-11-08 00:17
2002.01.08
Так ...............................


4-22490
SergeyDonetsk
2001-11-06 09:22
2002.01.08
як на АПИ можна знаючи Handle Canvas а задати


14-22403
Burmistroff
2001-11-11 20:13
2002.01.08
Супер довідник по Delphi -2. Ваша думка, please.





африкаанс албанський арабська вірменин азербайджанець баскський білоруський болгарська каталонський Китайська (спрощене письмо) Китайський традиційний) хорватський чеська данську мову нідерландський Ukranian естонець Філіппінська фінську мову французький
галісійська грузинський німецький грецький гаїтянський креольський давньоєврейську хінді угорський ісландський індонезієць ірландський італійський японський корейський латиська литовець македонець малайський мальтійський норвежець
перс полірування португальська румунський російська сербський словацький словенський іспанська суахілі шведську мову тайський турецька український урду в'єтнамський валлійський ідиш бенгальський боснійський
кебуано есперанто гуджараті хауса хмонг ігбо яванський каннада кхмерская Лао латинь маорі маратхі монгольський непальська панджабі сомалійський тамільська телугу йоруба
зулуський
Англійська Французький Німецький Італійський Португальська Русский Іспанська