Как я и думал, проблема будет решена с помощью 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;