Текущий архив: 2004.04.11;
Скачать: CL | DM;

Вниз

Смешно, но не могу наладить показ итемов ListBox a в его хинте   Найти похожие ветки 

← →
Aleksandr ©   (2004-03-22 13:14) [0]

Делаю так:


procedure TLBForm.lbFindMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
 P : TPoint;
 F : TFindItem;
begin
 P.X:=X;
 P.Y:=Y;
 lbFind.Hint:="";
 if lbFind.ItemAtPos(P,true)>-1 then begin
   F:=TFindItem(lbFind.Items.Objects[lbFind.ItemAtPos(P,true)]);
   if Assigned(F) AND (F.Subject<>"") then begin
     lbFind.Hint:=F.Subject;
     Application.ShowHint:=true
   end  
 end
end;


Если тыркнешь мышкой на другой итем в Листбоксе, то хинт показывается. А если просто мышью на другой наведешь, то ничего не происходит... Как это наладить?

---

← →
Infom   (2004-03-22 13:19) [1]

может надо не
> Application.ShowHint:=true

a
lbFind.ShowHint:=true

---

← →
Aleksandr ©   (2004-03-22 13:26) [2]

Не... то же самое.

---

← →
Infom   (2004-03-22 13:28) [3]

А условие
if Assigned(F) AND (F.Subject<>"") then
точно проходит

---

← →
pasha_golub ©   (2004-03-22 13:30) [4]

Есть два варианта. Станадратные хинты от Делфи и показ tooltips самой Windows.

1) Делфи

type
 TForm1 = class(TForm)
   SG: TStringGrid;
   HintTimer: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure SGMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure SGExit(Sender: TObject);
   procedure HintTimerTimer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;                      f:TControl;
 GCoord: TGridCoord;
 CX,CY:integer;
implementation

{$R *.dfm}
{$D+}
{$L+}

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.ShowHint := True;
with SG do
  begin
   Cells[0,0] := "Код";
   Cells[1,0] := "Описание";

   Cells[0,1] := "72972";
   Cells[1,1] := "Barebone FIC MB02-series 14" 1024x768, Intel® 855GM For Centrino®,MgAl-Alloy slim, Combo (DVD/CD-RW) module, english keyboard";
   Cells[0,2] := "73151";
   Cells[1,2] := "Barebone FIC MB05W 15" 1024x768, Intel® 855GM For Centrino®,Plastic, Combo (DVD/CD-RW) module, english keyboard";
  end;
end;

procedure TForm1.SGMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 HintTimer.Enabled := False;
 GCoord := SG.MouseCoord(X,Y);
 if (CX <> X) or (CY <> Y) then
  begin
    CX := X;
    CY := Y;
    HintTimer.Enabled := true;
  end;
end;

procedure TForm1.SGExit(Sender: TObject);
begin
SG.Hint := "";
end;

procedure TForm1.HintTimerTimer(Sender: TObject);
var
   Mes: TMessage;
begin
HintTimer.Enabled := False;
{$B-}
if (GCoord.X > -1) and (GCoord.Y > -1)
    and (SG.Hint <> SG.Cells[GCoord.X,GCoord.Y])
    and (SG.Canvas.TextWidth(SG.Cells[GCoord.X,GCoord.Y]) > SG.ColWidths[GCoord.X])
 then
   begin
       Application.CancelHint;
       SG.Hint := WrapText(SG.Cells[GCoord.X,GCoord.Y],#13#10,[ #0..#255]-["A".."Z","a".."z","0".."9"],20);
       TWMMouse(Mes).XPos := CX;
       TWMMouse(Mes).YPos := CY;
       Application.HintMouseMessage(SG,Mes);
   end
 else
   SG.Hint := "";

end;

end.


Пример для грида, но я думаю понятно будет. Есть еще на Королевстве пример от Игоря Шевченко.

2) Пример с tooltips

type
 TForm1 = class(TForm)
   SG: TStringGrid;
   Button1: TButton;
   Button2: TButton;
   procedure FormCreate(Sender: TObject);
   procedure SGMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure SGMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   ToolTipHandle: THandle;
   TipVisible: Boolean;
   OldCol,OldRow: Integer;
   ToolInfo: TToolInfo;
   procedure CreateTipsWindow;
 end;

var
 Form1: TForm1;

const
 TTM_SETTITLE = WM_USER+32;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  with SG do
  begin
   Cells[0,0] := "Код";
   Cells[1,0] := "Описание";
   Cells[0,1] := "72972";
   Cells[1,1] := "Barebone FIC MB02-series 14" 1024x768, Intel® 855GM For Centrino®,MgAl-Alloy slim, Combo (DVD/CD-RW) module, english keyboard";
   Cells[0,2] := "73151";
   Cells[1,2] := "Barebone FIC MB05W 15" 1024x768, Intel® 855GM For Centrino®,Plastic, Combo (DVD/CD-RW) module, english keyboard";
  end;
 CreateTipsWindow;
 OldCol := -1;
 OldRow := -1;
end;

procedure TForm1.CreateTipsWindow;
var
 InitCommCtrlEx: TInitCommonControlsEx;
begin
 // Загрузить класс ToolTip из DLL
 InitCommCtrlEx.dwSize := SizeOf(TInitCommonControlsEx);
 InitCommCtrlEx.dwICC := ICC_TAB_CLASSES;
 InitCommonControlsEx(InitCommCtrlEx);

 // Создаем окно ToolTip
 ToolTipHandle := CreateWindow(TOOLTIPS_CLASS, "", WS_POPUP,
                       Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                       Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                       0, 0, hInstance, nil);
 
 // Приготовим запись TOOLINFO
 with ToolInfo do
   begin
     cbSize := SizeOf(ToolInfo);
     uFlags := TTF_IDISHWND or TTF_TRACK or TTF_ABSOLUTE or TTF_TRANSPARENT;
     hwnd := THandle(-1);//SG.Handle;
     uId := ToolTipHandle;//SG.Handle;
     lpszText := nil;
   end;
 SendMessage(ToolTipHandle, WM_SETFONT, SG.Font.Handle, Integer(False));
 SendMessage(ToolTipHandle, TTM_ADDTOOL,0,Integer(@ToolInfo));
 SendMessage(ToolTipHandle,TTM_SETTIPBKCOLOR,clBlack,0);
 SendMessage(ToolTipHandle,TTM_SETTIPTEXTCOLOR,clLime,0);

end;

procedure TForm1.SGMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
 ACol,ARow: Integer;
 APoint: TPoint;
 ARect: TRect;
 ATextWidth: Integer;
begin
 SG.MouseToCell(X, Y, ACol, ARow);
 if (ACol = OldCol) and (ARow = OldRow) then Exit;

 OldCol := ACol;
 OldRow := ARow;

 if TipVisible then
   begin
     SendMessage(ToolTipHandle, TTM_TRACKACTIVATE, Integer(False), 0);
     TipVisible := False;
   end;

 if (ACol > -1) and (ARow > -1) then
   begin
     ARect := SG.CellRect(ACol,ARow);
     ATextWidth := SG.Canvas.TextWidth(SG.Cells[ACol,ARow]);
     if ARect.Right - ARect.Left < ATextWidth then
       begin
         APoint := SG.ClientToScreen(ARect.TopLeft);
         {if ATextWidth + APoint.X > Screen.Width then
           APoint.X := Screen.Width - ATextWidth - 5;}
       //  SendMessage(ToolTipHandle,TTM_SETTITLE,1,integer(PChar(SG.Cells[Acol,0])));
         SendMessage(ToolTipHandle, TTM_TRACKPOSITION, 0, MakeLParam(APoint.X, APoint.Y));
         SendMessage(ToolTipHandle, TTM_SETMAXTIPWIDTH, 0, SG.ColWidths[ACol]);
         ToolInfo.lpszText := PChar(SG.Cells[ACol,ARow]);
         SendMessage(ToolTipHandle, TTM_UPDATETIPTEXT, 0, Integer(@ToolInfo));
         SendMessage(ToolTipHandle, TTM_TRACKACTIVATE, Integer(True), Integer(@ToolInfo));
         TipVisible := True;
       end;
   end;
end;

procedure TForm1.SGMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if TipVisible then     //when mouse down, hide Tooltip Window
   begin
     SendMessage(ToolTipHandle, TTM_TRACKACTIVATE, Integer(False), 0);
     TipVisible := False;
   end;
end;

end.


Иоже для грида, но я думаю понятно. Именно дял листбокса можно взглянуть здесь: http://www.delphiworld.narod.ru/base/in_place_hint.html

---

← →
pasha_golub ©   (2004-03-22 13:34) [5]

Прошу прощения, код не отполирован, я как раз над ним провожу эксперименты. Вопросы можно по мылу.

---

← →
Вованчик ©   (2004-03-22 13:41) [6]

Попробуй так:
var
 Form1: TForm1;
 Item: Integer;

implementation

{$R *.dfm}

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var P: TPoint;
begin
 P.X:=X;
 P.Y:=Y;
 if ListBox1.ItemAtPos(P,true) <> Item then
   Application.CancelHint;

 if ListBox1.ItemAtPos(P,true)>-1 then begin
   ListBox1.Hint:=ListBox1.Items.Strings[ListBox1.ItemAtPos(P,true)];
   Item := ListBox1.ItemAtPos(P,true);
 end
end;

---

← →
Aleksandr ©   (2004-03-22 13:50) [7]

Всем спасибо.

2 Вованчик:
Ваш вариант самый простой, но сработал безотказно.

---

← →
pasha_golub ©   (2004-03-22 14:02) [8]

Вованчик ©   (22.03.04 13:41) [6]
Мдя, действительно. Но я так понял нужно показывать подсказку, если текст не умещается в листбоксе. В таком случае советую добавить:

if (ListBox1.ItemAtPos(P,true)>-1) and (ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[ListBox1.ItemAtPos(P,true)])>ListBox1.Width) then begin

---

← →
Doctor Deejay ©   (2004-03-22 14:31) [9]

А как сделать так, чтобы подсказка появлялась сразу? И еще - как сделать, чтобы она "ездила за курсором как на этом сайте в верхнем меню?

---

← →
pasha_golub ©   (2004-03-22 14:36) [10]

Doctor Deejay ©   (22.03.04 14:31) [9]

TApplication.HintPause по первому вопросу.

Чтобы ездила за курсором, использовать tooltips +  SendMessage + TTM_TRACKPOSITION

---

Страницы: 1 вся ветка

Текущий архив: 2004.04.11;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.034 c