Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Как перерисовать ListBox, при горизонтальном

Автор: ДЫМ 21.12.2004, 02:49

Как перерисовать ListBox, при горизонтальном скроллинге?

На форме есть ListBox со свойством Style=lbOwnerDrawFixed

вот прорисовка элементов

Код


procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
 // определяем максимальную ширину списка
 function fcMaxWidth:Integer;
 var i:Integer;
  begin
  Result := 0;
  for i := 0 to ListBox1.Items.Count - 1 do
  if Result < ListBox1.Canvas.TextWidth(ListBox1.Items[i])+2 then
    Result := ListBox1.Canvas.TextWidth(ListBox1.Items[i])+2;
   end;

begin
 With ListBox1.Canvas do
  begin
   SendMessage((Control as TListBox).Handle, LB_SETHORIZONTALEXTENT, fcMaxWidth, 0);
   
   FillRect(Rect);

   // здесь выводим текст с обрезанием по правому краю (три точки в
   // конце, если текст не помещается) 

   DrawTextEx(Handle, PChar((Control as TListBox).Items[Index]),
   Length(ListBox1.Items[Index]), Rect, DT_WORD_ELLIPSIS, nil);

  end;
end;

И все вроде нормально, но стоит прокрутить горизонтальный ScrollBar (вертикальный работает как надо) вправо ,то список не обновляется, вместо текста появляются какие-то куски.

Как бы отловить событие, возникающее при горизонтальной прокрутке, тогда туда можно запихнуть метод Refresh.

Автор: dm9 21.12.2004, 22:54

WM_HSCROLL ???

Автор: ДЫМ 22.12.2004, 02:16

Цитата

WM_HSCROLL ???

А поподробнее можно?

Автор: dm9 22.12.2004, 03:29

Вот тебе набросок компонентика. Сейчас более продвинуто делать времени нет, но если не разберёшься сам - помогу.

Код


unit MyListBox;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Dialogs, Messages, Windows, Graphics;

type
  TMyListBox = class(TListBox)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure HScroll (var Msg : TMessage); message WM_HSCROLL;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
  public
    { Public declarations }
    constructor Create (AOwner : TComponent); override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

constructor TMyListBox.Create;
begin
   inherited Create (AOwner);
   Self.Parent := TWinControl(AOwner);
   Self.Items.Add ('First');
   Self.Items.Add ('Second');
   Self.Items.Add ('Third');
   Self.Style := lbOwnerDrawFixed;
   Self.Perform (LB_SETHORIZONTALEXTENT, 150, 0);
end;

//Эта процедура сейчас подчистую скатана из класса-родителя TCustomListBox. Измени её под свои нужды.
procedure TMyListBox.DrawItem;
begin
   TControlCanvas(Self.Canvas).UpdateTextFlags;
   if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State)
   else
   begin
      Canvas.FillRect(Rect);
      if Index >= 0
      then Canvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
   end;
end;

procedure TMyListBox.HScroll;
var
   SBHWND : HWND;
begin
   SBHWND := Msg.LParam; //handle скроллбара
   //Делаешь с этим скроллбаром что хочешь
   //На сколько сдвинули скроллбар - см. справку по WM_HSCROLL (Help -> Windows SDK)
   Msg.Result := 0; //Мы сами обрабатываем сообщение - должны вернуть ноль
end;

procedure Register;
begin
  RegisterComponents('MyGroup', [TMyListBox]);
end;

end.

Добавлено @ 03:30
Тестировать так можно, например:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
   g : TMyListBox;
begin
   g := TMyListBox.Create (Self);
   g.Left := 10;
   g.Top := 200;
   g.Width := 100;
   g.Height := 100;
end;