Hint - criando em runtime como janelas

Top  Previous  Next

var

  H: THintWindow;

 

procedure FormCreate;

begin

  H := THintWindow.Create(Self);

end;

 

procedure MostraHintButtonClick

const

  Texto = 'Eu sou um hint perdido!';

var

  R: TRect;

begin

  R.Left   := Form1.Left + 100;

  R.Right  := R.Left + Canvas.TextWidth(Texto) + 10;

  R.Top    := Form1.Top + 100;

  R.Bottom := R.Top + Canvas.TextHeight(Texto) + 2;

 

  H.Brush.Color := clWhite;

  H.Canvas.Font.Name := 'Times New Roman';

  H.ActivateHint(R, Texto);

end;

 

procedure FechaHintClick

begin

  SendMessage(H.Handle, WM_CLOSE, 0 , 0 );

end;

 

procedure FormClose;

begin

  H.Free;

end;

 

// Para mover o hint para outra posicao:

 

  R.Left   := R.Left   + 100;

  R.Right  := R.Right  + 100;

  R.Top    := R.Top    + 100;

  R.Bottom := R.Bottom + 100;

 

  H.ActivateHint(R, Texto);

 

// isto depois de criado. note a var R e Texto neste caso devem ser globais

 

===============================================================================

// EXEMPLO 2

 

var

  HW: THintWindow;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  HW: THintWindow;

  P : TPoint;

  R : TRect;

begin

  // Pega posicao do Mouse

  GetCursorPos(P);

  // Converte do Mouse para a Form

  ScreenToClient(P);

  HW := THintWindow.Create(Self);

  // calcula o tamanho do Hint

  R := HW.CalcHintRect(100,'Teste de rinti.', nil);

  // altera as coordenadas para mostrar na posicao do mouse

  R.Top   := P.Y;

  R.Left  := P.X;

  R.Right := R.Right + P.x;

  R.Bottom:= R.Bottom + P.y;

  // Mostra

  HW.ActivateHint(R, 'Teste de rinti.');

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

  HW.ReleaseHandle; // Não funciona (dá access violation)

end;