Текущий архив: 2007.06.10;
Скачать: CL | DM;
Вниз
Хинт с не влезающими по ширине итемами листбокса Найти похожие ветки
← →
Подскажите? (2007-05-17 12:40) [0]Добрый день, у меня такой вопрос... Имеется ЛисБокс, как сделать так, чтобы подведя мышку на какой либо итем, и если он не влезает по ширине в сам листбокс, то показывался бы хинт с полной надписью этого итема?
← →
Leonid Troyanovsky © (2007-05-17 12:54) [1]
> Подскажите? (17.05.07 12:40)
var
oldidx: Longint = -1;
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.
← →
fd979 © (2007-05-17 13:05) [2]можно и так:
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint := HintCorrect;
Application.HintPause := 50;
...
end;
procedure Tfrm_glb_unt.HintCorrect(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
var
Index: Integer;
ARect: TRect;
begin
if HintInfo.HintControl is TTextListBox then
begin
with TTextListBox(HintInfo.HintControl) do
begin
Index := ItemAtPos(HintInfo.CursorPos, True);
if Index <> -1 then
if Canvas.TextWidth(Items[Index]) > ClientWidth then
begin
HintInfo.HintStr := Items[Index];
Perform(LB_GETITEMRECT, Index, Longint(@ARect));
HintInfo.CursorRect := ARect;
HintInfo.HintPos := ClientToScreen(ARect.TopLeft);
HintInfo.HintColor := clYellow;
CanShow := True;
end else
CanShow := False;
end;
exit;
end;
end;
← →
Подскажите? (2007-05-17 15:15) [3]Leonid Troyanovsky, fd979
Большое спасибо! :)
Страницы: 1 вся ветка
Текущий архив: 2007.06.10;
Скачать: CL | DM;
Память: 0.47 MB
Время: 0.026 c
