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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése