Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Аватара для Savant

Старожил


Сообщения: 300
Благодарности: 6

Профиль | Сайт | Отправить PM | Цитировать


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

Последний раз редактировалось Savant, 24-02-2005 в 10:45. Причина: серьёзные редактирования кода


Отправлено: 09:51, 24-02-2005 | #4