Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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
3-88388
Oleg_er
2002-05-04 11:05
2002.05.27
Создание таблицы


1-88546
-Jack-
2002-05-15 15:36
2002.05.27
Не пашет условие


3-88364
Pavel_mal
2002-05-01 16:59
2002.05.27
Отчет для таблицы


1-88456
Ross
2002-05-17 16:23
2002.05.27
Что мне нужно добавить?


7-88647
Neo_Max
2002-03-01 12:56
2002.05.27
Работа с системными прерываниями и регистрами процессора





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский