Форум: "Основная";
Текущий архив: 2004.04.25;
Скачать: [xml.tar.bz2];

Вниз

Мастера! Можно ли стандартные хинты сделать вечными?   Найти похожие ветки 

← →
Layner ©   (2004-04-05 14:49) [0]

Т.е. пока мышь не убрал с объекта?

---

← →
Романов Р.В. ©   (2004-04-05 14:56) [1]

F1 - TApplication.HintHidePause

---

← →
Layner ©   (2004-04-05 15:10) [2]

Пишу в DPR,

begin
 Application.Initialize;
 Application.CreateForm(Tmf, mf);
 Application.Run;
 Application.HintHidePause:=15000; //или так Application.HintPause:=15000;
end.

И без изменений...

---

← →
Locker   (2004-04-05 15:16) [3]

Application.HintHidePause:=15000;
Application.Run;

---

← →
pasha_golub ©   (2004-04-05 15:19) [4]

THintInfo.ReshowTimeout

Правда прийдется ловить CM_HINTSHOW в компоненте

---

← →
Layner ©   (2004-04-05 15:45) [5]

Спасибо за советы, нашел код, так получилось:


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
   ListBox1: TListBox;
   ListBox2: TListBox;
   Button1: TButton;
   procedure FormShow(Sender: TObject);
   procedure FormHide(Sender: TObject);
 private
   { Private declarations }
 public
procedure ShowHint (var HintStr: string;
    var CanShow: Boolean; var HintInfo: THintInfo);

   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ShowHint (var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo);
var
ListRect,a: TRect;
begin
with HintInfo do
begin
  if (HintControl = ListBox1)or(HintControl = ListBox2) then
  with HintControl as TListBox do
  begin
    if (ItemAtPos(CursorPos,true)<>-1)and
 (Canvas.TextWidth(items.Strings[ItemAtPos(CursorPos,true)]) >
 ItemRect(ItemAtPos(CursorPos,true)).Right-2)then
    begin
      HintStr := items.Strings[ItemAtPos(CursorPos,true)];
      ListRect := ClientRect;
      ListRect.Top := ListRect.Top + (ItemAtPos(CursorPos,true)-TopIndex)*ItemHeight;
      ListRect.Bottom := ListRect.Top + ItemHeight;
      CursorRect := ListRect;
      GetWindowRect(Handle,a);
      HintInfo.HintPos:=Point(ListRect.Left+a.Left+1,ListRect.Top+a.Top-1);
    end;
  end;
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Application.OnShowHint := ShowHint;
Application.HintHidePause:=5000;  
Application.HintPause:=300;       end;

procedure TForm1.FormHide(Sender: TObject);
begin
Application.HintHidePause:=2500;
Application.HintPause:=500;
end;

end.


---

← →
pasha_golub ©   (2004-04-05 16:40) [6]


procedure TForm1.ShowHint (var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo);
var
ListRect,a: TRect;
begin
with HintInfo do
begin
 if (HintControl = ListBox1)or(HintControl = ListBox2) then
 with HintControl as TListBox do
 begin
   if (ItemAtPos(CursorPos,true)<>-1)and
(Canvas.TextWidth(items.Strings[ItemAtPos(CursorPos,true)]) >
ItemRect(ItemAtPos(CursorPos,true)).Right-2)then
   begin
     HintStr := items.Strings[ItemAtPos(CursorPos,true)];
     ReshowTimeout := MaxInt;//и можно забыть про всякие беды, и не нужно никаких других выкрутасов
     ListRect := ClientRect;
     ListRect.Top := ListRect.Top + (ItemAtPos(CursorPos,true)-TopIndex)*ItemHeight;
     ListRect.Bottom := ListRect.Top + ItemHeight;
     CursorRect := ListRect;
     GetWindowRect(Handle,a);
     HintInfo.HintPos:=Point(ListRect.Left+a.Left+1,ListRect.Top+a.Top-1);
   end;
 end;
end;
end;


---

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

Форум: "Основная";
Текущий архив: 2004.04.25;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.04 c