kao, 你怎么知道我昨晚刚刚写了一个? 算了,大家共享一下吧!
unit wxGrid;
interface
uses Windows, Messages, Classes, Forms, Controls, Graphics, SysUtils, Grids;
const
MaxHintWidth = 300;
type
TGridObject = (goCol, goRow);
TwxGrid = class(TStringGrid)
private
FHintWnd: THintWindow;
FCellHint: boolean;
FModified: boolean;
FWordWrap: boolean;
protected
function CalcHintRect(const AHint: string; HintWnd: THintWindow): TRect;
procedure DoHint(X, Y: Integer);
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
procedure RowMoved(FromIndex, ToIndex: Longint); override;
procedure ColWidthsChanged; override;
procedure RowHeightsChanged; override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
procedure SetWordWrap(Value: boolean);
public
procedure CMMouseEnter(var Msg: TMessage); message cm_MouseEnter;
procedure CMMouseLeave(var Msg: TMessage); message cm_MouseLeave;
procedure WMMouseMove(var Msg: TWMMouseMove); message wm_MouseMove;
property Modified: boolean read FModified write FModified;
published
constructor Create(AOwner: TComponent); override;
procedure MoveRow(FromIndex, ToIndex: Longint);
procedure MoveColumn(FromIndex, ToIndex: Longint);
procedure Insert(InsertObject: TGridObject; NewIndex: longint);
procedure Delete(DeleteObject: TGridObject; OldIndex: longint);
procedure AutoSizeWidth;
property CellHint: boolean read FCellHint write FCellHint;
property WordWrap: boolean read FWordWrap write SetWordWrap;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Xiang',[TwxGrid]);
end;
constructor TwxGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCellHint := True;
FModified := False;
FWordWrap := False;
end;
procedure TwxGrid.SetEditText(ACol, ARow: Longint; const Value: string);
begin
inherited SetEditText(ACol, ARow, Value);
FModified := True;
end;
procedure TwxGrid.ColumnMoved(FromIndex, ToIndex: Longint);
begin
FModified := True;
inherited ColumnMoved(FromIndex, ToIndex);
end;
procedure TwxGrid.RowMoved(FromIndex, ToIndex: Longint);
begin
FModified := True;
inherited RowMoved(FromIndex, ToIndex);
end;
procedure TwxGrid.ColWidthsChanged;
begin
FModified := True;
inherited ColWidthsChanged;
end;
procedure TwxGrid.RowHeightsChanged;
begin
FModified := True;
inherited RowHeightsChanged;
end;
procedure TwxGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
const
CharOffset = 2;
var
Sentence: string;
begin
if FWordWrap then begin
ARect := Rect(ARect.Left + CharOffset, ARect.Top + CharOffset, ARect.Right, ARect.Bottom);
with Canvas do begin
if gdFixed in AState then begin
Pen.Color := FixedColor;
Brush.Color := FixedColor;
end
else if gdSelected in AState then begin
Brush.Color := clHighlight;
Pen.Color := clHighlight;
Font.Color := clHighlightText;
end
else begin
Pen.Color := Color;
Brush.Color := Color;
end;
Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
Sentence := Cells[ACol, ARow];
DrawText(Canvas.Handle, PChar(Sentence), Length(Sentence), ARect, DT_WORDBREAK);
if Assigned(OnDrawCell) then OnDrawCell(Self, ACol, ARow, ARect, AState);
end
else
inherited DrawCell(ACol, ARow, ARect, AState);
end;
procedure TwxGrid.SetWordWrap(Value: boolean);
begin
FWordWrap := Value;
Invalidate;
end;
function TwxGrid.CalcHintRect(const AHint: string; HintWnd: THintWindow): TRect;
begin
Result := HintWnd.CalcHintRect(MaxHintWidth, AHint, nil)
end;
procedure TwxGrid.CMMouseEnter(var Msg: TMessage);
var
Pt: TPoint;
begin
if FCellHint then begin
GetCursorPos(Pt);
Pt := ScreenToClient(Pt);
DoHint(Pt.X, Pt.Y)
end;
end;
procedure TwxGrid.CMMouseLeave(var Msg: TMessage);
begin
inherited;
if Assigned(FHintWnd) then FHintWnd.ReleaseHandle;
end;
procedure TwxGrid.DoHint(X, Y: Integer);
const
TextOffset = 2;
var
Col, Row: Longint;
R, OldR: TRect;
Pt: TPoint;
begin
MouseToCell(X, Y, Col, Row);
Canvas.Font := Font;
if (Col <> -1) and (Row <> -1) and
(Canvas.TextWidth(Cells[Col, Row]) + TextOffset > ColWidths[Col]) and
not EditorMode and ForegroundTask and not (csDesigning in ComponentState) then begin
if not Assigned(FHintWnd) then begin
FHintWnd := HintWindowClass.Create(Self);
FHintWnd.Color := Application.HintColor;
end;
Hint := Cells[Col, Row];
R := CalcHintRect(Hint, FHintWnd);
Pt := ClientToScreen(CellRect(Col, Row).TopLeft);
Dec(Pt.X);
Dec(Pt.Y);
OffsetRect(R, Pt.X, Pt.Y);
GetWindowRect(FHintWnd.Handle, OldR);
if not IsWindowVisible(FHintWnd.Handle) or
not ((R.Left = OldR.Left) and (R.Top = OldR.Top)) then
FHintWnd.ActivateHint(R, Hint)
end
else
if Assigned(FHintWnd) then FHintWnd.ReleaseHandle;
end;
procedure TwxGrid.WMMouseMove(var Msg: TWMMouseMove);
begin
inherited;
if FCellHint then DoHint(Msg.XPos, Msg.YPos)
end;
procedure TwxGrid.MoveRow(FromIndex, ToIndex: Longint);
begin
Inherited MoveRow(FromIndex, ToIndex);
FModified := True;
end;
procedure TwxGrid.MoveColumn(FromIndex, ToIndex: Longint);
begin
Inherited MoveColumn(FromIndex, ToIndex);
FModified := True;
end;
procedure TwxGrid.Insert(InsertObject: TGridObject; NewIndex: longint);
var
i, j: longint;
begin
if InsertObject = goRow then begin
j := RowCount;
RowCount := RowCount + 1;
for i := J downto NewIndex + 1 do Rows := Rows[i - 1];
Rows[NewIndex].Clear;
end
else begin
j := ColCount;
ColCount := ColCount + 1;
for i := J downto NewIndex + 1 do Cols := Cols[i - 1];
Cols[NewIndex].Clear;
end;
FModified := True;
end;
procedure TwxGrid.Delete(DeleteObject: TGridObject; OldIndex: longint);
var
i, j: longint;
begin
if DeleteObject = goRow then begin
j := RowCount - 2;
for i := OldIndex to j do Rows := Rows[i + 1];
RowCount := RowCount - 1;
end
else begin
j := ColCount - 2;
for i := OldIndex to j do Cols := Cols[i + 1];
ColCount := ColCount - 1;
end;
FModified := True;
end;
procedure TwxGrid.AutoSizeWidth;
var
i, j : integer;
temp : integer;
Max : integer;
begin
for j := FixedCols to ColCount - 1 do begin
Max := 0;
for i := 0 to (RowCount - 1) do begin
temp := Canvas.TextWidth(Cells[j, i]);
if temp > Max then Max := temp;
end;
ColWidths[j] := Max + GridLineWidth + 4;
end;
end;
end.