2003. december 13., szombat

Show different hints in a TStringGrid at runtime


Problem/Question/Abstract:

How to show different hints in a TStringGrid at runtime

Answer:

Solve 1:

Provide a handler for Application.OnShowHint, like this:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    procedure HintHandler(var HintStr: string; var CanShow: Boolean; var HintInfo:
      THintInfo);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnShowHint := HintHandler;
end;

procedure TForm1.HintHandler(var HintStr: string; var CanShow: Boolean; var HintInfo:
  THintInfo);
var
  P: TPoint;
  C, R: Integer;
begin
  if HintInfo.HintControl <> StringGrid1 then
    Exit;
  P := StringGrid1.ScreenToClient(HintInfo.HintPos);
  StringGrid1.MouseToCell(P.X, P.Y, C, R);
  HintStr := Format('%d, %d', [C, R]);
end;

end.


Solve 2:

To create different hints for the cells in the TStringGrid:

{needs Timer1: TTimer}

const
  OldCol: longint = -1;
  OldRow: longint = -1;
  MyHint: THintWindow = nil;

procedure TTree_Test.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
var
  C, R: longint;
  pt: TPoint;
  s: string;
  Rect1: TRect;
begin
  StringGrid1.MouseToCell(X, Y, C, R);
  if (OldCol <> C) or (OldRow <> R) then
  begin
    OldCol := C;
    OldRow := R;
    Timer1Timer(nil);
    if (C < 0) or (C >= StringGrid1.ColCount) or (R < 0) or
                                        (R >= StringGrid1.RowCount)
      then
      Exit;
    s := StringGrid1.Cols[C][R];
    if (s <> '') and (Canvas.TextWidth(s) > StringGrid1.ColWidths[C]) then
    begin
      Rect1 := StringGrid1.CellRect(C, R);
      pt := StringGrid1.ClientToScreen(Rect1.TopLeft);
      MyHint := THintWindow.Create(Self);
      MyHint.Color := clInfoBk;
      MyHint.Canvas.Font.Color := clInfoText;
      Rect1 := MyHint.CalcHintRect(200, s, nil);
      OffsetRect(Rect1, pt.x, pt.y);
      MyHint.ActivateHint(Rect1, s);
      Timer1.Enabled := true;
    end;
  end;
end;

procedure TTree_Test.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := false;
  if Assigned(MyHint) then
  begin
    MyHint.free;
    MyHint := nil;
  end;
end;

procedure TTree_Test.FormDestroy(Sender: TObject);
begin
  Timer1Timer(nil);
end;

Nincsenek megjegyzések:

Megjegyzés küldése