[Prisoner]

Код:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  S: string;
  N: Word;
  WasColor: TColor;
begin
  with Control as TListBox, Canvas do
  begin
    S := Items[Index];
    FillRect(Rect);
    MoveTo(Rect.Left + 2, Rect.Top);
    SetTextAlign(Canvas.Handle, TA_LEFT or TA_UPDATECP);
    WasColor := Font.Color;
    for N := 1 to Length(S) do
    begin
      case UpCase(S[N]) of
        'A', 'E', 'I', 'O', 'U': Font.Color := clRed;
      else
        Font.Color := WasColor;
      end;
      WinProcs.TextOut(Canvas.Handle, 0, 0, @S[N], 1);
    end;
  end;
end;

Код заставляет английские гласные быть красными, если убрать проверку на это правило и поменять логику, то можно некоторые строчки сделать жирными...

[Savant]

Prisoner
спасибо, реализовал
Правда было довольно много мучений, распишу их, чтобы другие не мучались

1. В design-time надо ListBox'y установить опции loOwnerDrawFixed либо loOwnerDrawVariable (кстати, в чем разница?), иначе данная процедура по-видимому игнорируется.
2. Для программирующих не с помощью VCL, а с помощью KOL

Код:

function TForm1.ListBox1DrawItem(Sender: PObj; DC: HDC; const Rect: TRect;
  ItemIdx: Integer; DrawAction: TDrawAction;
  ItemState: TDrawState): Boolean;
var
  S: string;
  Sel: Boolean;
begin
  S:=TKOLListBox(Sender).Items[ItemIdx];
  Sel:=odsSelected in ItemState;
  if Sel then begin
    TKOLListBox(Sender).Canvas.Brush.Color:=clhighLight;
    TKOLListBox(Sender).Font.Color:=clWhite;
  end;
  FillRect(DC, Rect, TKOLListBox(Sender).Canvas.Brush.Handle);
  //TKOLListBox(Sender).Canvas.MoveTo(Rect.Left + 2, Rect.Top);
  Windows.MoveToEx(DC, Rect.Left + 2, Rect.Top, nil);
  SetTextAlign(DC, TA_LEFT or TA_UPDATECP);
  TKOLListBox(Sender).Font.FontStyle:=[fsBold];
  TextOut(DC, 0, 0, PChar(S), Length(S));
  if Sel then begin
    TKOLListBox(Sender).Font.Color:=clWindowText;
    TKOLListBox(Sender).Canvas.Brush.Color:=clWindow;
  end;
end;

Если не заменить закомментированную строку на ту, что идет следом, то все строки будут "рисоваться" в один ряд. По-видимому глюк программистов.

Кстати 2 проблемы еще остались. Надо выделенный элемент писать на синем фоне (ну как обычно). Для этого я ввёл обрабочик

Код:

  if odsSelected in ItemState then ...

Но! Если операцию заливки (FillRect) выполнять до вывода текста (TextOut), то сам текст выводится на белом фоне, а если после - то текст "скрывается" под этим слоем краски.

Пока писал эти строки, допёрло как сделать

в самое начало надо добавить вызов SetBkMode, т.е.

Код:

....
begin
  SetBkMode(DC, TRANSPARENT);
  S:= ....

И последняя проблема:

Код:

....
    TKOLListBox(Sender).Font.Color:=clWindowText;
....

Вот из-за этой строки (она почти в конце) ListBox перерисовывается бесчисленное число раз (я ждал около 30 сек, потом надоело; сама программа не зависает). Если ее (строку) закомментировать, то программа работает нормально. Причем если эту строку поместить в любое другое место процедуры, то результат опять же отрицательный... Ничего не понимаю...
В итоге выяснилось, что это происходит, когда используется больше 1 вызова свойства Font.Color . Причем даже если делать так:

Код:

....
  if Sel then cl:=clWhite else cl:=clWindowText;
  TKOLListBox(Sender).Font.Color:=cl;
....

Вот с этим я никак не могу разобраться...

[Savant]

Как я и думал, проблема будет решена с помощью Winapi (опять глюки у программистов KOL???).
Итоговый код:

Код:

var
  Listbox_Font_Normal, Listbox_Font_Bold: HFONT;
  Fonts_Created: Boolean = false;
 
procedure TForm1.KOLForm1Destroy(Sender: PObj);
begin
.......
  DeleteObject(Listbox_Font_Normal);
  DeleteObject(Listbox_Font_Bold);
end;
 
procedure CreateMyFonts;
begin
  if not Fonts_Created then begin
	Listbox_Font_Normal:=CreateFont(-12,0,0,0,FW_NORMAL,0,0,0,RUSSIAN_CHARSET,
	  OUT_TT_ONLY_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,'Tahoma');
	Listbox_Font_Bold:=CreateFont(-12,0,0,0,FW_BOLD,0,0,0,RUSSIAN_CHARSET,
	  OUT_TT_ONLY_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,'Tahoma');
	Fonts_Created:=True;
  end;
end;
 
function TForm1.ListBox1DrawItem(Sender: PObj; DC: HDC; const Rect: TRect;
  ItemIdx: Integer; DrawAction: TDrawAction;
  ItemState: TDrawState): Boolean;
var
  S: string;
  Sel: Boolean;
  cL: Integer;
  HF: HFONT;
begin
  S:=TKOLListBox(Sender).Items[ItemIdx];
  SetBkMode(DC, TRANSPARENT);
  CreateMyFonts;
  Sel:=odsSelected in ItemState;
  if Sel then begin
	TKOLListBox(Sender).Canvas.Brush.Color:=clhighLight;
	cl:=clWhite;
  end else
	cl:=clWindowText;
  SetTextColor(DC, cl);
  FillRect(DC, Rect, TKOLListBox(Sender).Canvas.Brush.Handle);
  //TKOLListBox(Sender).Canvas.MoveTo(Rect.Left + 2, Rect.Top);
  Windows.MoveToEx(DC, Rect.Left + 2, Rect.Top, nil);
  SetTextAlign(DC, TA_LEFT or TA_UPDATECP);
  // --- TODO: if условие then
  if Sel then
	HF:=Listbox_Font_Bold
  // --- TODO: else
  else
	HF:=Listbox_Font_Normal;
  // --- TODO: end
  SelectObject(DC, HF);
  TextOut(DC, 0, 0, PChar(S), Length(S));
  if Sel then begin
	TKOLListBox(Sender).Canvas.Brush.Color:=clWindow;
  end;
  Result:=False;
end;

p.s.: данный код меняет жирность у всех строк, удовлетворяющих условию, условие надо вставлять вместо "TODO" как показано

Аналогичный код на VCL выглядит так:

Код:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  S: string;
begin
  with Control as TListBox, Canvas do
  begin
	S := Items[Index];
	FillRect(Rect);
	MoveTo(Rect.Left + 2, Rect.Top);
	SetTextAlign(Canvas.Handle, TA_LEFT or TA_UPDATECP);
	// TODO: if условие then
	if true then
	  Font.Style := [fsBold];
	WinProcs.TextOut(Canvas.Handle, 0, 0, PChar(S), Length(S));
	Font.Style := [];
  end;
end;