Скачать: 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 вся ветка

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.018 c