[Amgsys HQ]

Доброго времени суток!

Как видно по заголовку, на форме присутствует ListBox. Задача такая:
отрисовать самому пункты списка, но сделать так, чтобы выбранный
пункт списка был отличного размера от невыделенных (больше) +
добавить на него несколько кнопок. Можно ли такое реализовать?

Использую следующий код, но он не работает:

Код:

procedure MyListBoxMeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  if Index = TListBox(Control).ItemIndex then
    Height := 50
  else Height := 20;
end;

Заранее спасибо!

[angvelem]

А MyListBoxDrawItem при этом используется?

[Amgsys HQ]

Сообщение от angvelem

А MyListBoxDrawItem при этом используется?

Да, конечно, используется. Там есть параметр (State: TOwnerDrawState),
который используется для определения выделен элемент или нет, и, в
зависимости от этого, отрисовывается требуемое содержимое.

[angvelem]

Ну так и выкладывай весь код ответственный за отрисовку.

[Amgsys HQ]

Информационная структура элемента, откуда берется информация при
отрисовке элемента.

Код:

TEventsListItem = packed record
  ItemID: Integer;
  Title, Text: String;
  EventsTime: Double;
  ImageIndex: Integer;
  BrushColor: Integer;
  PenColor: Integer;
  procedure Assign(ASource: TEventsListItem);
end;

Код отрисовки (EventsList - мой класс, является хранилищем record'ов).
В списке EventsListBox содержатся значения TEventsListItem.ItemID

Код:

procedure TEventsListFrame.EventsListBoxDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  IMAGE_TOP_MARGIN = 2;
  IMAGE_LEFT_MARGIN = 3;
  TITLE_LEFT_MARGIN = 4;
  TITLE_TOP_MARGIN = IMAGE_TOP_MARGIN + 1;
  DTIME_RIGHT_MARGIN = 4;
  DTIME_TOP_MARGIN = TITLE_TOP_MARGIN;
  TEXT_LEFT_MARGIN = IMAGE_LEFT_MARGIN;
  TEXT_RIGHT_MARGIN = DTIME_RIGHT_MARGIN;
  TEXT_TOP_MARGIN = 4;
  TEXT_BOTTOM_MARGIN = 2;
var
  FCanvas: TCanvas;
  FList: TStrings;
  S: String;
  TempColor: Integer;
  TempStyle: TFontStyles;
  TitleHeight: Integer;
  TextRect: TRect;
  EventData: TEventsListItem;
begin
  FCanvas := TListBox(Control).Canvas;
  FList := TListBox(Control).Items;
  FCanvas.FillRect(Rect);
  if Index < TListBox(Control).Items.Count then
  begin
    if not EventsList.SearchFor(StrToIntDef(FList[Index], 0), EventData) then Exit; // Поиск инфо-структуры по ItemID
    { Отрисовка изображения }
    FCanvas.Draw(Rect.Left + IMAGE_LEFT_MARGIN, Rect.Top + IMAGE_TOP_MARGIN,
      EventsListImages.PngImages[EventData.ImageIndex].PngImage);
    { Отрисовка заголовка события }
    TempColor := FCanvas.Font.Color;
    TempStyle := FCanvas.Font.Style;
    try
      if odSelected in State then
      begin
        FCanvas.Font.Color := clYellow;
        FCanvas.Font.Style := [fsBold];
      end;
      TitleHeight := FCanvas.TextHeight(EventData.Title);
      FCanvas.TextOut(Rect.Left + IMAGE_LEFT_MARGIN + 16 + TITLE_LEFT_MARGIN,
        Rect.Top + TITLE_TOP_MARGIN, EventData.Title);
    finally
      FCanvas.Font.Color := TempColor;
      FCanvas.Font.Style := TempStyle;
    end;
    { Отрисовка времени события }
    TempColor := FCanvas.Font.Color;
    try
      FCanvas.Font.Color := clSilver;
      S := TimeToStr(EventData.EventsTime);
      FCanvas.TextOut(Rect.Right - DTIME_RIGHT_MARGIN -
        FCanvas.TextWidth(S), Rect.Top + DTIME_TOP_MARGIN, S);
    finally
      FCanvas.Font.Color := TempColor;
    end;
    if odSelected in State then
    begin
      { Отрисовка текста события }
      TempColor := FCanvas.Font.Color;
      try
        FCanvas.Font.Color := clWhite;
        S := EventData.Text;
        TextRect.Left := Rect.Left + TEXT_LEFT_MARGIN;
        TextRect.Top := Rect.Top + TITLE_TOP_MARGIN + TitleHeight + TEXT_TOP_MARGIN;
        TextRect.Right := Rect.Right - TEXT_RIGHT_MARGIN;
        TextRect.Bottom := Rect.Bottom - TEXT_BOTTOM_MARGIN;
        DrawText(FCanvas.Handle, PChar(S), Length(S), TextRect, DT_WORDBREAK);
      finally
        FCanvas.Font.Color := TempColor;
      end;
    end;
  end;
end;

Размеры элемента списка.

Код:

procedure TEventsListFrame.EventsListBoxMeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  if Index = TListBox(Control).ItemIndex then
    Height := 48
  else Height := TListBox(COntrol).ItemHeight;
end;

[angvelem]

............

[Amgsys HQ]

Сообщение от angvelem

............

А можно теперь это расшифровать?

P.S. Знает ли кто-нибудь, как изменить высоту выделенной строки? Бог с этими кнопками...

[angvelem]

Я по ошибке не там начал отвечать.

[angvelem]

Для изменения высоты выделенного Item-а, этого достаточно:

Код:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Selected : Boolean;
begin
  Selected := (State = [odSelected, odFocused]) or (State = [odSelected]);
  if Selected then
    SendMessage(ListBox1.Handle, LB_SETITEMHEIGHT, Index, 45)
  else
    SendMessage(ListBox1.Handle, LB_SETITEMHEIGHT, Index, 16);

  with ListBox1.Canvas do
  begin
    FillRect(Rect);
    if Selected then
    begin
      Font.Style := [fsBold];
      Font.Size := 24;
    end
    else
    begin
      Font.Style := [];
      Font.Size := 8;
    end;
    TextOut(Rect.Left + 1, Rect.Top + 1, ListBox1.Items[Index]);
  end;
end;

[Amgsys HQ]

angvelem, данный код работает, но выбранный элемент перекрывает элемент стоящий после него.

[Pyro]

http://delphi.cjcsoft.net/viewthread.php?tid=47017

PHP код:

procedure Listbox_CalcLineHeights(AListbox:TListbox);
var
   i, h : integer;
   MeasureItemEvent : TMeasureItemEvent;
begin
   if Assigned(AListbox) and AListbox.HandleAllocated then begin
     with AListbox do begin
       MeasureItemEvent := OnMeasureItem;
       if Assigned(MeasureItemEvent) then begin
         for i:=0 to Items.Count-1 do begin
           MeasureItemEvent(AListbox, i, h);
           SendMessage(Handle, LB_SETITEMHEIGHT, i, h);
         end;
       end;
     end;
   end;
end; 


должно пересчитать высоты элементов

[Amgsys HQ]

Pyro, спасибо за код, он подходит. Но если в списке очень много элементов (например, более 1000), то перебирать все в подряд - это круто.

[angvelem]

Дополнительно можно проверять на видимость iterm-а - обновлять только видимые.