2011. március 6., vasárnap

How to show a hint window programmatically


Problem/Question/Abstract:

Is there any API call, Delphi function or trick to show a hint window manually?

Answer:

This should get you started:

unit HintSelfNoTimer;

interface

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

const
  UM_EXITPROC = WM_USER + 42;

type
  TFrmHintSelfNoTimer = class(TForm)
    ComboBox1: TComboBox;
    Edit1: TEdit;
    procedure Edit1Exit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    FActive: boolean;
    FHint: THintWindow;
    procedure AppMessage(var AMessage: TMsg; var Handled: Boolean);
    procedure UMExitProc(var TheMsg: TMessage); message UM_EXITPROC;
    procedure KillHint;
  public
  end;

var
  FrmHintSelfNoTimer: TFrmHintSelfNoTimer;

implementation

{$R *.DFM}

procedure TFrmHintSelfNoTimer.AppMessage(var AMessage: TMsg; var Handled: Boolean);
begin
  if (AMessage.Message = WM_LBUTTONDOWN) or
    (AMessage.Message = WM_RBUTTONDOWN) then
    if Assigned(FHint) and FHint.Visible then
      KillHint;
end;

procedure TFrmHintSelfNoTimer.UMExitProc(var TheMsg: TMessage);
begin
  Edit1.SetFocus;
end;

procedure TFrmHintSelfNoTimer.KillHint;
begin
  FActive := false;
  if Assigned(FHint) then
  begin
    FHint.ReleaseHandle;
    FHint.Free;
    FHint := nil;
  end;
end;

procedure TFrmHintSelfNoTimer.Edit1Exit(Sender: TObject);
var
  thePoint: TPoint;
  theRect: TRect;
  theString: string;
begin
  if Edit1.Text <> '42' then
  begin
    thePoint.X := Edit1.Left;
    thePoint.Y := Edit1.Top - 24;
    with theRect do
    begin
      topLeft := ClientToScreen(thePoint);
      Right := Left + 150;
      Bottom := Top + 18;
    end;
    theString := 'The answer is 42 y''know!';
    FHint := THintWindow.Create(self);
    FHint.ActivateHint(theRect, theString);
    FActive := true;
    PostMessage(Handle, UM_EXITPROC, 0, 0);
  end;
end;

procedure TFrmHintSelfNoTimer.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

procedure TFrmHintSelfNoTimer.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Assigned(FHint) and FHint.Visible then
    KillHint;
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése