| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Хинты [D6, WinXP]

Rytek ©   (2005-08-21 06:38:00) 

Здравствуйте! Вопрос звучит просто: из-за чего этот код на хинты не действует для TglListBox (TCustomListBox), но для TListBox (TCustomListBox) он работает? Необходимые строки я заменял. Спасибо.

type
 TForm1 = class(TForm)
   ListBox1: TListBox;
   procedure FormCreate(Sender: TObject);
   procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
   FHintRow : Integer;
 public
   { Public declarations }

   procedure OnShowHint(var HintStr: string;
                        var CanShow: Boolean;
                        var HintInfo: THintInfo);
 end;

var
 Form1: TForm1;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
 FHintRow := -1;
 Application.OnShowHint := OnShowHint;
end;

procedure TForm1.OnShowHint(var HintStr: string; var CanShow: Boolean;
 var HintInfo: THintInfo);
Var Pos : TPoint;
begin
 with HintInfo do
     if HintControl is TListBox then    
        with HintControl as TListBox do
          begin
            Pos.X := 0;
            Pos.Y := ListBox1.Tag;
            HintPos := ListBox1.ClientToScreen(Pos);
            HintStr := ListBox1.Hint;
          end;
end;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var MousePos : TPoint;
   ItemPos  : TRect;
   RowWidth,
   ItemNum  : Integer;
   FHint    : String;
begin
 MousePos.X := X;
 MousePos.Y := Y;
 ItemNum := ListBox1.ItemAtPos(MousePos, True);

 if (ItemNum <> FHintRow) then  
    begin
      FHintRow := ItemNum;
      if ItemNum <> -1 then
         begin
           ItemPos := ListBox1.ItemRect(ItemNum);

           Application.CancelHint;
           ListBox1.Tag := ItemPos.Top;  

           FHint := ListBox1.Items[ItemNum];

           RowWidth := ListBox1.Canvas.TextWidth( FHint );
           if (RowWidth > ListBox1.ClientWidth)
              then FHint := FHint + '|'
              else FHint := '';

           ListBox1.Hint := FHint;
         end
      else begin ListBox1.Hint := '';
                 Application.CancelHint;
                 ListBox1.Tag := -1; end;
    end;

end;

---

Leonid Troyanovsky   (2005-08-22 13:12:00) [1]

> Rytek   (22.08.05 12:46) [4]
> Относительно хинта для каждого элемента - нет, но в целом
> для компонента - да.



Дык, чего этот контрол композитный?
Тогда, надо найти сам листбокс и заменить ему WindowProc,
на свою, которая будет обрабатывать WM_MOUSEMOVE.
См. VCL Reference WndProc, WindowProc example

--
Regards, LVT.

---

Rytek   (2005-08-22 12:46:00) [2]

Относительно хинта для каждого элемента - нет, но в целом для компонента - да.
Исходники есть, но слишком громоздкие - 30 kb.

---

Leonid Troyanovsky   (2005-08-22 08:59:00) [3]

> Rytek   (22.08.05 03:23) [2]
> Всё равно не работает. Не могу никак понять, в чём дело.
> А TglListBox - это один из компонентов библиотеки Globus
> VCL. pas-файл glLBox.


Если нет исходников оного компонента, то разобраться
будет весьма сложно.
А OnMouseMove срабатывает?

--
Regards, LVT.

---

Rytek   (2005-08-22 03:23:00) [4]

Всё равно не работает. Не могу никак понять, в чём дело. А TglListBox - это один из компонентов библиотеки Globus VCL. pas-файл glLBox.

---

Leonid Troyanovsky   (2005-08-21 11:29:00) [5]

> Rytek   (21.08.05 06:38)


Не знаю кто такой TdlgListBox, но попробуй так


type
 TForm1 = class(TForm)
   ListBox1: TListBox;
   procedure FormCreate(Sender: TObject);
   procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
   { Private declarations }
  oldidx : Integer;
public
  { Public declarations }

end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
oldidx := -1;
ListBox1.ShowHint := True;
end;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var
 idx : Longint;
begin
 with Sender as TListBox do
   begin
     idx := ItemAtPos(Point(x,y),True);
     if (idx < 0) or (idx = oldidx) then
       Exit;
     Application.ProcessMessages;
     Application.CancelHint;
     oldidx := idx;
     Hint := '';
     if Canvas.TextWidth(Items[idx]) > Width - 4 then
       Hint:=Items[idx];
   end;
end;


--
Regards, LVT.

---

Наверх