Форум: "Основная";
Текущий архив: 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.069 c