Хинты

← →
Rytek (2005-08-21 06:38) [0]

Здравствуйте! Вопрос звучит просто: из-за чего этот код на хинты не действует для 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-21 11:29) [1]

> 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.

← →
Rytek (2005-08-22 03:23) [2]

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

← →
Leonid Troyanovsky © (2005-08-22 08:59) [3]

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

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

--
Regards, LVT.

← →
Rytek (2005-08-22 12:46) [4]

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

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

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

--
Regards, LVT.

Хинты Найти похожие ветки