OwnerDraw TLabel

← →
IrBisoff © (2004-05-16 04:38) [0]

Как можно сделать сабж ? Вроде бы простой вопрос, но я чего-т пасую... Нужно выделить первый символ лэйбла другим цветом. Если не сложно - ответьте кодом.

← →
Mim1 © (2004-05-16 07:29) [1]

PaintBox, OnPaint
procedure TForm1.PaintBox1Paint(Sender: TObject); begin PaintBox1.Canvas.Font.Color := clRed; PaintBox1.Canvas.TextOut(0,0,"B"); PaintBox1.Canvas.Font.Color := clBlack; PaintBox1.Canvas.TextOut(PaintBox1.Canvas.TextWidth("B"),0,"egin"); end;

← →
IrBisoff © (2004-05-16 07:51) [2]

> PaintBox, OnPaint

Ок, понял, спасибо, но это видимо ещё не всё. При такой прорисовке Tlabel"a он ведёт себя очень странно - повляется только при автоматической перерисовке (убрать за видимую область экрана и вернуть назад к примеру), а вот при принудительной (Form.Repaint), да и вообще сразу после прорисовки - его не видно. =( Есть мысль, что поверх него рисуется стандартный кэпшн. =\

← →
IrBisoff © (2004-05-16 08:02) [3]

Уточнение: Вышенаписанное актуально в том случае, если вешать код на OnPaint формы (сколько не искал, у Tlabel Onpaint"a не нашёл =( ), а вот если вешать этот же код на событие (например, нажатие кнопки), то он ведёт себя с точностью до наоборот. =\

← →
Mim1 © (2004-05-16 10:36) [4]

примерно так

unit MimLabel; interface uses SysUtils, Classes, Controls, StdCtrls; type TMimLabel = class(TLabel) private { Private declarations } protected procedure Paint; override; { Protected declarations } public { Public declarations } published { Published declarations } end; procedure Register; implementation uses Graphics; procedure Register; begin RegisterComponents("Standard", [TMimLabel]); end; { TMimLabel } procedure TMimLabel.Paint; begin inherited; if length(text) > 0 then begin Canvas.Font.Color := clRed; Canvas.TextOut(0,0,copy(text,1,1)); Canvas.Font.Color := clBlack; Canvas.TextOut(Canvas.TextWidth(copy(text,1,1)),0,copy(text,2,maxint)); end; end; end.

← →
IrBisoff © (2004-05-16 10:56) [5]

> примерно так

Большое спасибо, хотя можно было настолько и не расписывать. ;)

← →
IrBisoff © (2004-05-16 11:23) [6]

> PaintBox, OnPaint

Ага, есть ещё один вопрос - как быть со сглаживанием ? В Tlabel сглаживание присутствует изначально, а вот если на канве рисовать текстом - сглаживание улетучивается "как с белых..". =(

← →
Mim1 © (2004-05-16 11:29) [7]

В приведенном компоненте сглаживание есть.
Вы наверное опять что нибудь не так делаете.

← →
IrBisoff © (2004-05-16 11:38) [8]

> В приведенном компоненте сглаживание есть.
> Вы наверное опять что нибудь не так делаете.

Абсолютно всё. =) Я использую это не как компонент, а всего лишь как класс, эт раз. Я не просто делаю Canvas.Font.Color := clRed;, а вот так:

if BigFirst then begin Canvas.Font := Freader.LabelCustomTitle.Font; Canvas.TextOut(0,0,copy(text,1,1)); Canvas.Font := Freader.LabelCustom.Font; Canvas.TextOut(Canvas.TextWidth(copy(text,1,1)),0,copy(text,2,maxint)); end else Canvas.TextOut(0,0,copy(text,1,maxint));, эт два.
А третий пункт - шрифт там Sylfaen. Конечно, для MS Sans Serif можно сглаживание и не юзать. ;)

← →
Mim1 © (2004-05-16 11:46) [9]

Вообщем понятно что ничего не понятно. :)
Вообщем смотрите реализацию метода procedure TCustomLabel.Paint; и
procedure TCustomLabel.DoDrawText(var Rect: TRect; Flags: Longint);

Если шрифт меняется то прямоугольник метки надо перерасчитывать (если autosize = true) вместо вызова inherited в моем коде.

← →
IrBisoff © (2004-05-16 12:25) [10]

> Если шрифт меняется то прямоугольник метки надо перерасчитывать
> (если autosize = true) вместо вызова inherited в моем коде.

Вот. Прямо в точку. =) Я как-то об этом не подумал. На самом деле у первого символа меняется не только цвет, но и аттрибут fsBold, следовательно строка смещается и кажется, что она не сглажена. Ведь фактически прорисовка идёт по верху стандартной, а не вместо неё. =) Каюсь, грешен. =)

Итак, как перерассчитывать этот самый прямоугольник метки ? =D

Хотя, впрочем, даже если я и не ставлю fsBold я получаю тот же эффект при шрифтах отличных от Sans"a. =\ Тут нужно каким-то образом заставить label не прорисовывать кэпшн, а делать это самому.

> не прорисовывать кэпшн

У лабела, кроме заимствований от TGraphicControl все (imho) св-ва связаные с Catpion.
Начинай с TGraphicControl - никакого готового капшна не будет.

> У лабела, кроме заимствований от TGraphicControl все (imho)
> св-ва связаные с Catpion.
> Начинай с TGraphicControl - никакого готового капшна не
> будет.

А как тогда реализовать Transparent ? Если бы не это проперти, можно было бы просто не вызывать в вышеприведенном коде inherited.

> Вы внимательно изучили методы Paint и DoDrawText предка?

Нет, невнимательно. =) А можно пример оверрайда для DoDrawText ? =) Ленивый я по природе своей.. =(

OwnerDraw TLabel Найти похожие ветки