Форум: "Основная";
Текущий архив: 2002.05.27;
Скачать: [xml.tar.bz2];
Вниз
Отрисовка TCustomLabel Найти похожие ветки
← →
Andre V. (2002-05-16 12:53) [0]В наследнике TCustomLabel полностью переписана процедура Paint.
При перерисовке экран (область) сначала закрашивается белым
цветом.
ЧТО ПРОПУЩЕНО В СВОЙСТВАХ?
← →
Игорь Шевченко (2002-05-16 12:55) [1]Andre V. (16.05.02 12:53)
А посмотреть, что сделано, можно?
← →
Andre V. (2002-05-16 13:08) [2]Ради бога!
Я то, дурак, место экономил....
Type
TSSCustomLabel = class(TCustomLabel)
private
{ Private declarations }
protected
{ Protected declarations }
procedure DoDrawText( Var Rect : TRect; Flags : LongInt ); override;
published
{ Published declarations }
end;
Type
TSSLiteLabel = class(TSSCustomLabel)
private
{ Private declarations }
protected
{ Protected declarations }
procedure Paint; override;
procedure DrawImage; virtual;
procedure DrawBitmap; virtual;
public
{ Public declarations }
published
{ Published declarations }
end;
procedure TSSLiteLabel.Paint;
Var
H : Integer;
L : Integer;
Rt : Integer;
T : Integer;
B : Integer;
R : TRect;
Var
ColorOne : TColor;
ColorTwo : TColor;
procedure DrawBorderRect;
begin
with Canvas do
begin
Pen.Color := ColorOne;
PolyLine( [Point(R.Left, R.Bottom), Point(R.Left, R.Top),
Point(R.Right, R.Top)] );
Pen.Color := ColorTwo;
PolyLine( [Point(R.Right, R.Top), Point(R.Right, R.Bottom),
Point(R.Left, R.Bottom)] );
end;
end;
begin
R := Rect( 0, 0, Width, Height );
if (NOT FTransp)AND(NOT FTile) then
FillArea( R );
DrawBitmap;
DrawImage;
if FSeparate
then
begin
L := FLeft;
Rt := FRight;
T := FTop;
B := FBottom;
case FILayout of
tlTop:
case FIAlign of
taLeftJustify: begin
inc( FLeft, FImages.Width );
{inc( FTop, FImages.Height );}
end;
taRightJustify: begin
inc( FRight, FImages.Width );
{inc( FTop, FImages.Height );}
end;
else
inc( FTop, FImages.Height );
end;
tlBottom:
case FIAlign of
taLeftJustify: begin
inc( FLeft, FImages.Width );
{inc( FBottom, FImages.Height );}
end;
taRightJustify: begin
inc( FRight, FImages.Width );
{inc( FBottom, FImages.Height );}
end;
else
inc( FBottom, FImages.Height );
end;
else
case FIAlign of
taLeftJustify: begin
inc( FLeft, FImages.Width );
end;
taRightJustify: begin
inc( FRight, FImages.Width );
end;
end;
end;
inherited;
FLeft := L;
FRight := Rt;
FTop := T;
FBottom := B;
end
else
inherited;
H := FThink;{
dec(R.Right);
dec(R.Bottom);}
with Canvas do
case FBorder of
bsNone:;
....
end;
end;
← →
Song (2002-05-16 13:22) [3]FillArea() видимо...
← →
Игорь Шевченко (2002-05-16 13:24) [4]День добрый,
> if (NOT FTransp)AND(NOT FTile) then
> FillArea( R );
Эти условие гарантировано не выполняется ?
← →
Andre V. (2002-05-16 13:32) [5]ДА. Если интересно, приведу текст FillArea, но он еще больше.
← →
Игорь Шевченко (2002-05-16 13:53) [6]Andre V. (16.05.02 13:32)
Зачем его приводить, если он не вызывается, как вы говорите ? :-)
Просто закомментируйте выделенные мной строчки и проверьте...
С уважением,
← →
Andre V. (2002-05-16 14:04) [7]Проверял беднягу. Насколько Вы понимаете, под текстом был
нарисованный ранее объект. Но закраска белым цветом не исчезла.
!!!!!
При перерисовке Label сначала белый цвет, затем фон окна, в
котором стоит Label, затем сам Label.
← →
Игорь Шевченко (2002-05-16 14:26) [8]Andre V. (16.05.02 14:04)
> При перерисовке Label сначала белый цвет, затем фон окна,
> в
> котором стоит Label, затем сам Label.
Это про стандартный Tlabel или про ваш ?
← →
Andre V. (2002-05-16 14:52) [9]Мой. Текст см. выше. Для перерисовки используется Invalidate.
← →
Игорь Шевченко (2002-05-16 15:51) [10]Andre V. (16.05.02 14:52)
Я извиняюсь, но может, вы где-то BrushStyle := bsClear забыли поставить ?
← →
Andre V. (2002-05-16 15:57) [11]Нет, не забыли. Это где-то в другом происходит.
А вывод лайбы в режиме прозрачности. Ежели под нее рисунок к
примеру положить, то его видно будет. Но потом, после переза-
краски (фон-белый цвет-фон).
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.05.27;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.007 c
