procedure TForm1.HintTimer(ASender: TObject);
var
  LDS: TDataSet;
  LCurRow: Integer;
  LGridCoord: TGridCoord;
  LFldStatus: TField;
  LHint: string;
begin
  FHintTimer.Enabled := False;
  LDS := DataSet;
  if LDS <> nil then
    LFldStatus := LDS.FindField(CfnOutStatusStr)
  else
    LFldStatus := nil;
  LGridCoord := DBGrid1.MouseCoord(FMousePos.X, FMousePos.Y);
  if
    (LFldStatus = nil) or (LFldStatus.IsNull) or
    (LGridCoord.X <= 0) or (LGridCoord.Y <= 0)
  then
    Exit;
  LDS.DisableControls;
  try
    LCurRow := LDS.RecNo;
    LDS.RecNo := LGridCoord.Y;
    try
      LHint := LFldStatus.AsString;
    finally
      LDS.RecNo := LCurRow;
    end;
  finally
    LDS.EnableControls;
  end;
  DBGrid1.Hint := LHint;
  Application.ActivateHint(DBGrid1.ClientToScreen(FMousePos));
end;

 DataLink.ActiveRecord := rec;

procedure TForm1.HintTimer(ASender: TObject);
var
  LDS: TDataSet;
  LCurRow: Integer;
  LGridCoord: TGridCoord;
  LFldStatus: TField;
  LHint: string;
begin
  FHintTimer.Enabled := False;
  LDS := DataSet;
  if LDS <> nil then
    LFldStatus := LDS.FindField(CfnOutStatusStr)
  else
    LFldStatus := nil;
  LGridCoord := DBGrid1.MouseCoord(FMousePos.X, FMousePos.Y);
  if
    (LFldStatus = nil) or (LFldStatus.IsNull) or
    (LGridCoord.X <= 0) or (LGridCoord.Y <= 0)
  then
    Exit;
  LCurRow := THackDBGrid(DBGrid1).DataLink.ActiveRecord;
  THackDBGrid(DBGrid1).DataLink.ActiveRecord := LGridCoord.Y - 1;
  try
    LHint := LFldStatus.AsString;
  finally
    THackDBGrid(DBGrid1).DataLink.ActiveRecord := LCurRow;
  end;
//  OutputDebugString(PChar(LHint));
  DBGrid1.Hint := LHint;
  Application.ActivateHint(DBGrid1.ClientToScreen(FMousePos));
end;

procedure TRxDBGrid.CMHintShow(var Message: TLMessage);

Application.HintMouseMessage(Self, Message);

NewHintControl := GetHintControl(FindDragTarget(Control.ClientToScreen(SmallPointToPoint(MouseMsg.Pos)), True));

  if (NewHintControl = nil) or not NewHintControl.ShowHint then
    CancelHint

if (NewHintControl <> FHintControl) or
  (not FHintCursorRect.Contains(Control.ClientToScreen(SmallPointToPoint(MouseMsg.Pos)))) then

WasHintActive := FHintActive;
if WasHintActive then
  Pause := FHintShortPause else
  Pause := FHintPause;

NewHintControl.Perform(CM_HINTSHOWPAUSE, Ord(WasHintActive), Winapi.Windows.LPARAM(@Pause));

HintInfo.HintControl := FHintControl; // Для кого отображаем
HintInfo.HintPos := CursorPos;  // экранные координаты мыши
HintInfo.CursorRect := FHintControl.BoundsRect;  // тот самый "прямоугольник хинта". По умолчанию - весь контрол
HintInfo.CursorPos := FHintControl.ScreenToClient(CursorPos);  // координаты мыши в СО контрола
HintInfo.HintStr := GetShortHint(GetHint(FHintControl));  // Сама строка

CanShow := FHintControl.Perform(CM_HINTSHOW, 0, Winapi.Windows.LPARAM(@HintInfo)) = 0;

if CanShow and Assigned(FOnShowHint) then
  FOnShowHint(HintInfo.HintStr, CanShow, HintInfo);

FHintActive := CanShow and (FHintControl <> nil);
if FHintActive and (HintInfo.HintStr <> '') then

with HintInfo do
begin
  FHintCursorRect.TopLeft := FHintControl.ClientToScreen(CursorRect.TopLeft);
  FHintCursorRect.BottomRight := FHintControl.ClientToScreen(CursorRect.BottomRight);
end;

procedure TDBGrid.CMHintShow(var AMsg: TCMHintShow);
var
  LInfo: PHintInfo;
  LCell: TGridCoord;
  LRec: Integer;
begin
  if Assigned(FOnGetHint) then begin
    AMsg.Result := 1;
    LInfo := AMsg.HintInfo;
    LCell := MouseCoord(LInfo^.CursorPos.X, LInfo^.CursorPos.Y);
    if (LCell.X > 0) and (LCell.Y > 0) then begin
      LRec := DataLink.ActiveRecord;
      try
        // Перемещаемся на нужную запись
        DataLink.ActiveRecord := LCell.Y - 1;
        // Получаем нужный хинт
        FOnGetHint(Self, LInfo^.HintStr);
      finally
        DataLink.ActiveRecord := LRec;
      end;
      // Устанавливаем "прямоугольник хинта" на текущую строку
      LInfo^.CursorRect := CellRect(LCell.X, LCell.Y);
      LInfo^.CursorRect.Left := 0;
      LInfo^.CursorRect.Right := Width;
      AMsg.Result := 0;
    end;
  end;
  inherited;
end;

FOnGetHint: TOnGetHint;
TOnGetHint = procedure(ASender: TObject; var AStr: string) of object;

procedure TDBGrid.CMHintShowPause(var AMsg: TCMHintShowPause);
begin
  inherited;
  if AMsg.WasActive <> 0 then
    AMsg.Pause^ := Application.HintPause;
end;

procedure TDataLink.SetActiveRecord(Value: Integer);
begin
  if DataSource.State <> dsSetKey then
    DataSource.DataSet.FActiveRecord := Value + FFirstRecord;
end;

function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  Buff: TRecordBuffer;
  .........
begin
  Buff := GetActiveBuf;
  .........
end;

function TIBCustomDataSet.GetActiveBuf: TRecordBuffer;
begin
  case State of
    dsBrowse:
      if IsEmpty then
        result := nil
      else
        result := ActiveBuffer;
  ..........
end;

function TDataSet.ActiveBuffer: TRecordBuffer;
begin
  Result := FBuffers[FActiveRecord];
end;