Легенда:
 новое сообщение
 закрытая нитка
 новое сообщение
 в закрытой нитке
 старое сообщение
|
- Напоминаю, что масса вопросов по функционированию форума снимается после прочтения его описания.
- Новичкам также крайне полезно ознакомиться с данным документом.
|
"Как сделать так, чтобы каждая строка в ListBox имела свой цвет" (заметка) 08.06.05 16:46 Число просмотров: 2309
Автор: n0xi0uzz <Черкасов Виктор> Статус: Member
|
У меня есть два примера процедур OnDrawItem:
procedure TTest.ListBox1DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TListBox).Canvas do
begin
case Index of
0:
begin
Font.Color := clBlue;
Brush.Color := clYellow;
end;
1:
begin
Font.Color := clRed;
Brush.Color := clLime;
end;
2:
begin
Font.Color := clGreen;
Brush.Color := clFuchsia;
end;
end;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]);
end;
end;
---
Вышеприведенный код устанавливает различный цвет у фона и текста в зависимости от номера строки, но он не работает с выделенными/выбранными строками (кстати, не забудьте установить значение свойства ListBox1.Style равным lbOwnerDrawFixed.)
procedure TListTest.ListBox1DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
HighLight = 'LINE';
var
TempLine, TempText, TempHigh: string;
TempLeft, TempTop, TempStart: Integer;
OldColor: TColor;
begin
with (Control as TListBox).Canvas do
begin
FillRect(Rect);
TempLeft := Rect.Left + 3;
TempTop := Rect.Top + 1;
TempLine := (Control as TListBox).Items[Index];
while TempLine > '' do
begin
TempStart := Pos(HighLight, AnsiUpperCase(TempLine));
if TempStart > 0 then
begin
TempText := Copy(TempLine, 1, TempStart - 1);
TempHigh := Copy(TempLine, TempStart, Length(HighLight));
Delete(TempLine, 1, TempStart + Length(HighLight) - 1);
end
else
begin
TempText := TempLine;
TempHigh := '';
TempLine := '';
end;
if TempText > '' then
begin
TextOut(TempLeft, TempTop, TempText);
Inc(TempLeft, TextWidth(TempText));
end;
if TempHigh > '' then
begin
OldColor := Font.Color;
if odSelected in State then
Font.Color := clYellow
else
Font.Color := clBlue;
TextOut(TempLeft, TempTop, TempHigh);
Inc(TempLeft, TextWidth(TempHigh));
Font.Color := OldColor;
end;
end;
end;
end;
---
Это можно протестировать со следующими тремя строками:
'Строка номер один'
'Вторая строка'
'Это строчка номер три'
Есть несколько вещей, достойных упоминания:
Я использую параметр Control для приведения типов ( Control as TListBox ).Items[ Index ], что убедиться в том, что я использую данные ListBox, такой способ позволяет сделать общим данный обработчик события для нескольких компонентов TListBox, например, если у вас имеется пара ListBox на различных страницах TNoteBook.
OldColor и проверка параметра State позволяет быть уверенным, что выбранная строка содержит видимый цвет шрифта (множество видеодрайверов используют белый текст на синем фоне для выбранной строки).
Также я создаю небольшое свободное пространство вокруг текста - увеличиваю TListBox.ItemHeight и, соответственно, область вывода текста - TempLeft := Rect.Left + 3 и TempTop := Rect.Top + 1.
Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay
|
|
<programming>
|
[Pascal] Кто-нить знает как в List Box сделать разноцветный шрифт? 08.06.05 13:55
Автор: Fighter <Vladimir> Статус: Elderman
|
|
|
|
"Как сделать так, чтобы каждая строка в ListBox имела свой цвет" (заметка) 08.06.05 16:46
Автор: n0xi0uzz <Черкасов Виктор> Статус: Member
|
У меня есть два примера процедур OnDrawItem:
procedure TTest.ListBox1DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TListBox).Canvas do
begin
case Index of
0:
begin
Font.Color := clBlue;
Brush.Color := clYellow;
end;
1:
begin
Font.Color := clRed;
Brush.Color := clLime;
end;
2:
begin
Font.Color := clGreen;
Brush.Color := clFuchsia;
end;
end;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]);
end;
end;
---
Вышеприведенный код устанавливает различный цвет у фона и текста в зависимости от номера строки, но он не работает с выделенными/выбранными строками (кстати, не забудьте установить значение свойства ListBox1.Style равным lbOwnerDrawFixed.)
procedure TListTest.ListBox1DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
HighLight = 'LINE';
var
TempLine, TempText, TempHigh: string;
TempLeft, TempTop, TempStart: Integer;
OldColor: TColor;
begin
with (Control as TListBox).Canvas do
begin
FillRect(Rect);
TempLeft := Rect.Left + 3;
TempTop := Rect.Top + 1;
TempLine := (Control as TListBox).Items[Index];
while TempLine > '' do
begin
TempStart := Pos(HighLight, AnsiUpperCase(TempLine));
if TempStart > 0 then
begin
TempText := Copy(TempLine, 1, TempStart - 1);
TempHigh := Copy(TempLine, TempStart, Length(HighLight));
Delete(TempLine, 1, TempStart + Length(HighLight) - 1);
end
else
begin
TempText := TempLine;
TempHigh := '';
TempLine := '';
end;
if TempText > '' then
begin
TextOut(TempLeft, TempTop, TempText);
Inc(TempLeft, TextWidth(TempText));
end;
if TempHigh > '' then
begin
OldColor := Font.Color;
if odSelected in State then
Font.Color := clYellow
else
Font.Color := clBlue;
TextOut(TempLeft, TempTop, TempHigh);
Inc(TempLeft, TextWidth(TempHigh));
Font.Color := OldColor;
end;
end;
end;
end;
---
Это можно протестировать со следующими тремя строками:
'Строка номер один'
'Вторая строка'
'Это строчка номер три'
Есть несколько вещей, достойных упоминания:
Я использую параметр Control для приведения типов ( Control as TListBox ).Items[ Index ], что убедиться в том, что я использую данные ListBox, такой способ позволяет сделать общим данный обработчик события для нескольких компонентов TListBox, например, если у вас имеется пара ListBox на различных страницах TNoteBook.
OldColor и проверка параметра State позволяет быть уверенным, что выбранная строка содержит видимый цвет шрифта (множество видеодрайверов используют белый текст на синем фоне для выбранной строки).
Также я создаю небольшое свободное пространство вокруг текста - увеличиваю TListBox.ItemHeight и, соответственно, область вывода текста - TempLeft := Rect.Left + 3 и TempTop := Rect.Top + 1.
Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay
|
| |
О, то, что нуно. Спасибо. 09.06.05 10:09
Автор: Fighter <Vladimir> Статус: Elderman
|
|
|
|
|
подробно о проекте
Анализ криптографических сетевых...
