попробуй это:
| Код |
unit FHintWin;
{ -----------------------------------------------------------
TFocusHintWindow --
Вот пример того, как можно использовать TFocusHintWindow.
Данный пример выводит всплывающую подсказку ниже любого
TEdit, имеющего фокус. В противном случае выводится
стандартная подсказка Windows.
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, FHintWin;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FocusHintWindow: TFocusHintWindow;
procedure AppIdle( Sender: TObject; var Done: Boolean );
procedure AppShowHint( var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo );
end;
implementation
procedure TForm1.FormCreate( Sender: TObject );
begin
Application.OnIdle := AppIdle;
Application.OnShowHint := AppShowHint;
FocusHintWindow := TFocusHintWindow.Create( Self );
end;
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
FocusHintWindow.Showing := Screen.ActiveControl is TEdit;
end;
procedure TForm1.AppShowHint( var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo );
begin
CanShow := not FocusHintWindow.Showing;
end;
end.
----------------------------------------------------------- }
interface
uses SysUtils, WinTypes, WinProcs, Classes, Controls, Forms;
type
TFocusHintWindow = class( THintWindow )
private
FShowing: Boolean;
HintControl: TControl;
protected
procedure SetShowing( Value: Boolean );
function CalcHintRect( Hint: string ): TRect;
procedure Appear;
procedure Disappear;
public
property Showing: Boolean read FShowing write SetShowing;
end;
implementation
function TFocusHintWindow.CalcHintRect( Hint: string ): TRect;
var
Buffer: array[ Byte ] of Char;
begin
Result := Bounds( 0, 0, Screen.Width, 0 );
DrawText( Canvas.Handle, StrPCopy( Buffer, Hint ), -1, Result,
DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX );
with HintControl, ClientOrigin do
OffsetRect( Result, X, Y + Height + 6 );
Inc( Result.Right, 6 );
Inc( Result.Bottom, 2 );
end;
procedure TFocusHintWindow.Appear;
var
Hint: string;
HintRect: TRect;
begin
if ( Screen.ActiveControl = HintControl ) then Exit;
HintControl := Screen.ActiveControl;
Hint := GetShortHint( HintControl.Hint );
HintRect := CalcHintRect( Hint );
ActivateHint( HintRect, Hint );
FShowing := True;
end;
procedure TFocusHintWindow.Disappear;
begin
HintControl := nil;
ShowWindow( Handle, SW_HIDE );
FShowing := False;
end;
procedure TFocusHintWindow.SetShowing( Value: Boolean );
begin
if Value then Appear else Disappear;
end;
end.
|
Добавлено @ 02:22
или вот это:
| Код |
{Появление}
IF h<>nil H.ReleaseHandle; {если чей-то хинт yже был, то его погасить}
H:=THintWindow.Create(Окно-владелец хинта);
H.ActivateHint(H.CalcHintRect(...),'hint hint nint');
....
{UnПоявление :) - это возможно пpидется повесить на таймеp, котоpый бyдет
обнyляться пpи каждом новом появлении хинта}
IF h<>nil H.ReleaseHandle;
|
|
