Author: Tomas Rutkauskas
How to show different hints in a TStringGrid at runtime
Answer:
Solve 1:
Provide a handler for Application.OnShowHint, like this:
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls,
8 Grids;
9
10 type
11 TForm1 = class(TForm)
12 StringGrid1: TStringGrid;
13 Button1: TButton;
14 procedure FormCreate(Sender: TObject);
15 private
16 { Private declarations }
17 public
18 procedure HintHandler(var HintStr: string; var CanShow: Boolean; var HintInfo:
19 THintInfo);
20 end;
21
22 var
23 Form1: TForm1;
24
25 implementation
26
27 {$R *.DFM}
28
29 procedure TForm1.FormCreate(Sender: TObject);
30 begin
31 Application.OnShowHint := HintHandler;
32 end;
33
34 procedure TForm1.HintHandler(var HintStr: string; var CanShow: Boolean; var
35 HintInfo:
36 THintInfo);
37 var
38 P: TPoint;
39 C, R: Integer;
40 begin
41 if HintInfo.HintControl <> StringGrid1 then
42 Exit;
43 P := StringGrid1.ScreenToClient(HintInfo.HintPos);
44 StringGrid1.MouseToCell(P.X, P.Y, C, R);
45 HintStr := Format('%d, %d', [C, R]);
46 end;
47
48 end.
Solve 2:
To create different hints for the cells in the TStringGrid:
49 {needs Timer1: TTimer}
50
51 const
52 OldCol: longint = -1;
53 OldRow: longint = -1;
54 MyHint: THintWindow = nil;
55
56 procedure TTree_Test.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
57 Integer);
58 var
59 C, R: longint;
60 pt: TPoint;
61 s: string;
62 Rect1: TRect;
63 begin
64 StringGrid1.MouseToCell(X, Y, C, R);
65 if (OldCol <> C) or (OldRow <> R) then
66 begin
67 OldCol := C;
68 OldRow := R;
69 Timer1Timer(nil);
70 if (C < 0) or (C >= StringGrid1.ColCount) or (R < 0) or
71 (R >= StringGrid1.RowCount)
72 then
73 Exit;
74 s := StringGrid1.Cols[C][R];
75 if (s <> '') and (Canvas.TextWidth(s) > StringGrid1.ColWidths[C]) then
76 begin
77 Rect1 := StringGrid1.CellRect(C, R);
78 pt := StringGrid1.ClientToScreen(Rect1.TopLeft);
79 MyHint := THintWindow.Create(Self);
80 MyHint.Color := clInfoBk;
81 MyHint.Canvas.Font.Color := clInfoText;
82 Rect1 := MyHint.CalcHintRect(200, s, nil);
83 OffsetRect(Rect1, pt.x, pt.y);
84 MyHint.ActivateHint(Rect1, s);
85 Timer1.Enabled := true;
86 end;
87 end;
88 end;
89
90 procedure TTree_Test.Timer1Timer(Sender: TObject);
91 begin
92 Timer1.Enabled := false;
93 if Assigned(MyHint) then
94 begin
95 MyHint.free;
96 MyHint := nil;
97 end;
98 end;
99
100 procedure TTree_Test.FormDestroy(Sender: TObject);
101 begin
102 Timer1Timer(nil);
103 end;
|
