请高手帮忙解决一个满格显示的数据库表格不能正常显示合计行的问题 ( 积分: 200 )

以下控件代码：可实现数据库表格满格显示和显示合计行，但还有以下问题：
1.在主从表环境下，移动主表记录，从表能数据能在表格中更新，但合计数没有更新
2.我希望在每列增加一个Wordwrap 属性
请高手帮忙解决
注意：本控件有一个属性“sumflag”,用于控制合计行的显示，如设为“合计,,1,1,1”，
则表示第一栏的合计行显示“合计”，第二栏合计行不显示，第三栏合计行显示本栏合计数.....(用“1”表示本栏显示合计数)
unit xcomps;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, StdCtrls, DBCtrls, DBGrids, DB, Math, Mask, DBTables,
Variants;

type
TxDBNavigator = class(TDBNavigator)
private
function ReadBtnEnabled(nb: TNavigateBtn): Boolean;
procedure SetBtnEnabled(nb: TNavigateBtn; Enabled: Boolean);
public
constructor Create(AOwner: TComponent);override;
property BtnEnabled[nb: TNavigateBtn]: Boolean read
ReadBtnEnabled write SetBtnEnabled;
published
property Font;
end;

{ -- 以下为xDBGrid -- }
const
MaxField = 50;

type

THeadTreeNode = class;
TxDBGrid = class;

LeafCol = record
FLeaf:THeadTreeNode;
FColumn:TColumn;
end;

PLeafCol = ^LeafCol;
// ArrLeafCol = array[0..MaxListSize - 1] of LeafCol;
TLeafCol = array[0..MaxListSize - 1] of LeafCol;
PTLeafCol = ^TLeafCol;

{ THeadTreeNode }

THeadTreeProc = procedure (node:THeadTreeNode) of object;
THeadTreeNode = class(TObject) // new
public
Host:THeadTreeNode;
Child:THeadTreeNode;
Next:THeadTreeNode;
Text:String;
Height:Integer;
Width:Integer;
Drawed:Boolean;
constructor Create;
constructor CreateText(AText:String;AHeight,AWidth:Integer);
destructor Destroy; override;
function Add(AAfter: THeadTreeNode; AText:String;
AHeight,AWidth:Integer):THeadTreeNode ;
function AddChild(ANode:THeadTreeNode;AText:String;
AHeight,AWidth:Integer):THeadTreeNode ;
function Find(ANode:THeadTreeNode):Boolean;
procedure Union(AFrom,ATo :THeadTreeNode;
AText:String;AHeight:Integer);
procedure FreeAllChild;
procedure CreateFieldTree(AGrid:TxDBGrid);
procedure DoForAllNode(proc:THeadTreeProc);
end;

TxDBGrid = class(TDBGrid)
private
FSelRow: Integer; // -- new ?????????????
FTitleOffset: Integer; // -- new;
// FIndicatorOffset: Integer;
FNoAppend: Boolean;
FIndicators: TImageList; // -- new;
FLineColor: TColor;
FSumColor: TColor;
FTopSumRows: Integer;
FBottomSumRows: Integer;
FSumFlag: string;
FOldValues: array[0..MaxField] of Variant;
FSumArray: array[0..MaxField] of Variant;
FEventArray: array[0..MaxField] of TFieldNotifyEvent;
FMasterQuery: TQuery;
FEventMasterScroll: TDataSetNotifyEvent;
FEventBeforeDelete: TDataSetNotifyEvent;
FEventBeforeCancel: TDataSetNotifyEvent;
FEventAfterCancel: TDataSetNotifyEvent;

// 原函数只刷新标题，增加整屏刷新
procedure WMSize(var Message: TWMSize); message WM_SIZE;
// 设置格线、统计行颜色。新增
procedure SetLineColor(clr: TColor);
procedure SetSumColor(clr: TColor);
// 计算在整个ClientHeight中,实际能以DefaultRowHeight
// 画多少个可卷动行,及最后一行的第线坐标
function MaxRowCount: Integer;
function MaxRowHeight: integer;
// 计算给定字段在COLUMNS中位置
function IndexOfColumn(fld: TField): Integer;
function IndexOfSumFlag(ACol: Integer): string;
procedure SetSumFlag(ACol: Integer; flag: string);
procedure WriteSumFlag(flag: string);
function GetSums(idx: Integer): real;
// 只是因为需要
function IsActiveControl: Boolean;
// 为减少修改程序量，直接取变量名为函数名
function FIndicatorOffset: Integer;
protected
FTitleHeight: Integer; {--------------new--------------}
FTitleLines: Integer; {--------------new--------------}
FTitleHeightFull: Integer; {new}

FMarginText:Boolean;
FVTitleMargin: Integer;
FHTitleMargin: Integer;
FUseMultiTitle: Boolean;

// 直接覆盖最TCustomGrid方法，无论任何行数量的
// 改动均强制改成满屏行
procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
// 覆盖原方法
procedure Paint;override;
procedure DrawCell(ACol, ARow: Longint;
ARect: TRect; AState: TGridDrawState); override;
procedure LayoutChanged; override;
procedure Scroll(Distance: Integer); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;

// 重新定义原始被隐藏的方法，不做修改
procedure UpdateRowCount;
procedure UpdateActive;
procedure UpdateScrollBar;
// 加载自己的编辑器，使之高度固定在DefaultRowHeigh上
function CreateEditor: TInplaceEdit; override;
// 专门针对统计的一系列方法
procedure OnFieldChange(Sender: TField);
procedure LinkActive(Value: Boolean); override;
function GetEditText(ACol, ARow: Longint): string;override;
// procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure OnMasterScroll(DataSet: TDataSet);
procedure OnBeforeDelete(DataSet: TDataSet);
procedure OnBeforeCancel(DataSet: TDataSet);
procedure OnAfterCancel(DataSet: TDataSet);
procedure CalcSum;
function FormatSum(Value: Variant; AField: TField): string;
procedure DrawSumCell(ACol: Integer);virtual;

// 多行标题
procedure ClearPainted(node:THeadTreeNode);
function SetChildTreeHeight(ANode:THeadTreeNode):Integer;
function ReadTitleHeight: Integer;
procedure WriteTitleHeight(th: Integer);
function ReadTitleLines: Integer;
procedure WriteTitleLines(tl: Integer);
procedure WriteMarginText(IsMargin:Boolean);
procedure WriteVTitleMargin(Value: Integer);
procedure WriteHTitleMargin(Value: Integer);
procedure WriteUseMultiTitle(Value:Boolean);
public
FHeadTree:THeadTreeNode;
FLeafFieldArrTLeafCol;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Sums[idx: Integer]: real read GetSums;

published
property TitleHeight : Integer read ReadTitleHeight
write WriteTitleHeight default 24;
property TitleLines : Integer read ReadTitleLines
write WriteTitleLines default 0;
property VTitleMargin: Integer read FVTitleMargin
write WriteVTitleMargin default 10;
property HTitleMargin: Integer read FHTitleMargin
write WriteHTitleMargin default 0;
property UseMultiTitle: Boolean read FUseMultiTitle
write WriteUseMultiTitle default False;
// 标准格线颜色
property LineColor: TColor read FLineColor write SetLineColor;
property SumColor: TColor read FSumColor write SetSumColor;
property SumFlag: String read FSumFlag write WriteSumFlag;
property NoAppend: boolean read FNoAppend write FNoAppend;
end;


TCharSet = Set of Char;

procedure Register;

implementation

(* $R xDBGRIDS.RES 放弃indicator位图 *)

procedure Register;
begin
RegisterComponents('Samples', [TxDBNavigator, TxDBGrid]);
end;

constructor TxDBNavigator.Create(AOwner :TComponent);
begin
inherited Create(aOwner);
Buttons[nbFirst ].Caption:='首条';
Buttons[nbPrior ].Caption:='前条';
Buttons[nbNext ].Caption:='后条';
Buttons[nbLast ].Caption:='末条';
Buttons[nbInsert ].Caption:='插入';
Buttons[nbDelete ].Caption:='删除';
Buttons[nbEdit ].Caption:='编辑';
Buttons[nbPost ].Caption:='存盘';
Buttons[nbCancel ].Caption:='放弃';
Buttons[nbRefresh].Caption:='刷新';
end;

function TxDBNavigator.ReadBtnEnabled(nb: TNavigateBtn): Boolean;
begin
Result := Buttons[nb].Enabled;
end;

procedure TxDBNavigator.SetBtnEnabled(nb: TNavigateBtn; Enabled: Boolean);
begin
DataChanged;
EditingChanged;
Buttons[nb].Enabled := (Buttons[nb].Enabled and Enabled);
end;

type
PIntArray = ^TIntArray;
TIntArray = array[0..MaxCustomExtents] of Integer;

// 为避免资源冲突，自行定义相应的行指示标位图
// 修改为放弃位图
{const
bmArrow = 'xDBGARROW';
bmEdit = 'xDBEDIT';
bmInsert = 'xDBINSERT';
bmMultiDot = 'xDBMULTIDOT';
bmMultiArrow = 'xDBMULTIARROW';}

var
DrawBitmap: TBitmap;
UserCount: Integer;

procedure UsesBitmap;
begin
if UserCount = 0 then
DrawBitmap := TBitmap.Create;
Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
Dec(UserCount);
if UserCount = 0 then DrawBitmap.Free;
end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment; ARightToLeft: Boolean);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
var
B, R: TRect;
Hold, Left: Integer;
I: TColorRef;
begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOut for solid colors }
{ In BiDi, because we changed the window origin, the text that does not
change alignment, actually gets its alignment changed. }
if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
ChangeBiDiModeAlignment(Alignment);
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ACanvas.TextRect(ARect, Left, ARect.Top + DY, Text);
end
else begin { Use FillRect and Drawtext for dithered colors }
DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
if (ACanvas.CanvasOrientation = coRightToLeft) then
ChangeBiDiModeAlignment(Alignment);
DrawText(Handle, PChar(Text), Length(Text), R,
AlignFlags[Alignment] or RTL[ARightToLeft]);
end;
if (ACanvas.CanvasOrientation = coRightToLeft) then
begin
Hold := ARect.Left;
ARect.Left := ARect.Right;
ARect.Right := Hold;
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;
end;
end;

////////
///{strUtils}
////////

function WordPosition(const N: Integer; const S: string; WordDelims: TCharSet): Integer;
var
Count, I: Integer;
begin
Count := 0;
I := 1;
Result := 0;
while (I <= Length(S)) and (Count <> N) do begin
{ skip over delimiters }
while (I <= Length(S)) and (S in WordDelims) do Inc(I);
{ if we're not beyond end of S, we're at the start of a word }
if I <= Length(S) then Inc(Count);
{ if not finished, find the end of the current word }
if Count <> N then
while (I <= Length(S)) and not (S in WordDelims) do Inc(I)
else Result := I;
end;
end;

function ExtractWord(N: Integer; const S: string; WordDelims: TCharSet): string;
var
I: Word;
Len: Integer;
begin
Len := 0;
I := WordPosition(N, S, WordDelims);
if I <> 0 then
{ find the end of the current word }
while (I <= Length(S)) and not(S in WordDelims) do begin
{ add the I'th character to result }
Inc(Len);
SetLength(Result, Len);
Result[Len] := S;
Inc(I);
end;
SetLength(Result, Len);
end;

function ExtractWordPos(N: Integer; const S: string; WordDelims: TCharSet;
var Pos: Integer): string;
var
I, Len: Integer;
begin
Len := 0;
I := WordPosition(N, S, WordDelims);
Pos := I;
if I <> 0 then
{ find the end of the current word }
while (I <= Length(S)) and not(S in WordDelims) do begin
{ add the I'th character to result }
Inc(Len);
SetLength(Result, Len);
Result[Len] := S;
Inc(I);
end;
SetLength(Result, Len);
end;

{ WriteTextEH }
procedure WriteTextEH(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment; MultyL: Boolean; LeftMarg:Integer);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
var
r, rect1: TRect;
I: Word;
Left, txth: Integer;
lpDTP : TDrawTextParams;

begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOut for solid colors }
if (MultyL = false) then begin
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
end
else begin {}{/////////// MultyL}
// 增加自动绘制边框功能
r:=ARect;
ACanvas.FillRect(ARect);
InflateRect(r,1,1);
ACanvas.Rectangle(r.left,r.top,r.right,r.bottom);

rect1.Left := 0; rect1.Top := 0; rect1.Right := 0; rect1.Bottom := 0;
rect1 := ARect; {}

lpDTP.cbSize := SizeOf(lpDTP);
lpDTP.uiLengthDrawn := Length(Text);
lpDTP.iLeftMargin := LeftMarg;
lpDTP.iRightMargin := 0;

InflateRect(rect1, -DX, -DY);

txth := DrawTextEx(ACanvas.Handle,PChar(Text), Length(Text), {}
rect1, DT_WORDBREAK or DT_CALCRECT,@lpDTP);

rect1 := ARect; {}
InflateRect(rect1, -DX, -DY);

rect1.top := rect1.top + ((rect1.Bottom-rect1.top) div 2) - (txth div 2);
DrawTextEx(ACanvas.Handle,PChar(Text), Length(Text), {}
rect1, AlignFlags[Alignment],@lpDTP); {}
end; {}
end
else begin { Use FillRect and Drawtext for dithered colors }
(* DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
if (ACanvas.CanvasOrientation = coRightToLeft) then
ChangeBiDiModeAlignment(Alignment);
DrawText(Handle, PChar(Text), Length(Text), R,
AlignFlags[Alignment] or RTL[ARightToLeft]);
end;
if (ACanvas.CanvasOrientation = coRightToLeft) then
begin
Hold := ARect.Left;
ARect.Left := ARect.Right;
ARect.Right := Hold;
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;*)
end;
end;

{ TxDBGridInplaceEdit }

{ 由于TDBGridInplaceEdit在dbGrids原文件中并未将其作为接口声明
所以只能照抄，然后简单覆盖其关键的客户区域设置函数，令其高度
为DefaultRowHeight高。
已知的BUG：内容超宽时，或编辑状态的横滚，引起的刷新会导致整
个单元格的重绘，原因不明。}

procedure KillMessage(Wnd: HWnd; Msg: Integer);
// Delete the requested message from the queue, but throw back
// any WM_QUIT msgs that PeekMessage may also return
var
M: TMsg;
begin
M.Message := 0;
if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
PostQuitMessage(M.wparam);
end;

type

TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
TPopupListbox = class;

TDBGridInplaceEdit = class(TInplaceEdit)
private
FButtonWidth: Integer;
FDataList: TDBLookupListBox;
FPickList: TPopupListbox;
FActiveList: TWinControl;
FLookupSource: TDatasource;
FEditStyle: TEditStyle;
FListVisible: Boolean;
FTracking: Boolean;
FPressed: Boolean;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetEditStyle(Value: TEditStyle);
procedure StopTracking;
procedure TrackButton(X,Y: Integer);
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
procedure WMPaint(var Message: TWMPaint); message wm_Paint;
procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
function OverButton(const P: TPoint): Boolean;
function ButtonRect: TRect;
protected
procedure BoundsChanged; override;
procedure CloseUp(Accept: Boolean);
procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
procedure DropDown;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure PaintWindow(DC: HDC); override;
procedure UpdateContents; override;
procedure WndProc(var Message: TMessage); override;
property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
property ActiveList: TWinControl read FActiveList write FActiveList;
property DataList: TDBLookupListBox read FDataList;
property PickList: TPopupListbox read FPickList;
public
constructor Create(Owner: TComponent); override;
end;

{ TPopupListbox }

TPopupListbox = class(TCustomListbox)
private
FSearchText: String;
FSearchTickCount: Longint;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure KeyPress(var Key: Char); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
end;

procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
AddBiDiModeExStyle(ExStyle);
WindowClass.Style := CS_SAVEBITS;
end;
end;

procedure TPopupListbox.CreateWnd;
begin
inherited CreateWnd;
Windows.SetParent(Handle, 0);
CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

procedure TPopupListbox.Keypress(var Key: Char);
var
TickCount: Integer;
begin
case Key of
#8, #27: FSearchText := '';
#32..#255:
begin
TickCount := GetTickCount;
if TickCount - FSearchTickCount > 2000 then FSearchText := '';
FSearchTickCount := TickCount;
if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
Key := #0;
end;
end;
inherited Keypress(Key);
end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
TDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
(X < Width) and (Y < Height));
end;


constructor TDBGridInplaceEdit.Create(Owner: TComponent);
begin
inherited Create(Owner);
FLookupSource := TDataSource.Create(Self);
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
FEditStyle := esSimple;
end;

procedure TDBGridInplaceEdit.BoundsChanged;
var
R: TRect;
begin
SetRect(R, 2, 2, Width - 2, Height);
if FEditStyle <> esSimple then
if not TCustomDBGrid(Owner).UseRightToLeftAlignment then
Dec(R.Right, FButtonWidth)
else
Inc(R.Left, FButtonWidth - 2);
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
if SysLocale.FarEast then
SetImeCompositionWindow(Font, R.Left, R.Top);
end;

procedure TDBGridInplaceEdit.CloseUp(Accept: Boolean);
var
MasterField: TField;
ListValue: Variant;
begin
if FListVisible then
begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
if FActiveList = FDataList then
ListValue := FDataList.KeyValue
else
if FPickList.ItemIndex <> -1 then
ListValue := FPickList.Items[FPicklist.ItemIndex];
SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FListVisible := False;
if Assigned(FDataList) then
FDataList.ListSource := nil;
FLookupSource.Dataset := nil;
Invalidate;
if Accept then
if FActiveList = FDataList then
with TxDBGrid(Grid), Columns[SelectedIndex].Field do
begin
MasterField := DataSet.FieldByName(KeyFields);
if MasterField.CanModify then
begin
DataSet.Edit;
MasterField.Value := ListValue;
end;
end
else
if (not VarIsNull(ListValue)) and EditCanModify then
with TxDBGrid(Grid), Columns[SelectedIndex].Field do
Text := ListValue;
end;
end;

procedure TDBGridInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_UP, VK_DOWN:
if ssAlt in Shift then
begin
if FListVisible then CloseUp(True) else DropDown;
Key := 0;
end;
VK_RETURN, VK_ESCAPE:
if FListVisible and not (ssAlt in Shift) then
begin
CloseUp(Key = VK_RETURN);
Key := 0;
end;
end;
end;

procedure TDBGridInplaceEdit.DropDown;
var
P: TPoint;
I,J,Y: Integer;
Column: TColumn;
begin
if not FListVisible and Assigned(FActiveList) then
begin
FActiveList.Width := Width;
with TxDBGrid(Grid) do
Column := Columns[SelectedIndex];
if FActiveList = FDataList then
with Column.Field do
begin
FDataList.Color := Color;
FDataList.Font := Font;
FDataList.RowCount := Column.DropDownRows;
FLookupSource.DataSet := LookupDataSet;
FDataList.KeyField := LookupKeyFields;
FDataList.ListField := LookupResultField;
FDataList.ListSource := FLookupSource;
FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
{ J := Column.DefaultWidth;
if J > FDataList.ClientWidth then
FDataList.ClientWidth := J;
} end
else
begin
FPickList.Color := Color;
FPickList.Font := Font;
FPickList.Items := Column.Picklist;
if FPickList.Items.Count >= Integer(Column.DropDownRows) then
FPickList.Height := Integer(Column.DropDownRows) * FPickList.ItemHeight + 4
else
FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
if Column.Field.IsNull then
FPickList.ItemIndex := -1
else
FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Text);
J := FPickList.ClientWidth;
for I := 0 to FPickList.Items.Count - 1 do
begin
Y := FPickList.Canvas.TextWidth(FPickList.Items);
if Y > J then J := Y;
end;
FPickList.ClientWidth := J;
end;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FListVisible := True;
Invalidate;
Windows.SetFocus(Handle);
end;
end;

type
TWinControlCracker = class(TWinControl) end;

procedure TDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
begin
TxDBGrid(Grid).EditButtonClick;
KillMessage(Handle, WM_CHAR);
end
else
inherited KeyDown(Key, Shift);
end;

procedure TDBGridInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
end;

procedure TDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if (Button = mbLeft) and (FEditStyle <> esSimple) and
OverButton(Point(X,Y)) then
begin
if FListVisible then
CloseUp(False)
else
begin
MouseCapture := True;
FTracking := True;
TrackButton(X, Y);
if Assigned(FActiveList) then
DropDown;
end;
end;
inherited MouseDown(Button, Shift, X, Y);
end;

procedure TDBGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ListPos: TPoint;
MousePos: TSmallPoint;
begin
if FTracking then
begin
TrackButton(X, Y);
if FListVisible then
begin
ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
if PtInRect(FActiveList.ClientRect, ListPos) then
begin
StopTracking;
MousePos := PointToSmallPoint(ListPos);
SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
Exit;
end;
end;
end;
inherited MouseMove(Shift, X, Y);
end;

procedure TDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
WasPressed: Boolean;
begin
WasPressed := FPressed;
StopTracking;
if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
TxDBGrid(Grid).EditButtonClick;
inherited MouseUp(Button, Shift, X, Y);
end;

procedure TDBGridInplaceEdit.PaintWindow(DC: HDC);
var
R: TRect;
Flags: Integer;
W, X, Y: Integer;
begin
if FEditStyle <> esSimple then
begin
R := ButtonRect;
Flags := 0;
if FEditStyle in [esDataList, esPickList] then
begin
if FActiveList = nil then
Flags := DFCS_INACTIVE
else if FPressed then
Flags := DFCS_FLAT or DFCS_PUSHED;
DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
end
else { esEllipsis }
begin
if FPressed then Flags := BF_FLAT;
DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
X := R.Left + ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
Y := R.Top + ((R.Bottom - R.Top) shr 1) - 1 + Ord(FPressed);
W := FButtonWidth shr 3;
if W = 0 then W := 1;
PatBlt(DC, X, Y, W, W, BLACKNESS);
PatBlt(DC, X - (W * 2), Y, W, W, BLACKNESS);
PatBlt(DC, X + (W * 2), Y, W, W, BLACKNESS);
end;
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
inherited PaintWindow(DC);
end;

procedure TDBGridInplaceEdit.SetEditStyle(Value: TEditStyle);
begin
if Value = FEditStyle then Exit;
FEditStyle := Value;
case Value of
esPickList:
begin
if FPickList = nil then
begin
FPickList := TPopupListbox.Create(Self);
FPickList.Visible := False;
FPickList.Parent := Self;
FPickList.OnMouseUp := ListMouseUp;
FPickList.IntegralHeight := True;
FPickList.ItemHeight := 11;
end;
FActiveList := FPickList;
end;
esDataList:
begin
if FDataList = nil then
begin
FDataList := TPopupDataList.Create(Self);
FDataList.Visible := False;
FDataList.Parent := Self;
FDataList.OnMouseUp := ListMouseUp;
end;
FActiveList := FDataList;
end;
else { cbsNone, cbsEllipsis, or read only field }
FActiveList := nil;
end;
with TxDBGrid(Grid) do
Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
Repaint;
end;

procedure TDBGridInplaceEdit.StopTracking;
begin
if FTracking then
begin
TrackButton(-1, -1);
FTracking := False;
MouseCapture := False;
end;
end;

procedure TDBGridInplaceEdit.TrackButton(X,Y: Integer);
var
NewState: Boolean;
R: TRect;
begin
R := ButtonRect;
NewState := PtInRect(R, Point(X, Y));
if FPressed <> NewState then
begin
FPressed := NewState;
InvalidateRect(Handle, @R, False);
end;
end;

procedure TDBGridInplaceEdit.UpdateContents;
var
Column: TColumn;
NewStyle: TEditStyle;
MasterField: TField;
begin
with TxDBGrid(Grid) do begin
if (SelectedIndex<0) or (SelectedIndex>=Columns.Count) then exit;
Column := Columns[SelectedIndex];
end;
NewStyle := esSimple;
case Column.ButtonStyle of
cbsEllipsis: NewStyle := esEllipsis;
cbsAuto:
if Assigned(Column.Field) then
with Column.Field do
begin
{ Show the dropdown button only if the field is editable }
if FieldKind = fkLookup then
begin
MasterField := Dataset.FieldByName(KeyFields);
{ Column.DefaultReadonly will always be True for a lookup field.
Test if Column.ReadOnly has been assigned a value of True }
if Assigned(MasterField) and MasterField.CanModify and
not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
with TxDBGrid(Grid) do
if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
NewStyle := esDataList
end
else
if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
not Column.Readonly then
NewStyle := esPickList
else if DataType in [ftDataset, ftReference] then
NewStyle := esEllipsis;
end;
end;
EditStyle := NewStyle;
inherited UpdateContents;
Font.Assign(Column.Font);
end;

procedure TDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
CloseUp(False);
end;

procedure TDBGridInplaceEdit.WMCancelMode(var Message: TMessage);
begin
StopTracking;
inherited;
end;

procedure TDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
begin
if not SysLocale.FarEast then inherited
else
begin
ImeName := Screen.DefaultIme;
ImeMode := imDontCare;
inherited;
if HWND(Message.WParam) <> TCustomDBGrid(Grid).Handle then
ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
end;
CloseUp(False);
end;

function TDBGridInplaceEdit.ButtonRect: TRect;
begin
if not TCustomDBGrid(Owner).UseRightToLeftAlignment then
Result := Rect(Width - FButtonWidth, 0, Width, Height)
else
Result := Rect(0, 0, FButtonWidth, Height);
end;

function TDBGridInplaceEdit.OverButton(const P: TPoint): Boolean;
begin
Result := PtInRect(ButtonRect, P);
end;

procedure TDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
with Message do
if (FEditStyle <> esSimple) and OverButton(Point(XPos, YPos)) then
Exit;
inherited;
end;

procedure TDBGridInplaceEdit.WMPaint(var Message: TWMPaint);
begin
PaintHandler(Message);
end;

procedure TDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
var
P: TPoint;
begin
GetCursorPos(P);
P := ScreenToClient(P);
if (FEditStyle <> esSimple) and OverButton(P) then
Windows.SetCursor(LoadCursor(0, idc_Arrow))
else
inherited;
end;

procedure TDBGridInplaceEdit.WndProc(var Message: TMessage);
begin
case Message.Msg of
wm_KeyDown, wm_SysKeyDown, wm_Char:
if EditStyle in [esPickList, esDataList] then
with TWMKey(Message) do
begin
DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
if (CharCode <> 0) and FListVisible then
begin
with TMessage(Message) do
SendMessage(FActiveList.Handle, Msg, WParam, LParam);
Exit;
end;
end
end;
inherited;
end;

{ TxDBGridInplaceEdit }
type

TxDBGridInplaceEdit = class(TDBGridInplaceEdit)
protected
procedure BoundsChanged; override;
end;

procedure TxDBGridInplaceEdit.BoundsChanged;
var
DefHeight: Integer;
begin
with TxDBGrid(Grid) do begin
DefHeight:=DefaultRowHeight;
end;
Invalidate;
// 强行改变编辑器窗口大小。
if Height>DefHeight then begin
SetWindowPos(Handle, HWND_TOP, Left, Top, Width, DefHeight,
SWP_SHOWWINDOW or SWP_NOREDRAW);
end;
inherited;
end;

{ THeadTreeNode }

constructor THeadTreeNode.Create;
begin
Child := Nil; Next := Self; Host := nil;
end;

constructor THeadTreeNode.CreateText(AText:String;AHeight,AWidth:Integer);
begin
Create;
Text := AText; Height := AHeight; Width := AWidth;
end;

destructor THeadTreeNode.Destroy;
begin
inherited;
if (Host = nil) then begin
FreeAllChild;
end;
end;

function THeadTreeNode.Add(AAfter:THeadTreeNode;AText:String;AHeight,AWidth:Integer):THeadTreeNode ;
var htLast,{htSelf,}th:THeadTreeNode;
begin
if(Find(AAfter) = false) then
raise Exception.Create('Node not in Tree');
htLast := AAfter.Next;
// while AAfter <> htLast.Next do htLast := htLast.Next; // 萨桁 镱耠邃龛?
th := THeadTreeNode.CreateText(AText,AHeight,AWidth);
th.Host := AAfter.Host;
AAfter.Next := th;
th.Next := htLast;
Result := th;
end;

function THeadTreeNode.AddChild(ANode:THeadTreeNode;
AText:String;AHeight,AWidth:Integer):THeadTreeNode ;
var
htLast,th:THeadTreeNode;
begin
if(Find(ANode) = false) then raise Exception.Create('Node not in Tree');

if(ANode.Child = nil) then begin
th := THeadTreeNode.CreateText(AText,AHeight,AWidth);
th.Host := ANode;
ANode.Child := th;
end else begin
htLast := ANode.Child;
while ANode.Child <> htLast.Next do htLast := htLast.Next;
th := THeadTreeNode.CreateText(AText,AHeight,AWidth);
th.Host := ANode;
htLast.Next := th;
th.Next := ANode.Child;
end;
Result := th;
end;

procedure THeadTreeNode.FreeAllChild;
var
htLast,htm:THeadTreeNode;
begin
if(Child = nil) then Exit;
htLast := Child;

while true do begin
htLast.FreeAllChild;
if(Child = htLast.Next) then begin htLast.Free; break; end;
htm := htLast;
htLast := htLast.Next;
htm.Free;
end;
Child := nil;
end;



function THeadTreeNode.Find(ANode:THeadTreeNode):Boolean;
var
htLast:THeadTreeNode;
begin
Result := false;
// if(Child = nil) then Exit;
htLast := Self;

while true do begin
if(htLast = ANode) then begin Result := true; break; end;
if(htLast.Child <> nil) and (htLast.Child.Find(ANode) = true) then begin Result := true; break; end;
if(Self = htLast.Next) then begin Result := false; break; end;
htLast := htLast.Next;
end;
end;

procedure THeadTreeNode.Union(AFrom,ATo :THeadTreeNode; AText:String;AHeight:Integer);
var th, tUn, TBeforFrom:THeadTreeNode;
toFinded :Boolean;
wid:Integer;
begin
if(Find(AFrom) = false) then raise Exception.Create('Node not in Tree');
toFinded := True;
if (AFrom <> ATo) then begin //new
th := AFrom; toFinded := false;
while AFrom.HOst.Child <> th.Next do begin
if(th.Next = ATo) then begin toFinded := true; break; end;
th := th.Next;
end;
end;

if(toFinded = false) then raise Exception.Create('ATo not in level');

tUn := ATo.Add(ATo,AText,AHeight,0);
TBeforFrom := AFrom.Host.Child;
while TBeforFrom.Next <> AFrom do TBeforFrom := TBeforFrom.Next;

TBeforFrom.Next := tUn;

th := AFrom; tUn.Child := AFrom;
if(th = AFrom.Host.Child) then AFrom.Host.Child := tUn;
Wid := 0;
while th <> ATo.Next do begin
Inc(Wid,th.Width);
Inc(Wid,1);
Dec(th.Height,AHeight);
th.Host := TUn;
th := th.Next;
end;
Dec(Wid,1);
ATo.Next := AFrom;
tUn.Width := Wid;
end;

{ CreateFieldTree }
procedure THeadTreeNode.CreateFieldTree(AGrid:TxDBGrid);
var i,pos,j:Integer;
node,nodeFrom,nodeTo:THeadTreeNode;
ss,ss1:String;
sameWord,GroupDid :Boolean;
begin

FreeAllChild;

for i := 0 to AGrid.Columns.Count - 1 do begin
if(Assigned(AGrid.Columns.Field)) then
node := AddChild(Self,AGrid.Columns.Field.DisplayLabel,
AGrid.RowHeights[0],
AGrid.Columns.Width)
else node := AddChild(Self,'',
AGrid.RowHeights[0]
,AGrid.Columns.Width);
AGrid.FLeafFieldArr.FLeaf := node;

end;

sameWord := false;
while True do begin//for k := 0 to ListNodeField.Count - 1 do begin
GroupDid := false;
for i := 0 to AGrid.Columns.Count - 1 do begin
ss1 := ExtractWordPos(2,AGrid.FLeafFieldArr.FLeaf.Text,['|'],pos);
if( ss1 <> '' ) then begin
ss1 := ExtractWord(1,AGrid.FLeafFieldArr.FLeaf.Text,['|']);
nodeFrom := AGrid.FLeafFieldArr.FLeaf;
// sameWord := false;
sameWord := True;
for j := i to AGrid.Columns.Count - 1 do begin
if (AGrid.Columns.Count - 1 > j) and
(ExtractWord(1,AGrid.FLeafFieldArr[j+1].FLeaf.Text,['|']) = ss1) then begin
ss := AGrid.FLeafFieldArr[j].FLeaf.Text;
Delete(ss,1,pos-1);
AGrid.FLeafFieldArr[j].FLeaf.Text := ss;
sameWord := true;
GroupDid := true;
end else begin
if (sameWord) then begin
ss := AGrid.FLeafFieldArr[j].FLeaf.Text;
Delete(ss,1,pos-1);
// TLeafField(ListNodeField.Items[j]).Field.DisplayLabel := ss;
AGrid.FLeafFieldArr[j].FLeaf.Text := ss;
nodeTo := AGrid.FLeafFieldArr[j].FLeaf;
GroupDid := true;
end;
break;
end;
end;
if(sameWord) then begin
Union(nodeFrom,nodeTo,ss1,20);
break;
end;
end; //if
end; //i
if(GroupDid = false) then break;
end; //k

end;

procedure THeadTreeNode.DoForAllNode(proc:THeadTreeProc);
var htLast:THeadTreeNode;
begin
if(Child = nil) then Exit;
htLast := Child;
while true do begin
proc(htLast);
if(htLast.Child <> nil ) then htLast.DoForAllNode(proc);
if(Child = htLast.Next) then begin break; end;
htLast := htLast.Next;
end;
end;

{ TxDBGrid }

constructor TxDBGrid.Create(AOwner: TComponent);
var
Bmp: TBitmap;
begin
UsesBitmap;
inherited Create(AOwner);
Bmp := TBitmap.Create;
try
// Bmp.LoadFromResourceName(HInstance, bmArrow);
FIndicators := TImageList.CreateSize(6, 11); //Bmp.Width, Bmp.Height);
{ FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmEdit);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmInsert);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmMultiDot);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmMultiArrow);
FIndicators.AddMasked(Bmp, clWhite);}
finally
Bmp.Free;
end;

FTitleHeight := 24; {new}
FTitleHeightFull := 24;
FTitleLines := 0;
FLeafFieldArr := nil;
FHeadTree := THeadTreeNode.CreateText('xTitle',10,0);
FVTitleMargin := 10;
FHTitleMargin := 0;
FUseMultiTitle := False;

// 为新特性所增变量
FTitleOffset := 1;
// FIndicatorOffset:=1;
FTopSumRows := 1;
FSumFlag := '';
FBottomSumRows := 0;
FLineColor := clBlack;
FSumColor := clInfoBk;
RowCount := 5;
FMasterQuery:=nil;
end;

destructor TxDBGrid.Destroy;
var
i: Integer;
f: TDataSetNotifyEvent;
f1: TFieldNotifyEvent;
begin
if Assigned(FMasterQuery) and (FMasterQuery.DataSource<>nil) then begin
f:=OnMasterScroll;
if (Assigned(FEventMasterScroll)) and (@f<>@FEventMasterScroll) then
FMasterQuery.DataSource.DataSet.AfterScroll:=FEventMasterScroll
else
FMasterQuery.DataSource.DataSet.AfterScroll:=nil;
end;
FMasterQuery:=nil;
FEventMasterScroll:=nil; // 专为处理主从表

for i:=0 to Columns.Count-1 do begin
if (Columns.Field<>nil) then begin
f1:=OnFieldChange;
if (Assigned(FEventArray)) and (@f1<>@FEventArray) then
Columns.Field.OnChange:=FEventArray
else
Columns.Field.OnChange:=nil;
end;
FEventArray:=nil;
FSumArray:=0;
FOldValues:=0;
end;

inherited;
if(FLeafFieldArr <> nil) then FreeMem(FLeafFieldArr);
FHeadTree.Free;
ReleaseBitmap;
end;

procedure TxDBGrid.LayoutChanged;
var
tm: TTEXTMETRIC;
K,J,I: Integer;
AFont:TFont;
begin
inherited;
// if not AcquireLayoutLock then Exit;
if({(RowHeights[0] <> FTitleHeightFull) and }(dgTitles in Options)) then begin
K := 0;
for I := 0 to Columns.Count-1 do
begin
Canvas.Font := Columns.Title.Font;
J := Canvas.TextHeight('Wg') + 4;
if J > K then begin K := J; GetTextMetrics(Canvas.Handle, tm); end;
end;
if K = 0 then
begin
Canvas.Font := TitleFont;
GetTextMetrics(Canvas.Handle, tm);
end;

FTitleHeightFull := tm.tmExternalLeading + tm.tmHeight*FTitleLines+2 +
FTitleHeight;
if dgRowLines in Options then
FTitleHeightFull := FTitleHeightFull + 1;
RowHeights[0] := FTitleHeightFull;
if(UseMultiTitle = true) then begin
ReallocMem(FLeafFieldArr,SizeOf(LeafCol)*Columns.Count);
AFont := Canvas.Font;
Canvas.Font := TitleFont;
for i := 0 to Columns.Count - 1 do
FLeafFieldArr.FColumn := Columns;
FHeadTree.CreateFieldTree(Self);
RowHeights[0] := SetChildTreeHeight(FHeadTree) -2;// 1;
Canvas.Font := AFont;
end;
// 新增，首先将RowCount设为满屏，并将末行设为二倍高
UpdateRowCount;
Invalidate;
end;
end;

function TxDBGrid.MaxRowCount: integer;
var
CHeight, LineWidth, h, i: Integer;
begin
// if (not HandleAllocated)
// or (csLoading in ComponentState) then
CHeight:=Height
// else
// CHeight:=ClientHeight
;
if dgRowLines in Options then LineWidth:=1 else LineWidth:=0;
h:=RowHeights[0]+LineWidth;
i:=0;
while h+DefaultRowHeight+LineWidth-10<CHeight do begin
Inc(h, DefaultRowheight+LineWidth);
Inc(i);
end;
Result:=i;
end;

function TxDBGrid.MaxRowHeight: integer;
var
CHeight, LineWidth, h: Integer;
begin
// if (not HandleAllocated)
// or (csLoading in ComponentState) then
CHeight:=Height
// else
// CHeight:=ClientHeight
;
if dgRowLines in Options then LineWidth:=1 else LineWidth:=0;
h:=RowHeights[0]+LineWidth;
// i:=0;
while h+DefaultRowHeight+LineWidth<CHeight do begin
Inc(h, DefaultRowheight+LineWidth);
// Inc(i);
end;
Result:=h-2;
end;

function TxDBGrid.ReadTitleHeight: Integer;
begin
Result := FTitleHeight;
end;

procedure TxDBGrid.WriteTitleHeight(th: Integer); {WriteTitleHeight}
begin
FTitleHeight := th;
LayoutChanged;
end;

function TxDBGrid.ReadTitleLines: Integer;
begin
Result := FTitleLines;
end;

procedure TxDBGrid.WriteTitleLines(tl: Integer); {WriteTitleLines}
begin
FTitleLines := tl;
LayoutChanged;
end;

procedure TxDBGrid.ClearPainted(node:THeadTreeNode); //new
begin
node.Drawed := false;
end;

procedure TxDBGrid.WriteMarginText(IsMargin:Boolean);
begin
if(IsMargin <> FMarginText) then begin
FMarginText := IsMargin;
LayoutChanged;
end;
end;

procedure TxDBGrid.WriteVTitleMargin(Value: Integer);
begin
FVTitleMargin := Value;
LayoutChanged;
end;

procedure TxDBGrid.WriteHTitleMargin(Value: Integer);
begin
FHTitleMargin := Value;
LayoutChanged;
end;

procedure TxDBGrid.WriteUseMultiTitle(Value:Boolean);
begin
FUseMultiTitle := Value;
LayoutChanged;
end;

function TxDBGrid.SetChildTreeHeight(ANode:THeadTreeNode):Integer;
var htLast:THeadTreeNode;
newh,maxh,th :Integer;
rec:TRect;
DefaultRowHeight : Integer;
begin
DefaultRowHeight := 0;
Result := 0;
if(ANode.Child = nil) then Exit;
htLast := ANode.Child;
maxh := 0;
if(htLast.Child <> nil) then
maxh := SetChildTreeHeight(htLast);

rec := Rect(0,0,htLast.Width-4,DefaultRowHeight);
th := DrawText(Canvas.Handle,PChar(htLast.Text),
Length(htLast.Text), rec, DT_WORDBREAK or DT_CALCRECT);
if (th > DefaultRowHeight) then maxh := maxh + th + FVTitleMargin
else maxh := maxh + DefaultRowHeight;

while true do begin
if(ANode.Child = htLast.Next) then begin break; end;
htLast := htLast.Next;
newh := 0;
if(htLast.Child <> nil) then
newh := SetChildTreeHeight(htLast);
rec := Rect(0,0,htLast.Width-4,DefaultRowHeight);
th := DrawText(Canvas.Handle,PChar(htLast.Text),
Length(htLast.Text), rec, DT_WORDBREAK or DT_CALCRECT);
if (th > DefaultRowHeight) then newh := newh + th + FVTitleMargin
else newh := newh + DefaultRowHeight;

if(maxh < newh) then maxh := newh;
end;

htLast := ANode.Child;
while ANode.Child <> htLast.Next do begin
if(htLast.Child = nil) then htLast.Height := maxh
else htLast.Height := maxh - htLast.Height;
htLast := htLast.Next;
end;
if(htLast.Child = nil) then htLast.Height := maxh
else htLast.Height := maxh - htLast.Height;

ANode.Height := maxh;
Result := maxh;
end;

procedure TxDBGrid.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;

procedure TxDBGrid.SetLineColor(clr: TColor);
begin
if FLineColor<>clr then begin
FLineColor:=clr;
Invalidate;
end;
end;

procedure TxDBGrid.SetSumColor(clr: TColor);
begin
if FSumColor<>clr then begin
FSumColor:=clr;
Invalidate;
end;
end;

procedure TxDBGrid.Scroll(Distance: Integer);
var
OldRect, NewRect: TRect;
RowHeight: Integer;
begin
if FBottomSumRows<=0 then begin
inherited Scroll(Distance);
exit;
end;
if not HandleAllocated then Exit;
OldRect := BoxRect(0, Row, ColCount - 1, Row);
if (DataLink.ActiveRecord >= RowCount - FTitleOffset) then
// or (RowCount<MaxRowCount+FTitleOffset) then
UpdateRowCount{LayoutChanged};
UpdateScrollBar;
UpdateActive;
NewRect := BoxRect(0, Row, ColCount - 1, Row);
ValidateRect(Handle, @OldRect);
InvalidateRect(Handle, @OldRect, False);
InvalidateRect(Handle, @NewRect, False);
if Distance <> 0 then
begin
HideEditor;
try
if Abs(Distance) > VisibleRowCount then
begin
Invalidate;
Exit;
end
else
begin
// 目的：使向上屏幕卷动时，底行不残留原先的行
RowHeight := DefaultRowHeight;
if dgRowLines in Options then Inc(RowHeight, GridLineWidth);
// 刷新当前记录行
if dgIndicator in Options then
begin
OldRect := BoxRect(0, FSelRow, ColCount - 1, FSelRow);
InvalidateRect(Handle, @OldRect, False);
end;
// 刷新正文
// 卷动屏幕时，令裁剪矩形空出底层一行
NewRect := BoxRect(0, FTitleOffset, ColCount - 1, {VisibleRowCount}1000);
Dec(NewRect.Bottom, RowHeight*FBottomSumRows);
ScrollWindowEx(Handle, 0, -RowHeight * Distance, @NewRect, @NewRect,
0, nil, SW_Invalidate);
if dgIndicator in Options then
begin
NewRect := BoxRect(0, Row, ColCount - 1, Row);
InvalidateRect(Handle, @NewRect, False);
end;
end;
finally
if dgAlwaysShowEditor in Options then ShowEditor;
end;
end;
if UpdateLock = 0 then Update;
end;

procedure TxDBGrid.UpdateRowCount;
var
OldRowCount: Integer;
begin
OldRowCount := RowCount;
if FBottomSumRows>0 then begin
if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
FixedRows := FTitleOffset;
with DataLink do
if (not Active or (RecordCount = 0) or not HandleAllocated) then
RowCount:=MaxRowCount-1+FTitleOffset
else begin
RowCount := 100;
DataLink.BufferCount := MaxRowCount-1 {VisibleRowCount};
RowCount := {RecordCount} MaxRowCount-1 + FTitleOffset;
if dgRowSelect in Options then TopRow := FixedRows;
UpdateActive;
end;
end
else begin
if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
FixedRows := FTitleOffset;
with DataLink do
if (not Active or (RecordCount = 0) or not HandleAllocated) then
RowCount:=FTitleOffset+{MaxRowCount}VisibleRowCount
else begin
RowCount := 100;
DataLink.BufferCount := {MaxRowCount}VisibleRowCount;
RowCount := FTitleOffset+ RecordCount;
if dgRowSelect in Options then TopRow := FixedRows;
UpdateActive;
end;
end;
if OldRowCount <> RowCount then Invalidate;
end;

procedure TxDBGrid.UpdateScrollBar;
var
SIOld, SINew: TScrollInfo;
begin
if Datalink.Active and HandleAllocated then
with Datalink.DataSet do
begin
SIOld.cbSize := sizeof(SIOld);
SIOld.fMask := SIF_ALL;
GetScrollInfo(Self.Handle, SB_VERT, SIOld);
SINew := SIOld;
if IsSequenced then
begin
SINew.nMin := 1;
SINew.nPage := Self.VisibleRowCount;
SINew.nMax := Integer(DWORD(RecordCount) + SINew.nPage - 1);
if State in [dsInactive, dsBrowse, dsEdit] then
SINew.nPos := RecNo; // else keep old pos
end
else
begin
SINew.nMin := 0;
SINew.nPage := 0;
SINew.nMax := 4;
if DataLink.BOF then SINew.nPos := 0
else if DataLink.EOF then SINew.nPos := 4
else SINew.nPos := 2;
end;
if (SINew.nMin <> SIOld.nMin) or (SINew.nMax <> SIOld.nMax) or
(SINew.nPage <> SIOld.nPage) or (SINew.nPos <> SIOld.nPos) then
SetScrollInfo(Self.Handle, SB_VERT, SINew, True);
end;
end;

procedure TxDBGrid.UpdateActive;
var
NewRow: Integer;
Field: TField;
begin
if Datalink.Active and HandleAllocated and not (csLoading in ComponentState) then
begin
NewRow := Datalink.ActiveRecord + FTitleOffset;
if Row <> NewRow then
begin
if not (dgAlwaysShowEditor in Options) then HideEditor;
MoveColRow(Col, NewRow, False, False);
InvalidateEditor;
end;
Field := SelectedField;
if Assigned(Field) {and (Field.Text <> FEditText)} then
InvalidateEditor;
end;
end;

{ 单元格绘制，关键改动 }
procedure TxDBGrid.DrawCell(ACol, ARow: Longint; ARect:
TRect; AState: TGridDrawState);
var
FrameOffs: Byte;

function RowIsMultiSelected: Boolean;
var
Index: Integer;
begin
Result := (dgMultiSelect in Options) and Datalink.Active and
SelectedRows.Find(Datalink.Datasource.Dataset.Bookmark, Index);
end;

procedure DrawHost(ALeaf:THeadTreeNode; DHRect:TRect);
var
curLeaf: THeadTreeNode;
curW:Integer;
leftM:Integer;
drawRec:TRect;
begin
DHRect.Bottom := DHRect.Top-1;
Dec(DHRect.Top,ALeaf.Host.Height);

curLeaf := ALeaf.Host.Child;
curW := 0;
while curLeaf <> ALeaf do begin
Inc(curW,curLeaf.Width);
if dgColLines in Options then Inc(curW,1);
curLeaf := curLeaf.Next;
end;
Dec(DHRect.Left,curW);
DHRect.Right := DHRect.Left + ALeaf.Host.Width;
leftM := 0;
drawRec := DHRect;
// BUG，假定行提示列永远存在
if (dgIndicator in Options) and
(DHRect.Left < ColWidths[0]) then
begin
leftM := DHRect.Left - ColWidths[0] - 1;
drawRec.Left := ColWidths[0]+1;
end;
InflateRect(DHRect, 1, 1);

if(leftM <> 0) then
WriteTextEH(Canvas, drawRec, FrameOffs-1, FrameOffs,
ALeaf.Host.Text, taCenter,true,leftM)
else
WriteTextEH(Canvas, drawRec, FrameOffs, FrameOffs,
ALeaf.Host.Text, taCenter,true,leftM);

ALeaf.Host.Drawed := true;

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then begin
if CTL3D then
begin
if(leftM <> 0) then
DrawEdge(Canvas.Handle, drawRec, BDR_RAISEDINNER, BF_TOP)
else
DrawEdge(Canvas.Handle, drawRec, BDR_RAISEDINNER, BF_TOPLEFT);
DrawEdge(Canvas.Handle, drawRec, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
end;
InflateRect(DHRect, -1, -1);
end;

if(ALeaf.Host.Host <> nil) and (ALeaf.Host.Host.Drawed = false) then
begin
DrawHost(ALeaf.Host,DHRect);
ALeaf.Host.Host.Drawed := true;
end;
end;

procedure DrawTitleCell(ACol, ARow: Integer; Column: TColumn; var AState: TGridDrawState);
const
ScrollArrows: array [Boolean, Boolean] of Integer =
((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
var
MasterCol: TColumn;
TitleRect, TextRect, ButtonRect: TRect;
I: Integer;
InBiDiMode: Boolean;
begin
TitleRect := CalcTitleRect(Column, ARow, MasterCol);

if MasterCol = nil then
begin
Canvas.FillRect(ARect);
Exit;
end;

Canvas.Font := MasterCol.Title.Font;
Canvas.Brush.Color := MasterCol.Title.Color;
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
InflateRect(TitleRect, -1, -1);
TextRect := TitleRect;
I := GetSystemMetrics(SM_CXHSCROLL);
if ((TextRect.Right - TextRect.Left) > I) and MasterCol.Expandable then
begin
Dec(TextRect.Right, I);
ButtonRect := TitleRect;
ButtonRect.Left := TextRect.Right;
I := SaveDC(Canvas.Handle);
try
Canvas.FillRect(ButtonRect);
InflateRect(ButtonRect, -1, -1);
IntersectClipRect(Canvas.Handle, ButtonRect.Left,
ButtonRect.Top, ButtonRect.Right, ButtonRect.Bottom);
InflateRect(ButtonRect, 1, 1);
{ DrawFrameControl doesn't draw properly when orienatation has changed.
It draws as ExtTextOut does. }
InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
if InBiDiMode then { stretch the arrows box }
Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
ScrollArrows[InBiDiMode, MasterCol.Expanded] or DFCS_FLAT);
finally
RestoreDC(Canvas.Handle, I);
end;
end;
with MasterCol.Title do
WriteText(Canvas, TextRect, FrameOffs, FrameOffs, Caption, Alignment,
IsRightToLeft);
if ([dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines])
and CTL3D then
begin
InflateRect(TitleRect, 1, 1);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
AState := AState - [gdFixed]; // prevent box drawing later
end;

var
OldActive: Integer;
Indicator: Integer;
Highlight: Boolean;
Value: string;
DrawColumn: TColumn;
MultiSelected: Boolean;
ALeft: Integer;
ARect1: TRect;
begin
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;

Dec(ARow, FTitleOffset);
Dec(ACol, FIndicatorOffset);

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) and CTL3D then
begin
InflateRect(ARect, -1, -1);
FrameOffs := 1;
end
else
FrameOffs := 2;
// 左边提示行
if (gdFixed in AState) and (ACol < 0) then
begin
Canvas.Brush.Color := FixedColor;
Canvas.FillRect(ARect);
if Assigned(DataLink) and DataLink.Active then
begin
MultiSelected := False;
if ARow >= 0 then
begin
OldActive := DataLink.ActiveRecord;
try
Datalink.ActiveRecord := ARow;
MultiSelected := RowIsMultiselected;
finally
Datalink.ActiveRecord := OldActive;
end;
end;
if (ARow = DataLink.ActiveRecord) or MultiSelected then
begin
Indicator := 0;
if DataLink.DataSet <> nil then
case DataLink.DataSet.State of
dsEdit: Indicator := 1;
dsInsert: Indicator := 2;
dsBrowse:
if MultiSelected then
if (ARow <> Datalink.ActiveRecord) then
Indicator := 3
else
Indicator := 4; // multiselected and current row
end;
FIndicators.BkColor := FixedColor;
ALeft := ARect.Right - FIndicators.Width - FrameOffs;
if Canvas.CanvasOrientation = coRightToLeft then Inc(ALeft);
// FIndicators.Draw(Canvas, ALeft,
// (ARect.Top + ARect.Top + DefaultRowHeight - FIndicators.Height) shr 1, Indicator, True);
if ARow = Datalink.ActiveRecord then
FSelRow := ARow + FTitleOffset;
end;
end;
end
else with Canvas do
begin
DrawColumn := Columns[ACol];

if not DrawColumn.Showing then Exit; // 为何要去掉
// 设置字体
if not (gdFixed in AState) then
begin
Font := DrawColumn.Font;
Brush.Color := DrawColumn.Color;
end
else begin
Font := DrawColumn.Title.Font;
Brush.Color := DrawColumn.Title.Color;
end;
// 上方固定行,先正常绘制最底行
// if ARow < 0 then
// DrawTitleCell(ACol, ARow + FTitleOffset, DrawColumn, AState)
if ARow < 0 then with DrawColumn.Title do begin
ARect1 := ARect;
if (FUseMultiTitle = True) then begin
Font := TitleFont;
ARect.Top := ARect.Bottom - FLeafFieldArr[ACol].FLeaf.Height + 1;
WriteTextEH(Canvas, ARect, FrameOffs, FrameOffs, FLeafFieldArr[ACol].FLeaf.Text, taCenter,True,0);
end
else
WriteTextEH(Canvas, ARect, FrameOffs, FrameOffs, Caption, Alignment,True,0);
end
// 正文CELL，无内容直接清除
else if (DataLink = nil)
or not DataLink.Active
or (ARow>=DataLink.RecordCount) then
FillRect(ARect)
else
// 标准正文
begin
Value := '';
OldActive := DataLink.ActiveRecord;
try
DataLink.ActiveRecord := ARow;
if Assigned(DrawColumn.Field) then begin
Value := DrawColumn.Field.DisplayText;
end;
Highlight := HighlightCell(ACol, ARow, Value, AState);
if Highlight then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end;
if not Enabled then
Font.Color := clGrayText;

// 绘制单元格
ARect1:=ARect;
if ARect.Bottom-ARect.Top>DefaultRowHeight then begin
ARect1.Bottom:=ARect.Top+DefaultRowHeight;
end;
if DefaultDrawing then
WriteText(Canvas, ARect1, 2, 2, Value, DrawColumn.Alignment,
UseRightToLeftAlignmentForField(DrawColumn.Field, DrawColumn.Alignment));
// 绘制汇总行
if (FBottomSumRows>0) and (ARow=MaxRowCount-1) then begin
DrawSumCell(ACol);
end;
if Columns.State = csDefault then
DrawDataCell(ARect, DrawColumn.Field, AState);
DrawColumnCell(ARect, ACol, DrawColumn, AState);
finally
DataLink.ActiveRecord := OldActive;
end;
// 彻底不需要焦点
{ if DefaultDrawing and (gdSelected in AState)
and ((dgAlwaysShowSelection in Options) or Focused)
and not (csDesigning in ComponentState)
and not (dgRowSelect in Options)
and (UpdateLock = 0)
and (ValidParentForm(Self).ActiveControl = Self) then
Windows.DrawFocusRect(Handle, ARect);}
end;
end;

// 无论任何固定行均需处理凸凹
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) and Ctl3D then
begin
InflateRect(ARect, 1, 1);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
end;

// 最后绘制抬头
if (ARow < 0) and (ACol >=0) and (FUseMultiTitle = True) then
with DrawColumn.Title do begin
if(FLeafFieldArr[ACol].FLeaf.Host <> nil) and
(FLeafFieldArr[ACol].FLeaf.Host.Drawed = False) then
begin
Canvas.Pen.Color:=FLineColor;
DrawHost(FLeafFieldArr[ACol].FLeaf,ARect);
end;
end;


end;

// PAINT方法所需函数
function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
begin
Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
and (Row <= Rect.Bottom);
end;

procedure FillDWord(var Dest; Count, Value: Integer); register;
asm
XCHG EDX, ECX
PUSH EDI
MOV EDI, EAX
MOV EAX, EDX
REP STOSD
POP EDI
end;

{ StackAlloc allocates a 'small' block of memory from the stack by
decrementing SP. This provides the allocation speed of a local variable,
but the runtime size flexibility of heap allocated memory. }
function StackAlloc(Size: Integer): Pointer; register;
asm
POP ECX { return address }
MOV EDX, ESP
ADD EAX, 3
AND EAX, not 3 // round up to keep ESP dword aligned
CMP EAX, 4092
JLE @@2
@@1:
SUB ESP, 4092
PUSH EAX { make sure we touch guard page, to grow stack }
SUB EAX, 4096
JNS @@1
ADD EAX, 4096
@@2:
SUB ESP, EAX
MOV EAX, ESP { function result = low memory address of block }
PUSH EDX { save original SP, for cleanup }
MOV EDX, ESP
SUB EDX, 4
PUSH EDX { save current SP, for sanity check (sp = [sp]) }
PUSH ECX { return to caller }
end;

{ StackFree pops the memory allocated by StackAlloc off the stack.
- Calling StackFree is optional - SP will be restored when the calling routine
exits, but it's a good idea to free the stack allocated memory ASAP anyway.
- StackFree must be called in the same stack context as StackAlloc - not in
a subroutine or finally block.
- Multiple StackFree calls must occur in reverse order of their corresponding
StackAlloc calls.
- Built-in sanity checks guarantee that an improper call to StackFree will not
corrupt the stack. Worst case is that the stack block is not released until
the calling routine exits. }
procedure StackFree(P: Pointer); register;
asm
POP ECX { return address }
MOV EDX, DWORD PTR [ESP]
SUB EAX, 8
CMP EDX, ESP { sanity check #1 (SP = [SP]) }
JNE @@1
CMP EDX, EAX { sanity check #2 (P = this stack block) }
JNE @@1
MOV ESP, DWORD PTR [ESP+4] { restore previous SP }
@@1:
PUSH ECX { return to caller }
end;

procedure TxDBGrid.Paint;
var
LineColor: TColor;
DrawInfo: TGridDrawInfo;
Sel: TGridRect;
UpdateRect: TRect;
//AFocRect, FocRect: TRect;
PointsList: PIntArray;
StrokeList: PIntArray;
MaxStroke: Integer;
FrameFlags1, FrameFlags2: DWORD;

procedure DrawLines(DoHorz, DoVert: Boolean; Col, Row: Longint;
const CellBounds: array of Integer; OnColor, OffColor: TColor);

{ Cellbounds is 4 integers: StartX, StartY, StopX, StopY
Horizontal lines: MajorIndex = 0
Vertical lines: MajorIndex = 1 }

const
FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;

procedure DrawAxisLines(const AxisInfo: TGridAxisDrawInfo;
Cell, MajorIndex: Integer; UseOnColor: Boolean);
var
Line: Integer;
LogBrush: TLOGBRUSH;
Index: Integer;
Points: PIntArray;
StopMajor, StartMinor, StopMinor: Integer;
begin
with Canvas, AxisInfo do
begin
if EffectiveLineWidth <> 0 then
begin
Pen.Width := GridLineWidth;
if UseOnColor then
Pen.Color := OnColor
else
Pen.Color := OffColor;
if Pen.Width > 1 then
begin
LogBrush.lbStyle := BS_Solid;
LogBrush.lbColor := Pen.Color;
LogBrush.lbHatch := 0;
Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
end;
Points := PointsList;
Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
GetExtent(Cell);
//!!! ??? Line needs to be incremented for RightToLeftAlignment ???
if UseRightToLeftAlignment and (MajorIndex = 0) then Inc(Line);
StartMinor := CellBounds[MajorIndex xor 1];
StopMinor := CellBounds[2 + (MajorIndex xor 1)];
StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
Index := 0;
repeat
Points^[Index + MajorIndex] := Line; { MoveTo }
Points^[Index + (MajorIndex xor 1)] := StartMinor;
Inc(Index, 2);
Points^[Index + MajorIndex] := Line; { LineTo }
Points^[Index + (MajorIndex xor 1)] := StopMinor;
Inc(Index, 2);
Inc(Cell);
Inc(Line, GetExtent(Cell) + EffectiveLineWidth);
until Line > StopMajor;
{ 2 integers per point, 2 points per line -> Index div 4 }
PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
end;
end;
end;

begin
if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then Exit;
if not DoHorz then
begin
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
end
else
begin
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
end;
end;

procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
Color: TColor; IncludeDrawState: TGridDrawState);
var
CurCol, CurRow: Longint;
{AWhere,} Where, TempRect: TRect;
DrawState: TGridDrawState;
Focused: Boolean;
begin
CurRow := ARow;
Where.Top := StartY;
while (Where.Top < StopY) do begin
if (CurRow < RowCount) then
begin
CurCol := ACol;
Where.Left := StartX;
Where.Bottom := Where.Top + RowHeights[CurRow];
while (Where.Left < StopX) and (CurCol < ColCount) do
begin
Where.Right := Where.Left + ColWidths[CurCol];
if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
begin
DrawState := IncludeDrawState;
Focused := IsActiveControl;
if Focused and (CurRow = Row) and (CurCol = Col) then
Include(DrawState, gdFocused);
if PointInGridRect(CurCol, CurRow, Sel) then
Include(DrawState, gdSelected);
if not (gdFocused in DrawState) or not (dgEditing in Options) or
not EditorMode or (csDesigning in ComponentState) then
begin
if DefaultDrawing or (csDesigning in ComponentState) then
with Canvas do
begin
Font := Self.Font;
if (gdSelected in DrawState) and
(not (gdFocused in DrawState) or
([{goDrawFocusSelected, }dgRowSelect] * Options <> [])) then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end
else
Brush.Color := Color;
// 减少刷新范围，避免将统计值清空
tempRect:=Where;
if tempRect.Bottom-tempRect.Top>DefaultRowHeight then
tempRect.Bottom:=Where.Top+DefaultRowHeight;
if (CurRow>0) and not (gdFixed in DrawState) then
FillRect(tempRect);
end;
DrawCell(CurCol, CurRow, Where, DrawState);
if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
((FrameFlags1 or FrameFlags2) <> 0) then
begin
TempRect := Where;
if (FrameFlags1 and BF_RIGHT) = 0 then
Inc(TempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
else if (FrameFlags1 and BF_BOTTOM) = 0 then
Inc(TempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
if not ((CurRow=0) and (CurCol>0)) then begin
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1);
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2);
end;
end;
// 彻底不需要焦点
{ if DefaultDrawing and not (csDesigning in ComponentState) and
(gdFocused in DrawState) and
([dgEditing, dgAlwaysShowEditor] * Options <>
[dgEditing, dgAlwaysShowEditor])
and not (dgRowSelect in Options) then
begin
if not UseRightToLeftAlignment then
DrawFocusRect(Canvas.Handle, Where)
else
begin
AWhere := Where;
AWhere.Left := Where.Right;
AWhere.Right := Where.Left;
DrawFocusRect(Canvas.Handle, AWhere);
end;
end;}
end;
end;
Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
Inc(CurCol);
end;
Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
Inc(CurRow);
end
else begin
CurCol := ACol;
Where.Left := StartX;
Where.Bottom := Where.Top + DefaultRowHeight{RowHeights[CurRow]};
while (Where.Left < StopX) and (CurCol < ColCount) do
begin
Where.Right := Where.Left + ColWidths[CurCol];
if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
begin
with Canvas do begin
Brush.Color := Color;
FillRect(Where);
end;
end;
Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
Inc(CurCol);
end;
Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
Inc(CurRow);
end;
end; { end of while }
end;

var
i: Integer;
begin
// if UseRightToLeftAlignment then ChangeGridOrientation(True);
if dgTitles in Options then
FHeadTree.DoForAllNode(ClearPainted);

UpdateRect := Canvas.ClipRect;
CalcDrawInfo(DrawInfo);
with DrawInfo do
begin
if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then
begin
{ Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
(fixed, variable) and (variable, variable) }
LineColor := FLineColor;
MaxStroke := Max(Horz.LastFullVisibleCell - LeftCol + FixedCols,
MaxRowCount{Vert.LastFullVisibleCell - TopRow} + FixedRows) + 3;
PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
FillDWord(StrokeList^, MaxStroke, 2);

if ColorToRGB(Color) = clSilver then LineColor := clGray;
DrawLines(dgRowLines in Options, dgColLines in Options,
0, 0, [0, 0, Horz.FixedBoundary, Vert.FixedBoundary],
FLineColor, FixedColor);
// 抬头的格线由标题单元格自行绘制
if CTL3D then
DrawLines(dgRowLines in Options, dgColLines in Options,
LeftCol, 0, [Horz.FixedBoundary, 0, Horz.GridBoundary,
Vert.FixedBoundary], FLineColor, FixedColor);
// 提示行格线必须绘制，无论有多少行
DrawLines(dgRowLines in Options, dgColLines in Options,
0, TopRow, [0, Vert.FixedBoundary, Horz.FixedBoundary,
MaxRowHeight+1{ Vert.GridBoundary}], FLineColor, FixedColor);

// 正文格线同样，无论实际多少行
DrawLines(dgRowLines in Options, dgColLines in Options, LeftCol,
TopRow, [Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridBoundary,
MaxRowHeight+1{ Vert.GridBoundary}], LineColor, Color);

StackFree(StrokeList);
StackFree(PointsList);
end;

{ Draw the cells in the four areas }
Sel := Selection;
FrameFlags1 := 0;
FrameFlags2 := 0;
if dgColLines in Options then
begin
FrameFlags1 := BF_RIGHT;
FrameFlags2 := BF_LEFT;
end;
if dgRowLines in Options then
begin
FrameFlags1 := FrameFlags1 or BF_BOTTOM;
FrameFlags2 := FrameFlags2 or BF_TOP;
end;
DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, FixedColor,
[gdFixed]);
DrawCells(LeftCol, 0, Horz.FixedBoundary {- FColOffset}, 0, Horz.GridBoundary, //!! clip
Vert.FixedBoundary, FixedColor, [gdFixed]);
DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary,
MaxRowHeight+1{Vert.GridBoundary}, FixedColor, [gdFixed]);
DrawCells(LeftCol, TopRow, Horz.FixedBoundary {- FColOffset}, //!! clip
Vert.FixedBoundary, Horz.GridBoundary, MaxRowHeight+1{Vert.GridBoundary}, Color, []);

// 强制重绘汇总行
if FBottomSumRows>0 then
for i:=0 to ColCount-FIndicatorOffset-1 do
DrawSumCell(i);
// 彻底取消绘制焦点
{ if not (csDesigning in ComponentState) and
(dgRowSelect in Options) and DefaultDrawing and Focused then
begin
GridRectToScreenRect(Selection, FocRect, False);
if not UseRightToLeftAlignment then
Canvas.DrawFocusRect(FocRect)
else
begin
AFocRect := FocRect;
AFocRect.Left := FocRect.Right;
AFocRect.Right := FocRect.Left;
DrawFocusRect(Canvas.Handle, AFocRect);
end;
end;}

{ Fill in area not occupied by cells }
// 右方空白区域必须向下延伸到最后
if Horz.GridBoundary < Horz.GridExtent then
begin
Canvas.Brush.Color := Color;
// if FBottomSumRows>0 then
Canvas.FillRect(Rect(Horz.GridBoundary, 0,
Horz.GridExtent, MaxRowHeight+2))
// else
// Canvas.FillRect(Rect(Horz.GridBoundary, 0,
// Horz.GridExtent, Vert.GridBoundary));
end;
// 下方空白区域必须从最大处开始
if Vert.GridBoundary < Vert.GridExtent then
begin
Canvas.Brush.Color := Color;
// if FBottomSumRows>0 then
Canvas.FillRect(Rect(0, MaxRowHeight+2,
Horz.GridExtent, Vert.GridExtent))
// else
// Canvas.FillRect(Rect(0, Vert.GridBoundary,
// Horz.GridExtent, Vert.GridExtent));
end;
end;

// if UseRightToLeftAlignment then ChangeGridOrientation(False);
end;

procedure TxDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
if not FNoAppend then
inherited KeyDown(Key,Shift)
else begin
if (Key = VK_DOWN)
and (not (ssCtrl in Shift)) then begin
if (Datalink.DataSet.Eof) then
exit;
Datalink.DataSet.Next;
if Datalink.DataSet.Eof then exit;
end
else
inherited KeyDown(Key,Shift);
end;
end;

function TxDBGrid.IsActiveControl: Boolean;
var
H: Hwnd;
ParentForm: TCustomForm;
begin
Result := False;
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) then
begin
if (ParentForm.ActiveControl = Self) then
Result := True
end
else
begin
H := GetFocus;
while IsWindow(H) and (Result = False) do
begin
if H = WindowHandle then
Result := True
else
H := GetParent(H);
end;
end;
end;

function TxDBGrid.CreateEditor: TInplaceEdit;
begin
Result := TxDBGridInplaceEdit.Create(Self);
end;

procedure TxDBGrid.SizeChanged(OldColCount, OldRowCount: Longint);
begin
if FBottomSumRows<=0 then exit;
if OldRowCount<>FTitleOffset+MaxRowCount-1 then begin
RowCount:=FTitleOffSet+MaxRowCount-1;
RowHeights[RowCount-1]:=DefaultRowHeight*2+1;
end;
end;

function TxDBGrid.IndexOfColumn(fld: TField): Integer;
var
i: Integer;
begin
if fld=nil then begin result:=-1; exit; end;

Result:=-1;
for i:=0 to Columns.Count-1 do begin
if fld.FieldName=Columns.FieldName then begin
result:=i;
break;
end
else
Result:=-1;
end;
end;

function TxDBGrid.IndexOfSumFlag(ACol: Integer): string;
var
s: string;
idx, i: Integer;
begin
s:=FSumFlag;
i:=0;
while (i<=ACol) do begin
idx:=pos(',', s);
if (idx>0) then
result:=Copy(s,1,idx-1)
else begin
result:='';
exit;
end;
s:=Copy(s,idx+1,Length(s)-idx);
Inc(i);
end;
end;

procedure TxDBGrid.WriteSumFlag(flag: string);
begin
FSumFlag:=flag;
if FSumFlag<>'' then FBottomSumRows:=1
else FBottomSumRows:=0;
end;

procedure TxDBGrid.SetSumFlag(ACol: Integer; flag: string);
var
s, s1: string;
idx, i: Integer;
begin
s:=FSumFlag;
s1:='';
i:=0;
while (i<=ACol) do begin
idx:=pos(',', s);
if (idx>0) then begin
if (i<ACol) then s1:=s1+Copy(s,1,idx);
end
else
exit;
s:=Copy(s,idx+1,Length(s)-idx);
Inc(i);
end;
FSumFlag:=s1+flag+','+s;
end;

procedure TxDBGrid.DrawSumCell(ACol: Integer);
var
r: TRect;
sum: string;
alig: TAlignment;
AText: string;
begin
if FBottomSumRows<=0 then exit;
r:=CellRect(ACol+FIndicatorOffset, FTitleOffset);
r.Top:=MaxRowHeight-DefaultRowHeight+1;
r.Bottom:=r.Top+DefaultRowHeight;
Canvas.Brush.Color := FSumColor;
Canvas.Font.Color := clBlack;
Canvas.Pen.Color := FLineColor;
Canvas.MoveTo(r.Left,r.Top-1);
Canvas.LineTo(r.Right,r.Top-1);
with Columns[ACol] do begin
sum:=IndexOfSumFlag(ACol);
if sum='1' then begin
if VarIsNull(FSumArray[ACol]) then
AText:=FormatSum(0, Field)
else
AText:=FormatSum(FSumArray[ACol],Field);
alig:=Alignment;
end
else begin
AText:=Sum;
alig:=taCenter;
end;
WriteText(Canvas, r, 2, 2, AText, alig,
UseRightToLeftAlignmentForField(Field, Alignment));
end;
end;

procedure TxDBGrid.LinkActive(Value: Boolean);
var
i: Integer;
f: TFieldNotifyEvent;
f1: TDataSetNotifyEvent;
begin
inherited LinkActive(Value);
if DataLink.DataSet=nil then exit;
// 数据库关闭
if not Value then begin
if Assigned(FMasterQuery) and (FMasterQuery.DataSource<>nil) then begin
f1:=OnMasterScroll;
if Assigned(FEventMasterScroll) and (@f1<>@FEventMasterScroll) then
FMasterQuery.DataSource.DataSet.AfterScroll:=FEventMasterScroll
else
FMasterQuery.DataSource.DataSet.AfterScroll:=nil;
end;
FMasterQuery:=nil;
FEventMasterScroll:=nil; // 专为处理主从表

f1:=OnBeforeDelete;
if Assigned(FEventBeforeDelete) and (@f1<>@FEventBeforeDelete) then
DataLink.DataSet.BeforeDelete:=FEventBeforeDelete
else
DataLink.DataSet.BeforeDelete:=nil;

f1:=OnBeforeCancel;
if Assigned(FEventBeforeCancel) and (@f1<>@FEventBeforeCancel) then
DataLink.DataSet.BeforeCancel:=FEventBeforeCancel
else
DataLink.DataSet.BeforeCancel:=nil;

f1:=OnAfterCancel;
if Assigned(FEventAfterCancel) and (@f1<>@FEventAfterCancel) then
DataLink.DataSet.AfterCancel:=FEventAfterCancel
else
DataLink.DataSet.AfterCancel:=nil;

for i:=0 to Columns.Count-1 do begin
if (Columns.Field<>nil) then begin
f:=OnFieldChange;
if (Assigned(FEventArray)) and (@f<>@FEventArray) then
Columns.Field.OnChange:=FEventArray
else
Columns.Field.OnChange:=nil;
end;
FEventArray:=nil;
FSumArray:=0;
FOldValues:=0;
end;
exit;
end;
// 求初始的统计值
with DataLink.DataSet do begin
if not Active then exit;
// 保存开始的事件
if DataLink.DataSet.InheritsFrom(TQuery) then begin
FMasterQuery:=TQuery(DataLink.DataSet);
if FMasterQuery.DataSource<>nil then begin
f1:=OnMasterScroll;
if (Assigned(FMasterQuery.DataSource.DataSet.AfterScroll))
and (@f1<>@FMasterQuery.DataSource.DataSet.AfterScroll) then
FEventMasterScroll:=FMasterQuery.DataSource.DataSet.AfterScroll
else
FEventMasterScroll:=nil;
FMasterQuery.DataSource.DataSet.AfterScroll:=OnMasterScroll;
end;
end;

f1:=OnBeforeDelete;
if (Assigned(DataLink.DataSet.BeforeDelete))
and (@f1<>@DataLink.DataSet.BeforeDelete) then
FEventBeforeDelete:=DataLink.DataSet.BeforeDelete
else
FEventBeforeDelete:=nil;
DataLink.DataSet.BeforeDelete:=OnBeforeDelete;

f1:=OnBeforeCancel;
if (Assigned(DataLink.DataSet.BeforeCancel))
and (@f1<>@DataLink.DataSet.BeforeCancel) then
FEventBeforeCancel:=DataLink.DataSet.BeforeCancel
else
FEventBeforeCancel:=nil;
DataLink.DataSet.BeforeCancel:=OnBeforeCancel;

f1:=OnAfterCancel;
if (Assigned(DataLink.DataSet.AfterCancel))
and (@f1<>@DataLink.DataSet.AfterCancel) then
FEventAfterCancel:=DataLink.DataSet.AfterCancel
else
FEventAfterCancel:=nil;
DataLink.DataSet.AfterCancel:=OnAfterCancel;

// 修正BUG，不应用DATASET的次序而非COLUMNS的次序。
for i:=0 to Columns.Count-1 do begin
// 检测标志位，看是否需计总
if IndexOfSumFlag(i)='1' then begin
if (Columns.Field<>nil) and (Columns.Field.DataType in
[ftSmallint, ftInteger, ftFloat, ftBCD, ftCurrency, ftLargeint]) then
begin
if Assigned(Columns.Field.OnChange) then begin
f:=OnFieldChange;
if @f<>@Columns.Field.OnChange then
FEventArray:=Columns.Field.OnChange
else
FEventArray:=nil;
end;
FSumArray:=0;
FOldValues:=0;
Columns.Field.OnChange:=OnFieldChange;
end
// 修正标志位
else begin
SetSumFlag(i, '');
end;
end;
end;
CalcSum;
end;
end;

procedure TxDBGrid.CalcSum;
var
i: Integer;
begin
with DataLink.DataSet do begin
if not Active then exit;
for i:=0 to MaxField do begin
FSumArray:=0;
FOldValues:=0;
end;

DisableControls;
First;
while not eof do begin
for i:=0 to Columns.Count-1 do begin
// 直接检测标志位，看是否需计总
if (IndexOfSumFlag(i)='1') and
not VarIsNull(Columns.Field.Value) then
FSumArray:=FSumArray+Columns.Field.Value;
end;
next;
end;
First;
EnableControls;
end;
Invalidate;
end;

procedure TxDBGrid.OnMasterScroll(DataSet: TDataSet);
var
f: TDataSetNotifyEvent;
begin
f:=OnMasterScroll;
if (Assigned(FEventMasterScroll)) and (@FEventMasterScroll<>@f) then
FEventMasterScroll(DataSet);
CalcSum;
end;

procedure TxDBGrid.OnBeforeDelete(DataSet: TDataSet);
var
i: Integer;
f: TDataSetNotifyEvent;
begin
f:=OnBeforeDelete;
if (Assigned(FEventBeforeDelete)) and (@FEventBeforeDelete<>@f) then
FEventBeforeDelete(DataSet);

if (DataSet=nil) or (not DataSet.Active) then exit;
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if (IndexOfSumFlag(i)='1') then begin
FSumArray:=FSumArray-Columns.Field.AsFloat;
DrawSumCell(i);
end;
end;
end;

procedure TxDBGrid.OnBeforeCancel(DataSet: TDataSet);
var
i: Integer;
f: TDataSetNotifyEvent;
begin
f:=OnBeforeCancel;
if (Assigned(FEventBeforeCancel)) and (@FEventBeforeCancel<>@f) then
FEventBeforeCancel(DataSet);

if (DataSet=nil) or (not DataSet.Active) then exit;
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if (IndexOfSumFlag(i)='1') then
FOldValues:=Columns.Field.Value;
end;
end;

procedure TxDBGrid.OnAfterCancel(DataSet: TDataSet);
var
i: Integer;
f: TDataSetNotifyEvent;
begin
f:=OnAfterCancel;
if (Assigned(FEventAfterCancel)) and (@FEventAfterCancel<>@f) then
FEventAfterCancel(DataSet);

if (DataSet=nil) or (not DataSet.Active) then exit;
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if (IndexOfSumFlag(i)='1') then begin
FSumArray:=FSumArray-FOldValues+Columns.Field.Value;
DrawSumCell(i);
end;
end;
end;

function TxDBGrid.GetEditText(ACol, ARow: Longint): string;
var
s: string;
i: Integer;
f: TFieldNotifyEvent;

///////////////////////////////////////////////////////////
// 清除格式化字符
function NumberString(str: string): string;
begin
while (pos(',',str)>0) do Delete(Str, Pos(',',str), 1);
while (pos('$',str)>0) do Delete(Str, Pos('$',str), 1);
while (pos('￥', str)>0) do Delete(Str, Pos('￥',str), 2);
if str='' then result:='0'
else result:=str;
end;

begin
// 修正BUG，计算字段，无论何时全都存放计算字段旧值
if (Datalink.Active) then begin
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if {((ACol-FIndicatorOffset=i)
and (Columns.Field.FieldKind<>fkData))
and} (IndexOfSumFlag(i)='1') then begin
// 强制重新赋予ONCHANGE处理例程
f:=OnFieldChange;
if @Columns.Field.OnChange<>@f then begin
FEventArray:=Columns.Field.OnChange;
Columns.Field.OnChange:=OnFieldChange;
end;

if (Columns.Field.Text<>'') then begin
s:=NumberString(Columns.Field.Text);
FOldValues:=StrToFloat(s)
end
else
FOldValues:=0;
end;
end;
end;
Result:=inherited GetEditText(ACol, ARow);
end;

///////////////////////////////////////////////////////////
// 以下函数组合专为处理字段统计用
procedure TxDBGrid.OnFieldChange(Sender: TField);
var
idx: Integer;
f: TFieldNotifyEvent;
begin
if (Sender=nil) then exit;
idx:=IndexOfColumn(Sender);
if idx<0 then exit;
f:=OnFieldChange;
if (Assigned(FEventArray[idx])) and (@f<>@FEventArray[idx]) then
FEventArray[idx](Sender);
if Sender.Value<>FOldValues[idx] then
FSumArray[idx]:=FSumArray[idx]+Sender.Value-FOldValues[idx];
DrawSumCell(idx);
end;

{procedure TxDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
var
ANewValue: real;
i: Integer;
begin
inherited SetEditText(ACol, ARow, Value);
if (Datalink.Active) then begin
for i:=0 to Columns.Count-1 do begin
// 避免产生BUG，无论如何全计算
if ((ACol-FIndicatorOffset=i) // （当前列
or (Columns.Field.FieldKind<>fkData)) // 或 计算字段）
and (IndexOfSumFlag(i)='1') then begin // 且（含计算标志）
ANewValue:=Columns.Field.AsFloat;
// AnewValue:=StrToFloat(NumberString(Columns.Field.Text));
if ANewValue<>FOldValues then begin
FSumArray:=FSumArray+ANewValue-FOldValues;
DrawSumCell(i);
end;
end;
end;
end;
end;}

function TxDBGrid.FIndicatorOffset: Integer;
begin
if dgIndicator in Options then result:=1
else result:=0;
end;

function TxDBGrid.FormatSum(Value: Variant; AField: TField): string;
var
L: Longint;
F: Double;
FmtStr: string;
Format: TFloatFormat;
Digits: Integer;
Text: string;
begin
if AField=nil then exit;
FmtStr := TNumericField(AField).DisplayFormat;
if not AField.InheritsFrom(TFloatField) then begin
L := Value;
if FmtStr = '' then Str(L, Text) else Text:=FormatFloat(FmtStr, L);
end
else begin
F := Value;
if FmtStr = '' then begin
if TFloatField(AField).Currency then begin
Format := ffCurrency;
Digits := CurrencyDecimals;
end
else begin
Format := ffGeneral;
Digits := 0;
end;
Text := FloatToStrF(F, Format, TFloatField(AField).Precision, Digits);
end else
Text := FormatFloat(FmtStr, F);
end;
Result:=Text;
end;

function TxDBGrid.GetSums(idx: Integer): real;
var
sum: string;
begin
sum:=IndexOfSumFlag(idx);
if sum='1' then begin
if VarIsNull(FSumArray[idx]) then
result:=0
else
Result:=FSumArray[idx];
end
else
Result:=0;
end;

end.

以下控件代码：可实现数据库表格满格显示和显示合计行，但还有以下问题：
1.在主从表环境下，移动主表记录，从表能数据能在表格中更新，但合计数没有更新
2.我希望在每列增加一个Wordwrap 属性
请高手帮忙解决
注意：本控件有一个属性“sumflag”,用于控制合计行的显示，如设为“合计,,1,1,1”，
则表示第一栏的合计行显示“合计”，第二栏合计行不显示，第三栏合计行显示本栏合计数.....(用“1”表示本栏显示合计数)
unit xcomps;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, StdCtrls, DBCtrls, DBGrids, DB, Math, Mask, DBTables,
Variants;

type
TxDBNavigator = class(TDBNavigator)
private
function ReadBtnEnabled(nb: TNavigateBtn): Boolean;
procedure SetBtnEnabled(nb: TNavigateBtn; Enabled: Boolean);
public
constructor Create(AOwner: TComponent);override;
property BtnEnabled[nb: TNavigateBtn]: Boolean read
ReadBtnEnabled write SetBtnEnabled;
published
property Font;
end;

{ -- 以下为xDBGrid -- }
const
MaxField = 50;

type

THeadTreeNode = class;
TxDBGrid = class;

LeafCol = record
FLeaf:THeadTreeNode;
FColumn:TColumn;
end;

PLeafCol = ^LeafCol;
// ArrLeafCol = array[0..MaxListSize - 1] of LeafCol;
TLeafCol = array[0..MaxListSize - 1] of LeafCol;
PTLeafCol = ^TLeafCol;

{ THeadTreeNode }

THeadTreeProc = procedure (node:THeadTreeNode) of object;
THeadTreeNode = class(TObject) // new
public
Host:THeadTreeNode;
Child:THeadTreeNode;
Next:THeadTreeNode;
Text:String;
Height:Integer;
Width:Integer;
Drawed:Boolean;
constructor Create;
constructor CreateText(AText:String;AHeight,AWidth:Integer);
destructor Destroy; override;
function Add(AAfter: THeadTreeNode; AText:String;
AHeight,AWidth:Integer):THeadTreeNode ;
function AddChild(ANode:THeadTreeNode;AText:String;
AHeight,AWidth:Integer):THeadTreeNode ;
function Find(ANode:THeadTreeNode):Boolean;
procedure Union(AFrom,ATo :THeadTreeNode;
AText:String;AHeight:Integer);
procedure FreeAllChild;
procedure CreateFieldTree(AGrid:TxDBGrid);
procedure DoForAllNode(proc:THeadTreeProc);
end;

TxDBGrid = class(TDBGrid)
private
FSelRow: Integer; // -- new ?????????????
FTitleOffset: Integer; // -- new;
// FIndicatorOffset: Integer;
FNoAppend: Boolean;
FIndicators: TImageList; // -- new;
FLineColor: TColor;
FSumColor: TColor;
FTopSumRows: Integer;
FBottomSumRows: Integer;
FSumFlag: string;
FOldValues: array[0..MaxField] of Variant;
FSumArray: array[0..MaxField] of Variant;
FEventArray: array[0..MaxField] of TFieldNotifyEvent;
FMasterQuery: TQuery;
FEventMasterScroll: TDataSetNotifyEvent;
FEventBeforeDelete: TDataSetNotifyEvent;
FEventBeforeCancel: TDataSetNotifyEvent;
FEventAfterCancel: TDataSetNotifyEvent;

// 原函数只刷新标题，增加整屏刷新
procedure WMSize(var Message: TWMSize); message WM_SIZE;
// 设置格线、统计行颜色。新增
procedure SetLineColor(clr: TColor);
procedure SetSumColor(clr: TColor);
// 计算在整个ClientHeight中,实际能以DefaultRowHeight
// 画多少个可卷动行,及最后一行的第线坐标
function MaxRowCount: Integer;
function MaxRowHeight: integer;
// 计算给定字段在COLUMNS中位置
function IndexOfColumn(fld: TField): Integer;
function IndexOfSumFlag(ACol: Integer): string;
procedure SetSumFlag(ACol: Integer; flag: string);
procedure WriteSumFlag(flag: string);
function GetSums(idx: Integer): real;
// 只是因为需要
function IsActiveControl: Boolean;
// 为减少修改程序量，直接取变量名为函数名
function FIndicatorOffset: Integer;
protected
FTitleHeight: Integer; {--------------new--------------}
FTitleLines: Integer; {--------------new--------------}
FTitleHeightFull: Integer; {new}

FMarginText:Boolean;
FVTitleMargin: Integer;
FHTitleMargin: Integer;
FUseMultiTitle: Boolean;

// 直接覆盖最TCustomGrid方法，无论任何行数量的
// 改动均强制改成满屏行
procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
// 覆盖原方法
procedure Paint;override;
procedure DrawCell(ACol, ARow: Longint;
ARect: TRect; AState: TGridDrawState); override;
procedure LayoutChanged; override;
procedure Scroll(Distance: Integer); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;

// 重新定义原始被隐藏的方法，不做修改
procedure UpdateRowCount;
procedure UpdateActive;
procedure UpdateScrollBar;
// 加载自己的编辑器，使之高度固定在DefaultRowHeigh上
function CreateEditor: TInplaceEdit; override;
// 专门针对统计的一系列方法
procedure OnFieldChange(Sender: TField);
procedure LinkActive(Value: Boolean); override;
function GetEditText(ACol, ARow: Longint): string;override;
// procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure OnMasterScroll(DataSet: TDataSet);
procedure OnBeforeDelete(DataSet: TDataSet);
procedure OnBeforeCancel(DataSet: TDataSet);
procedure OnAfterCancel(DataSet: TDataSet);
procedure CalcSum;
function FormatSum(Value: Variant; AField: TField): string;
procedure DrawSumCell(ACol: Integer);virtual;

// 多行标题
procedure ClearPainted(node:THeadTreeNode);
function SetChildTreeHeight(ANode:THeadTreeNode):Integer;
function ReadTitleHeight: Integer;
procedure WriteTitleHeight(th: Integer);
function ReadTitleLines: Integer;
procedure WriteTitleLines(tl: Integer);
procedure WriteMarginText(IsMargin:Boolean);
procedure WriteVTitleMargin(Value: Integer);
procedure WriteHTitleMargin(Value: Integer);
procedure WriteUseMultiTitle(Value:Boolean);
public
FHeadTree:THeadTreeNode;
FLeafFieldArrTLeafCol;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Sums[idx: Integer]: real read GetSums;

published
property TitleHeight : Integer read ReadTitleHeight
write WriteTitleHeight default 24;
property TitleLines : Integer read ReadTitleLines
write WriteTitleLines default 0;
property VTitleMargin: Integer read FVTitleMargin
write WriteVTitleMargin default 10;
property HTitleMargin: Integer read FHTitleMargin
write WriteHTitleMargin default 0;
property UseMultiTitle: Boolean read FUseMultiTitle
write WriteUseMultiTitle default False;
// 标准格线颜色
property LineColor: TColor read FLineColor write SetLineColor;
property SumColor: TColor read FSumColor write SetSumColor;
property SumFlag: String read FSumFlag write WriteSumFlag;
property NoAppend: boolean read FNoAppend write FNoAppend;
end;


TCharSet = Set of Char;

procedure Register;

implementation

(* $R xDBGRIDS.RES 放弃indicator位图 *)

procedure Register;
begin
RegisterComponents('Samples', [TxDBNavigator, TxDBGrid]);
end;

constructor TxDBNavigator.Create(AOwner :TComponent);
begin
inherited Create(aOwner);
Buttons[nbFirst ].Caption:='首条';
Buttons[nbPrior ].Caption:='前条';
Buttons[nbNext ].Caption:='后条';
Buttons[nbLast ].Caption:='末条';
Buttons[nbInsert ].Caption:='插入';
Buttons[nbDelete ].Caption:='删除';
Buttons[nbEdit ].Caption:='编辑';
Buttons[nbPost ].Caption:='存盘';
Buttons[nbCancel ].Caption:='放弃';
Buttons[nbRefresh].Caption:='刷新';
end;

function TxDBNavigator.ReadBtnEnabled(nb: TNavigateBtn): Boolean;
begin
Result := Buttons[nb].Enabled;
end;

procedure TxDBNavigator.SetBtnEnabled(nb: TNavigateBtn; Enabled: Boolean);
begin
DataChanged;
EditingChanged;
Buttons[nb].Enabled := (Buttons[nb].Enabled and Enabled);
end;

type
PIntArray = ^TIntArray;
TIntArray = array[0..MaxCustomExtents] of Integer;

// 为避免资源冲突，自行定义相应的行指示标位图
// 修改为放弃位图
{const
bmArrow = 'xDBGARROW';
bmEdit = 'xDBEDIT';
bmInsert = 'xDBINSERT';
bmMultiDot = 'xDBMULTIDOT';
bmMultiArrow = 'xDBMULTIARROW';}

var
DrawBitmap: TBitmap;
UserCount: Integer;

procedure UsesBitmap;
begin
if UserCount = 0 then
DrawBitmap := TBitmap.Create;
Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
Dec(UserCount);
if UserCount = 0 then DrawBitmap.Free;
end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment; ARightToLeft: Boolean);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
var
B, R: TRect;
Hold, Left: Integer;
I: TColorRef;
begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOut for solid colors }
{ In BiDi, because we changed the window origin, the text that does not
change alignment, actually gets its alignment changed. }
if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
ChangeBiDiModeAlignment(Alignment);
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ACanvas.TextRect(ARect, Left, ARect.Top + DY, Text);
end
else begin { Use FillRect and Drawtext for dithered colors }
DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
if (ACanvas.CanvasOrientation = coRightToLeft) then
ChangeBiDiModeAlignment(Alignment);
DrawText(Handle, PChar(Text), Length(Text), R,
AlignFlags[Alignment] or RTL[ARightToLeft]);
end;
if (ACanvas.CanvasOrientation = coRightToLeft) then
begin
Hold := ARect.Left;
ARect.Left := ARect.Right;
ARect.Right := Hold;
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;
end;
end;

////////
///{strUtils}
////////

function WordPosition(const N: Integer; const S: string; WordDelims: TCharSet): Integer;
var
Count, I: Integer;
begin
Count := 0;
I := 1;
Result := 0;
while (I <= Length(S)) and (Count <> N) do begin
{ skip over delimiters }
while (I <= Length(S)) and (S in WordDelims) do Inc(I);
{ if we're not beyond end of S, we're at the start of a word }
if I <= Length(S) then Inc(Count);
{ if not finished, find the end of the current word }
if Count <> N then
while (I <= Length(S)) and not (S in WordDelims) do Inc(I)
else Result := I;
end;
end;

function ExtractWord(N: Integer; const S: string; WordDelims: TCharSet): string;
var
I: Word;
Len: Integer;
begin
Len := 0;
I := WordPosition(N, S, WordDelims);
if I <> 0 then
{ find the end of the current word }
while (I <= Length(S)) and not(S in WordDelims) do begin
{ add the I'th character to result }
Inc(Len);
SetLength(Result, Len);
Result[Len] := S;
Inc(I);
end;
SetLength(Result, Len);
end;

function ExtractWordPos(N: Integer; const S: string; WordDelims: TCharSet;
var Pos: Integer): string;
var
I, Len: Integer;
begin
Len := 0;
I := WordPosition(N, S, WordDelims);
Pos := I;
if I <> 0 then
{ find the end of the current word }
while (I <= Length(S)) and not(S in WordDelims) do begin
{ add the I'th character to result }
Inc(Len);
SetLength(Result, Len);
Result[Len] := S;
Inc(I);
end;
SetLength(Result, Len);
end;

{ WriteTextEH }
procedure WriteTextEH(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment; MultyL: Boolean; LeftMarg:Integer);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
var
r, rect1: TRect;
I: Word;
Left, txth: Integer;
lpDTP : TDrawTextParams;

begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOut for solid colors }
if (MultyL = false) then begin
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
end
else begin {}{/////////// MultyL}
// 增加自动绘制边框功能
r:=ARect;
ACanvas.FillRect(ARect);
InflateRect(r,1,1);
ACanvas.Rectangle(r.left,r.top,r.right,r.bottom);

rect1.Left := 0; rect1.Top := 0; rect1.Right := 0; rect1.Bottom := 0;
rect1 := ARect; {}

lpDTP.cbSize := SizeOf(lpDTP);
lpDTP.uiLengthDrawn := Length(Text);
lpDTP.iLeftMargin := LeftMarg;
lpDTP.iRightMargin := 0;

InflateRect(rect1, -DX, -DY);

txth := DrawTextEx(ACanvas.Handle,PChar(Text), Length(Text), {}
rect1, DT_WORDBREAK or DT_CALCRECT,@lpDTP);

rect1 := ARect; {}
InflateRect(rect1, -DX, -DY);

rect1.top := rect1.top + ((rect1.Bottom-rect1.top) div 2) - (txth div 2);
DrawTextEx(ACanvas.Handle,PChar(Text), Length(Text), {}
rect1, AlignFlags[Alignment],@lpDTP); {}
end; {}
end
else begin { Use FillRect and Drawtext for dithered colors }
(* DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
if (ACanvas.CanvasOrientation = coRightToLeft) then
ChangeBiDiModeAlignment(Alignment);
DrawText(Handle, PChar(Text), Length(Text), R,
AlignFlags[Alignment] or RTL[ARightToLeft]);
end;
if (ACanvas.CanvasOrientation = coRightToLeft) then
begin
Hold := ARect.Left;
ARect.Left := ARect.Right;
ARect.Right := Hold;
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;*)
end;
end;

{ TxDBGridInplaceEdit }

{ 由于TDBGridInplaceEdit在dbGrids原文件中并未将其作为接口声明
所以只能照抄，然后简单覆盖其关键的客户区域设置函数，令其高度
为DefaultRowHeight高。
已知的BUG：内容超宽时，或编辑状态的横滚，引起的刷新会导致整
个单元格的重绘，原因不明。}

procedure KillMessage(Wnd: HWnd; Msg: Integer);
// Delete the requested message from the queue, but throw back
// any WM_QUIT msgs that PeekMessage may also return
var
M: TMsg;
begin
M.Message := 0;
if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
PostQuitMessage(M.wparam);
end;

type

TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
TPopupListbox = class;

TDBGridInplaceEdit = class(TInplaceEdit)
private
FButtonWidth: Integer;
FDataList: TDBLookupListBox;
FPickList: TPopupListbox;
FActiveList: TWinControl;
FLookupSource: TDatasource;
FEditStyle: TEditStyle;
FListVisible: Boolean;
FTracking: Boolean;
FPressed: Boolean;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetEditStyle(Value: TEditStyle);
procedure StopTracking;
procedure TrackButton(X,Y: Integer);
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
procedure WMPaint(var Message: TWMPaint); message wm_Paint;
procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
function OverButton(const P: TPoint): Boolean;
function ButtonRect: TRect;
protected
procedure BoundsChanged; override;
procedure CloseUp(Accept: Boolean);
procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
procedure DropDown;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure PaintWindow(DC: HDC); override;
procedure UpdateContents; override;
procedure WndProc(var Message: TMessage); override;
property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
property ActiveList: TWinControl read FActiveList write FActiveList;
property DataList: TDBLookupListBox read FDataList;
property PickList: TPopupListbox read FPickList;
public
constructor Create(Owner: TComponent); override;
end;

{ TPopupListbox }

TPopupListbox = class(TCustomListbox)
private
FSearchText: String;
FSearchTickCount: Longint;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure KeyPress(var Key: Char); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
end;

procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
AddBiDiModeExStyle(ExStyle);
WindowClass.Style := CS_SAVEBITS;
end;
end;

procedure TPopupListbox.CreateWnd;
begin
inherited CreateWnd;
Windows.SetParent(Handle, 0);
CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

procedure TPopupListbox.Keypress(var Key: Char);
var
TickCount: Integer;
begin
case Key of
#8, #27: FSearchText := '';
#32..#255:
begin
TickCount := GetTickCount;
if TickCount - FSearchTickCount > 2000 then FSearchText := '';
FSearchTickCount := TickCount;
if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
Key := #0;
end;
end;
inherited Keypress(Key);
end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
TDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
(X < Width) and (Y < Height));
end;


constructor TDBGridInplaceEdit.Create(Owner: TComponent);
begin
inherited Create(Owner);
FLookupSource := TDataSource.Create(Self);
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
FEditStyle := esSimple;
end;

procedure TDBGridInplaceEdit.BoundsChanged;
var
R: TRect;
begin
SetRect(R, 2, 2, Width - 2, Height);
if FEditStyle <> esSimple then
if not TCustomDBGrid(Owner).UseRightToLeftAlignment then
Dec(R.Right, FButtonWidth)
else
Inc(R.Left, FButtonWidth - 2);
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
if SysLocale.FarEast then
SetImeCompositionWindow(Font, R.Left, R.Top);
end;

procedure TDBGridInplaceEdit.CloseUp(Accept: Boolean);
var
MasterField: TField;
ListValue: Variant;
begin
if FListVisible then
begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
if FActiveList = FDataList then
ListValue := FDataList.KeyValue
else
if FPickList.ItemIndex <> -1 then
ListValue := FPickList.Items[FPicklist.ItemIndex];
SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FListVisible := False;
if Assigned(FDataList) then
FDataList.ListSource := nil;
FLookupSource.Dataset := nil;
Invalidate;
if Accept then
if FActiveList = FDataList then
with TxDBGrid(Grid), Columns[SelectedIndex].Field do
begin
MasterField := DataSet.FieldByName(KeyFields);
if MasterField.CanModify then
begin
DataSet.Edit;
MasterField.Value := ListValue;
end;
end
else
if (not VarIsNull(ListValue)) and EditCanModify then
with TxDBGrid(Grid), Columns[SelectedIndex].Field do
Text := ListValue;
end;
end;

procedure TDBGridInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_UP, VK_DOWN:
if ssAlt in Shift then
begin
if FListVisible then CloseUp(True) else DropDown;
Key := 0;
end;
VK_RETURN, VK_ESCAPE:
if FListVisible and not (ssAlt in Shift) then
begin
CloseUp(Key = VK_RETURN);
Key := 0;
end;
end;
end;

procedure TDBGridInplaceEdit.DropDown;
var
P: TPoint;
I,J,Y: Integer;
Column: TColumn;
begin
if not FListVisible and Assigned(FActiveList) then
begin
FActiveList.Width := Width;
with TxDBGrid(Grid) do
Column := Columns[SelectedIndex];
if FActiveList = FDataList then
with Column.Field do
begin
FDataList.Color := Color;
FDataList.Font := Font;
FDataList.RowCount := Column.DropDownRows;
FLookupSource.DataSet := LookupDataSet;
FDataList.KeyField := LookupKeyFields;
FDataList.ListField := LookupResultField;
FDataList.ListSource := FLookupSource;
FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
{ J := Column.DefaultWidth;
if J > FDataList.ClientWidth then
FDataList.ClientWidth := J;
} end
else
begin
FPickList.Color := Color;
FPickList.Font := Font;
FPickList.Items := Column.Picklist;
if FPickList.Items.Count >= Integer(Column.DropDownRows) then
FPickList.Height := Integer(Column.DropDownRows) * FPickList.ItemHeight + 4
else
FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
if Column.Field.IsNull then
FPickList.ItemIndex := -1
else
FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Text);
J := FPickList.ClientWidth;
for I := 0 to FPickList.Items.Count - 1 do
begin
Y := FPickList.Canvas.TextWidth(FPickList.Items);
if Y > J then J := Y;
end;
FPickList.ClientWidth := J;
end;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FListVisible := True;
Invalidate;
Windows.SetFocus(Handle);
end;
end;

type
TWinControlCracker = class(TWinControl) end;

procedure TDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
begin
TxDBGrid(Grid).EditButtonClick;
KillMessage(Handle, WM_CHAR);
end
else
inherited KeyDown(Key, Shift);
end;

procedure TDBGridInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
end;

procedure TDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if (Button = mbLeft) and (FEditStyle <> esSimple) and
OverButton(Point(X,Y)) then
begin
if FListVisible then
CloseUp(False)
else
begin
MouseCapture := True;
FTracking := True;
TrackButton(X, Y);
if Assigned(FActiveList) then
DropDown;
end;
end;
inherited MouseDown(Button, Shift, X, Y);
end;

procedure TDBGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ListPos: TPoint;
MousePos: TSmallPoint;
begin
if FTracking then
begin
TrackButton(X, Y);
if FListVisible then
begin
ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
if PtInRect(FActiveList.ClientRect, ListPos) then
begin
StopTracking;
MousePos := PointToSmallPoint(ListPos);
SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
Exit;
end;
end;
end;
inherited MouseMove(Shift, X, Y);
end;

procedure TDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
WasPressed: Boolean;
begin
WasPressed := FPressed;
StopTracking;
if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
TxDBGrid(Grid).EditButtonClick;
inherited MouseUp(Button, Shift, X, Y);
end;

procedure TDBGridInplaceEdit.PaintWindow(DC: HDC);
var
R: TRect;
Flags: Integer;
W, X, Y: Integer;
begin
if FEditStyle <> esSimple then
begin
R := ButtonRect;
Flags := 0;
if FEditStyle in [esDataList, esPickList] then
begin
if FActiveList = nil then
Flags := DFCS_INACTIVE
else if FPressed then
Flags := DFCS_FLAT or DFCS_PUSHED;
DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
end
else { esEllipsis }
begin
if FPressed then Flags := BF_FLAT;
DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
X := R.Left + ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
Y := R.Top + ((R.Bottom - R.Top) shr 1) - 1 + Ord(FPressed);
W := FButtonWidth shr 3;
if W = 0 then W := 1;
PatBlt(DC, X, Y, W, W, BLACKNESS);
PatBlt(DC, X - (W * 2), Y, W, W, BLACKNESS);
PatBlt(DC, X + (W * 2), Y, W, W, BLACKNESS);
end;
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
inherited PaintWindow(DC);
end;

procedure TDBGridInplaceEdit.SetEditStyle(Value: TEditStyle);
begin
if Value = FEditStyle then Exit;
FEditStyle := Value;
case Value of
esPickList:
begin
if FPickList = nil then
begin
FPickList := TPopupListbox.Create(Self);
FPickList.Visible := False;
FPickList.Parent := Self;
FPickList.OnMouseUp := ListMouseUp;
FPickList.IntegralHeight := True;
FPickList.ItemHeight := 11;
end;
FActiveList := FPickList;
end;
esDataList:
begin
if FDataList = nil then
begin
FDataList := TPopupDataList.Create(Self);
FDataList.Visible := False;
FDataList.Parent := Self;
FDataList.OnMouseUp := ListMouseUp;
end;
FActiveList := FDataList;
end;
else { cbsNone, cbsEllipsis, or read only field }
FActiveList := nil;
end;
with TxDBGrid(Grid) do
Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
Repaint;
end;

procedure TDBGridInplaceEdit.StopTracking;
begin
if FTracking then
begin
TrackButton(-1, -1);
FTracking := False;
MouseCapture := False;
end;
end;

procedure TDBGridInplaceEdit.TrackButton(X,Y: Integer);
var
NewState: Boolean;
R: TRect;
begin
R := ButtonRect;
NewState := PtInRect(R, Point(X, Y));
if FPressed <> NewState then
begin
FPressed := NewState;
InvalidateRect(Handle, @R, False);
end;
end;

procedure TDBGridInplaceEdit.UpdateContents;
var
Column: TColumn;
NewStyle: TEditStyle;
MasterField: TField;
begin
with TxDBGrid(Grid) do begin
if (SelectedIndex<0) or (SelectedIndex>=Columns.Count) then exit;
Column := Columns[SelectedIndex];
end;
NewStyle := esSimple;
case Column.ButtonStyle of
cbsEllipsis: NewStyle := esEllipsis;
cbsAuto:
if Assigned(Column.Field) then
with Column.Field do
begin
{ Show the dropdown button only if the field is editable }
if FieldKind = fkLookup then
begin
MasterField := Dataset.FieldByName(KeyFields);
{ Column.DefaultReadonly will always be True for a lookup field.
Test if Column.ReadOnly has been assigned a value of True }
if Assigned(MasterField) and MasterField.CanModify and
not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
with TxDBGrid(Grid) do
if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
NewStyle := esDataList
end
else
if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
not Column.Readonly then
NewStyle := esPickList
else if DataType in [ftDataset, ftReference] then
NewStyle := esEllipsis;
end;
end;
EditStyle := NewStyle;
inherited UpdateContents;
Font.Assign(Column.Font);
end;

procedure TDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
CloseUp(False);
end;

procedure TDBGridInplaceEdit.WMCancelMode(var Message: TMessage);
begin
StopTracking;
inherited;
end;

procedure TDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
begin
if not SysLocale.FarEast then inherited
else
begin
ImeName := Screen.DefaultIme;
ImeMode := imDontCare;
inherited;
if HWND(Message.WParam) <> TCustomDBGrid(Grid).Handle then
ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
end;
CloseUp(False);
end;

function TDBGridInplaceEdit.ButtonRect: TRect;
begin
if not TCustomDBGrid(Owner).UseRightToLeftAlignment then
Result := Rect(Width - FButtonWidth, 0, Width, Height)
else
Result := Rect(0, 0, FButtonWidth, Height);
end;

function TDBGridInplaceEdit.OverButton(const P: TPoint): Boolean;
begin
Result := PtInRect(ButtonRect, P);
end;

procedure TDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
with Message do
if (FEditStyle <> esSimple) and OverButton(Point(XPos, YPos)) then
Exit;
inherited;
end;

procedure TDBGridInplaceEdit.WMPaint(var Message: TWMPaint);
begin
PaintHandler(Message);
end;

procedure TDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
var
P: TPoint;
begin
GetCursorPos(P);
P := ScreenToClient(P);
if (FEditStyle <> esSimple) and OverButton(P) then
Windows.SetCursor(LoadCursor(0, idc_Arrow))
else
inherited;
end;

procedure TDBGridInplaceEdit.WndProc(var Message: TMessage);
begin
case Message.Msg of
wm_KeyDown, wm_SysKeyDown, wm_Char:
if EditStyle in [esPickList, esDataList] then
with TWMKey(Message) do
begin
DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
if (CharCode <> 0) and FListVisible then
begin
with TMessage(Message) do
SendMessage(FActiveList.Handle, Msg, WParam, LParam);
Exit;
end;
end
end;
inherited;
end;

{ TxDBGridInplaceEdit }
type

TxDBGridInplaceEdit = class(TDBGridInplaceEdit)
protected
procedure BoundsChanged; override;
end;

procedure TxDBGridInplaceEdit.BoundsChanged;
var
DefHeight: Integer;
begin
with TxDBGrid(Grid) do begin
DefHeight:=DefaultRowHeight;
end;
Invalidate;
// 强行改变编辑器窗口大小。
if Height>DefHeight then begin
SetWindowPos(Handle, HWND_TOP, Left, Top, Width, DefHeight,
SWP_SHOWWINDOW or SWP_NOREDRAW);
end;
inherited;
end;

{ THeadTreeNode }

constructor THeadTreeNode.Create;
begin
Child := Nil; Next := Self; Host := nil;
end;

constructor THeadTreeNode.CreateText(AText:String;AHeight,AWidth:Integer);
begin
Create;
Text := AText; Height := AHeight; Width := AWidth;
end;

destructor THeadTreeNode.Destroy;
begin
inherited;
if (Host = nil) then begin
FreeAllChild;
end;
end;

function THeadTreeNode.Add(AAfter:THeadTreeNode;AText:String;AHeight,AWidth:Integer):THeadTreeNode ;
var htLast,{htSelf,}th:THeadTreeNode;
begin
if(Find(AAfter) = false) then
raise Exception.Create('Node not in Tree');
htLast := AAfter.Next;
// while AAfter <> htLast.Next do htLast := htLast.Next; // 萨桁 镱耠邃龛?
th := THeadTreeNode.CreateText(AText,AHeight,AWidth);
th.Host := AAfter.Host;
AAfter.Next := th;
th.Next := htLast;
Result := th;
end;

function THeadTreeNode.AddChild(ANode:THeadTreeNode;
AText:String;AHeight,AWidth:Integer):THeadTreeNode ;
var
htLast,th:THeadTreeNode;
begin
if(Find(ANode) = false) then raise Exception.Create('Node not in Tree');

if(ANode.Child = nil) then begin
th := THeadTreeNode.CreateText(AText,AHeight,AWidth);
th.Host := ANode;
ANode.Child := th;
end else begin
htLast := ANode.Child;
while ANode.Child <> htLast.Next do htLast := htLast.Next;
th := THeadTreeNode.CreateText(AText,AHeight,AWidth);
th.Host := ANode;
htLast.Next := th;
th.Next := ANode.Child;
end;
Result := th;
end;

procedure THeadTreeNode.FreeAllChild;
var
htLast,htm:THeadTreeNode;
begin
if(Child = nil) then Exit;
htLast := Child;

while true do begin
htLast.FreeAllChild;
if(Child = htLast.Next) then begin htLast.Free; break; end;
htm := htLast;
htLast := htLast.Next;
htm.Free;
end;
Child := nil;
end;



function THeadTreeNode.Find(ANode:THeadTreeNode):Boolean;
var
htLast:THeadTreeNode;
begin
Result := false;
// if(Child = nil) then Exit;
htLast := Self;

while true do begin
if(htLast = ANode) then begin Result := true; break; end;
if(htLast.Child <> nil) and (htLast.Child.Find(ANode) = true) then begin Result := true; break; end;
if(Self = htLast.Next) then begin Result := false; break; end;
htLast := htLast.Next;
end;
end;

procedure THeadTreeNode.Union(AFrom,ATo :THeadTreeNode; AText:String;AHeight:Integer);
var th, tUn, TBeforFrom:THeadTreeNode;
toFinded :Boolean;
wid:Integer;
begin
if(Find(AFrom) = false) then raise Exception.Create('Node not in Tree');
toFinded := True;
if (AFrom <> ATo) then begin //new
th := AFrom; toFinded := false;
while AFrom.HOst.Child <> th.Next do begin
if(th.Next = ATo) then begin toFinded := true; break; end;
th := th.Next;
end;
end;

if(toFinded = false) then raise Exception.Create('ATo not in level');

tUn := ATo.Add(ATo,AText,AHeight,0);
TBeforFrom := AFrom.Host.Child;
while TBeforFrom.Next <> AFrom do TBeforFrom := TBeforFrom.Next;

TBeforFrom.Next := tUn;

th := AFrom; tUn.Child := AFrom;
if(th = AFrom.Host.Child) then AFrom.Host.Child := tUn;
Wid := 0;
while th <> ATo.Next do begin
Inc(Wid,th.Width);
Inc(Wid,1);
Dec(th.Height,AHeight);
th.Host := TUn;
th := th.Next;
end;
Dec(Wid,1);
ATo.Next := AFrom;
tUn.Width := Wid;
end;

{ CreateFieldTree }
procedure THeadTreeNode.CreateFieldTree(AGrid:TxDBGrid);
var i,pos,j:Integer;
node,nodeFrom,nodeTo:THeadTreeNode;
ss,ss1:String;
sameWord,GroupDid :Boolean;
begin

FreeAllChild;

for i := 0 to AGrid.Columns.Count - 1 do begin
if(Assigned(AGrid.Columns.Field)) then
node := AddChild(Self,AGrid.Columns.Field.DisplayLabel,
AGrid.RowHeights[0],
AGrid.Columns.Width)
else node := AddChild(Self,'',
AGrid.RowHeights[0]
,AGrid.Columns.Width);
AGrid.FLeafFieldArr.FLeaf := node;

end;

sameWord := false;
while True do begin//for k := 0 to ListNodeField.Count - 1 do begin
GroupDid := false;
for i := 0 to AGrid.Columns.Count - 1 do begin
ss1 := ExtractWordPos(2,AGrid.FLeafFieldArr.FLeaf.Text,['|'],pos);
if( ss1 <> '' ) then begin
ss1 := ExtractWord(1,AGrid.FLeafFieldArr.FLeaf.Text,['|']);
nodeFrom := AGrid.FLeafFieldArr.FLeaf;
// sameWord := false;
sameWord := True;
for j := i to AGrid.Columns.Count - 1 do begin
if (AGrid.Columns.Count - 1 > j) and
(ExtractWord(1,AGrid.FLeafFieldArr[j+1].FLeaf.Text,['|']) = ss1) then begin
ss := AGrid.FLeafFieldArr[j].FLeaf.Text;
Delete(ss,1,pos-1);
AGrid.FLeafFieldArr[j].FLeaf.Text := ss;
sameWord := true;
GroupDid := true;
end else begin
if (sameWord) then begin
ss := AGrid.FLeafFieldArr[j].FLeaf.Text;
Delete(ss,1,pos-1);
// TLeafField(ListNodeField.Items[j]).Field.DisplayLabel := ss;
AGrid.FLeafFieldArr[j].FLeaf.Text := ss;
nodeTo := AGrid.FLeafFieldArr[j].FLeaf;
GroupDid := true;
end;
break;
end;
end;
if(sameWord) then begin
Union(nodeFrom,nodeTo,ss1,20);
break;
end;
end; //if
end; //i
if(GroupDid = false) then break;
end; //k

end;

procedure THeadTreeNode.DoForAllNode(proc:THeadTreeProc);
var htLast:THeadTreeNode;
begin
if(Child = nil) then Exit;
htLast := Child;
while true do begin
proc(htLast);
if(htLast.Child <> nil ) then htLast.DoForAllNode(proc);
if(Child = htLast.Next) then begin break; end;
htLast := htLast.Next;
end;
end;

{ TxDBGrid }

constructor TxDBGrid.Create(AOwner: TComponent);
var
Bmp: TBitmap;
begin
UsesBitmap;
inherited Create(AOwner);
Bmp := TBitmap.Create;
try
// Bmp.LoadFromResourceName(HInstance, bmArrow);
FIndicators := TImageList.CreateSize(6, 11); //Bmp.Width, Bmp.Height);
{ FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmEdit);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmInsert);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmMultiDot);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmMultiArrow);
FIndicators.AddMasked(Bmp, clWhite);}
finally
Bmp.Free;
end;

FTitleHeight := 24; {new}
FTitleHeightFull := 24;
FTitleLines := 0;
FLeafFieldArr := nil;
FHeadTree := THeadTreeNode.CreateText('xTitle',10,0);
FVTitleMargin := 10;
FHTitleMargin := 0;
FUseMultiTitle := False;

// 为新特性所增变量
FTitleOffset := 1;
// FIndicatorOffset:=1;
FTopSumRows := 1;
FSumFlag := '';
FBottomSumRows := 0;
FLineColor := clBlack;
FSumColor := clInfoBk;
RowCount := 5;
FMasterQuery:=nil;
end;

destructor TxDBGrid.Destroy;
var
i: Integer;
f: TDataSetNotifyEvent;
f1: TFieldNotifyEvent;
begin
if Assigned(FMasterQuery) and (FMasterQuery.DataSource<>nil) then begin
f:=OnMasterScroll;
if (Assigned(FEventMasterScroll)) and (@f<>@FEventMasterScroll) then
FMasterQuery.DataSource.DataSet.AfterScroll:=FEventMasterScroll
else
FMasterQuery.DataSource.DataSet.AfterScroll:=nil;
end;
FMasterQuery:=nil;
FEventMasterScroll:=nil; // 专为处理主从表

for i:=0 to Columns.Count-1 do begin
if (Columns.Field<>nil) then begin
f1:=OnFieldChange;
if (Assigned(FEventArray)) and (@f1<>@FEventArray) then
Columns.Field.OnChange:=FEventArray
else
Columns.Field.OnChange:=nil;
end;
FEventArray:=nil;
FSumArray:=0;
FOldValues:=0;
end;

inherited;
if(FLeafFieldArr <> nil) then FreeMem(FLeafFieldArr);
FHeadTree.Free;
ReleaseBitmap;
end;

procedure TxDBGrid.LayoutChanged;
var
tm: TTEXTMETRIC;
K,J,I: Integer;
AFont:TFont;
begin
inherited;
// if not AcquireLayoutLock then Exit;
if({(RowHeights[0] <> FTitleHeightFull) and }(dgTitles in Options)) then begin
K := 0;
for I := 0 to Columns.Count-1 do
begin
Canvas.Font := Columns.Title.Font;
J := Canvas.TextHeight('Wg') + 4;
if J > K then begin K := J; GetTextMetrics(Canvas.Handle, tm); end;
end;
if K = 0 then
begin
Canvas.Font := TitleFont;
GetTextMetrics(Canvas.Handle, tm);
end;

FTitleHeightFull := tm.tmExternalLeading + tm.tmHeight*FTitleLines+2 +
FTitleHeight;
if dgRowLines in Options then
FTitleHeightFull := FTitleHeightFull + 1;
RowHeights[0] := FTitleHeightFull;
if(UseMultiTitle = true) then begin
ReallocMem(FLeafFieldArr,SizeOf(LeafCol)*Columns.Count);
AFont := Canvas.Font;
Canvas.Font := TitleFont;
for i := 0 to Columns.Count - 1 do
FLeafFieldArr.FColumn := Columns;
FHeadTree.CreateFieldTree(Self);
RowHeights[0] := SetChildTreeHeight(FHeadTree) -2;// 1;
Canvas.Font := AFont;
end;
// 新增，首先将RowCount设为满屏，并将末行设为二倍高
UpdateRowCount;
Invalidate;
end;
end;

function TxDBGrid.MaxRowCount: integer;
var
CHeight, LineWidth, h, i: Integer;
begin
// if (not HandleAllocated)
// or (csLoading in ComponentState) then
CHeight:=Height
// else
// CHeight:=ClientHeight
;
if dgRowLines in Options then LineWidth:=1 else LineWidth:=0;
h:=RowHeights[0]+LineWidth;
i:=0;
while h+DefaultRowHeight+LineWidth-10<CHeight do begin
Inc(h, DefaultRowheight+LineWidth);
Inc(i);
end;
Result:=i;
end;

function TxDBGrid.MaxRowHeight: integer;
var
CHeight, LineWidth, h: Integer;
begin
// if (not HandleAllocated)
// or (csLoading in ComponentState) then
CHeight:=Height
// else
// CHeight:=ClientHeight
;
if dgRowLines in Options then LineWidth:=1 else LineWidth:=0;
h:=RowHeights[0]+LineWidth;
// i:=0;
while h+DefaultRowHeight+LineWidth<CHeight do begin
Inc(h, DefaultRowheight+LineWidth);
// Inc(i);
end;
Result:=h-2;
end;

function TxDBGrid.ReadTitleHeight: Integer;
begin
Result := FTitleHeight;
end;

procedure TxDBGrid.WriteTitleHeight(th: Integer); {WriteTitleHeight}
begin
FTitleHeight := th;
LayoutChanged;
end;

function TxDBGrid.ReadTitleLines: Integer;
begin
Result := FTitleLines;
end;

procedure TxDBGrid.WriteTitleLines(tl: Integer); {WriteTitleLines}
begin
FTitleLines := tl;
LayoutChanged;
end;

procedure TxDBGrid.ClearPainted(node:THeadTreeNode); //new
begin
node.Drawed := false;
end;

procedure TxDBGrid.WriteMarginText(IsMargin:Boolean);
begin
if(IsMargin <> FMarginText) then begin
FMarginText := IsMargin;
LayoutChanged;
end;
end;

procedure TxDBGrid.WriteVTitleMargin(Value: Integer);
begin
FVTitleMargin := Value;
LayoutChanged;
end;

procedure TxDBGrid.WriteHTitleMargin(Value: Integer);
begin
FHTitleMargin := Value;
LayoutChanged;
end;

procedure TxDBGrid.WriteUseMultiTitle(Value:Boolean);
begin
FUseMultiTitle := Value;
LayoutChanged;
end;

function TxDBGrid.SetChildTreeHeight(ANode:THeadTreeNode):Integer;
var htLast:THeadTreeNode;
newh,maxh,th :Integer;
rec:TRect;
DefaultRowHeight : Integer;
begin
DefaultRowHeight := 0;
Result := 0;
if(ANode.Child = nil) then Exit;
htLast := ANode.Child;
maxh := 0;
if(htLast.Child <> nil) then
maxh := SetChildTreeHeight(htLast);

rec := Rect(0,0,htLast.Width-4,DefaultRowHeight);
th := DrawText(Canvas.Handle,PChar(htLast.Text),
Length(htLast.Text), rec, DT_WORDBREAK or DT_CALCRECT);
if (th > DefaultRowHeight) then maxh := maxh + th + FVTitleMargin
else maxh := maxh + DefaultRowHeight;

while true do begin
if(ANode.Child = htLast.Next) then begin break; end;
htLast := htLast.Next;
newh := 0;
if(htLast.Child <> nil) then
newh := SetChildTreeHeight(htLast);
rec := Rect(0,0,htLast.Width-4,DefaultRowHeight);
th := DrawText(Canvas.Handle,PChar(htLast.Text),
Length(htLast.Text), rec, DT_WORDBREAK or DT_CALCRECT);
if (th > DefaultRowHeight) then newh := newh + th + FVTitleMargin
else newh := newh + DefaultRowHeight;

if(maxh < newh) then maxh := newh;
end;

htLast := ANode.Child;
while ANode.Child <> htLast.Next do begin
if(htLast.Child = nil) then htLast.Height := maxh
else htLast.Height := maxh - htLast.Height;
htLast := htLast.Next;
end;
if(htLast.Child = nil) then htLast.Height := maxh
else htLast.Height := maxh - htLast.Height;

ANode.Height := maxh;
Result := maxh;
end;

procedure TxDBGrid.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;

procedure TxDBGrid.SetLineColor(clr: TColor);
begin
if FLineColor<>clr then begin
FLineColor:=clr;
Invalidate;
end;
end;

procedure TxDBGrid.SetSumColor(clr: TColor);
begin
if FSumColor<>clr then begin
FSumColor:=clr;
Invalidate;
end;
end;

procedure TxDBGrid.Scroll(Distance: Integer);
var
OldRect, NewRect: TRect;
RowHeight: Integer;
begin
if FBottomSumRows<=0 then begin
inherited Scroll(Distance);
exit;
end;
if not HandleAllocated then Exit;
OldRect := BoxRect(0, Row, ColCount - 1, Row);
if (DataLink.ActiveRecord >= RowCount - FTitleOffset) then
// or (RowCount<MaxRowCount+FTitleOffset) then
UpdateRowCount{LayoutChanged};
UpdateScrollBar;
UpdateActive;
NewRect := BoxRect(0, Row, ColCount - 1, Row);
ValidateRect(Handle, @OldRect);
InvalidateRect(Handle, @OldRect, False);
InvalidateRect(Handle, @NewRect, False);
if Distance <> 0 then
begin
HideEditor;
try
if Abs(Distance) > VisibleRowCount then
begin
Invalidate;
Exit;
end
else
begin
// 目的：使向上屏幕卷动时，底行不残留原先的行
RowHeight := DefaultRowHeight;
if dgRowLines in Options then Inc(RowHeight, GridLineWidth);
// 刷新当前记录行
if dgIndicator in Options then
begin
OldRect := BoxRect(0, FSelRow, ColCount - 1, FSelRow);
InvalidateRect(Handle, @OldRect, False);
end;
// 刷新正文
// 卷动屏幕时，令裁剪矩形空出底层一行
NewRect := BoxRect(0, FTitleOffset, ColCount - 1, {VisibleRowCount}1000);
Dec(NewRect.Bottom, RowHeight*FBottomSumRows);
ScrollWindowEx(Handle, 0, -RowHeight * Distance, @NewRect, @NewRect,
0, nil, SW_Invalidate);
if dgIndicator in Options then
begin
NewRect := BoxRect(0, Row, ColCount - 1, Row);
InvalidateRect(Handle, @NewRect, False);
end;
end;
finally
if dgAlwaysShowEditor in Options then ShowEditor;
end;
end;
if UpdateLock = 0 then Update;
end;

procedure TxDBGrid.UpdateRowCount;
var
OldRowCount: Integer;
begin
OldRowCount := RowCount;
if FBottomSumRows>0 then begin
if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
FixedRows := FTitleOffset;
with DataLink do
if (not Active or (RecordCount = 0) or not HandleAllocated) then
RowCount:=MaxRowCount-1+FTitleOffset
else begin
RowCount := 100;
DataLink.BufferCount := MaxRowCount-1 {VisibleRowCount};
RowCount := {RecordCount} MaxRowCount-1 + FTitleOffset;
if dgRowSelect in Options then TopRow := FixedRows;
UpdateActive;
end;
end
else begin
if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
FixedRows := FTitleOffset;
with DataLink do
if (not Active or (RecordCount = 0) or not HandleAllocated) then
RowCount:=FTitleOffset+{MaxRowCount}VisibleRowCount
else begin
RowCount := 100;
DataLink.BufferCount := {MaxRowCount}VisibleRowCount;
RowCount := FTitleOffset+ RecordCount;
if dgRowSelect in Options then TopRow := FixedRows;
UpdateActive;
end;
end;
if OldRowCount <> RowCount then Invalidate;
end;

procedure TxDBGrid.UpdateScrollBar;
var
SIOld, SINew: TScrollInfo;
begin
if Datalink.Active and HandleAllocated then
with Datalink.DataSet do
begin
SIOld.cbSize := sizeof(SIOld);
SIOld.fMask := SIF_ALL;
GetScrollInfo(Self.Handle, SB_VERT, SIOld);
SINew := SIOld;
if IsSequenced then
begin
SINew.nMin := 1;
SINew.nPage := Self.VisibleRowCount;
SINew.nMax := Integer(DWORD(RecordCount) + SINew.nPage - 1);
if State in [dsInactive, dsBrowse, dsEdit] then
SINew.nPos := RecNo; // else keep old pos
end
else
begin
SINew.nMin := 0;
SINew.nPage := 0;
SINew.nMax := 4;
if DataLink.BOF then SINew.nPos := 0
else if DataLink.EOF then SINew.nPos := 4
else SINew.nPos := 2;
end;
if (SINew.nMin <> SIOld.nMin) or (SINew.nMax <> SIOld.nMax) or
(SINew.nPage <> SIOld.nPage) or (SINew.nPos <> SIOld.nPos) then
SetScrollInfo(Self.Handle, SB_VERT, SINew, True);
end;
end;

procedure TxDBGrid.UpdateActive;
var
NewRow: Integer;
Field: TField;
begin
if Datalink.Active and HandleAllocated and not (csLoading in ComponentState) then
begin
NewRow := Datalink.ActiveRecord + FTitleOffset;
if Row <> NewRow then
begin
if not (dgAlwaysShowEditor in Options) then HideEditor;
MoveColRow(Col, NewRow, False, False);
InvalidateEditor;
end;
Field := SelectedField;
if Assigned(Field) {and (Field.Text <> FEditText)} then
InvalidateEditor;
end;
end;

{ 单元格绘制，关键改动 }
procedure TxDBGrid.DrawCell(ACol, ARow: Longint; ARect:
TRect; AState: TGridDrawState);
var
FrameOffs: Byte;

function RowIsMultiSelected: Boolean;
var
Index: Integer;
begin
Result := (dgMultiSelect in Options) and Datalink.Active and
SelectedRows.Find(Datalink.Datasource.Dataset.Bookmark, Index);
end;

procedure DrawHost(ALeaf:THeadTreeNode; DHRect:TRect);
var
curLeaf: THeadTreeNode;
curW:Integer;
leftM:Integer;
drawRec:TRect;
begin
DHRect.Bottom := DHRect.Top-1;
Dec(DHRect.Top,ALeaf.Host.Height);

curLeaf := ALeaf.Host.Child;
curW := 0;
while curLeaf <> ALeaf do begin
Inc(curW,curLeaf.Width);
if dgColLines in Options then Inc(curW,1);
curLeaf := curLeaf.Next;
end;
Dec(DHRect.Left,curW);
DHRect.Right := DHRect.Left + ALeaf.Host.Width;
leftM := 0;
drawRec := DHRect;
// BUG，假定行提示列永远存在
if (dgIndicator in Options) and
(DHRect.Left < ColWidths[0]) then
begin
leftM := DHRect.Left - ColWidths[0] - 1;
drawRec.Left := ColWidths[0]+1;
end;
InflateRect(DHRect, 1, 1);

if(leftM <> 0) then
WriteTextEH(Canvas, drawRec, FrameOffs-1, FrameOffs,
ALeaf.Host.Text, taCenter,true,leftM)
else
WriteTextEH(Canvas, drawRec, FrameOffs, FrameOffs,
ALeaf.Host.Text, taCenter,true,leftM);

ALeaf.Host.Drawed := true;

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then begin
if CTL3D then
begin
if(leftM <> 0) then
DrawEdge(Canvas.Handle, drawRec, BDR_RAISEDINNER, BF_TOP)
else
DrawEdge(Canvas.Handle, drawRec, BDR_RAISEDINNER, BF_TOPLEFT);
DrawEdge(Canvas.Handle, drawRec, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
end;
InflateRect(DHRect, -1, -1);
end;

if(ALeaf.Host.Host <> nil) and (ALeaf.Host.Host.Drawed = false) then
begin
DrawHost(ALeaf.Host,DHRect);
ALeaf.Host.Host.Drawed := true;
end;
end;

procedure DrawTitleCell(ACol, ARow: Integer; Column: TColumn; var AState: TGridDrawState);
const
ScrollArrows: array [Boolean, Boolean] of Integer =
((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
var
MasterCol: TColumn;
TitleRect, TextRect, ButtonRect: TRect;
I: Integer;
InBiDiMode: Boolean;
begin
TitleRect := CalcTitleRect(Column, ARow, MasterCol);

if MasterCol = nil then
begin
Canvas.FillRect(ARect);
Exit;
end;

Canvas.Font := MasterCol.Title.Font;
Canvas.Brush.Color := MasterCol.Title.Color;
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
InflateRect(TitleRect, -1, -1);
TextRect := TitleRect;
I := GetSystemMetrics(SM_CXHSCROLL);
if ((TextRect.Right - TextRect.Left) > I) and MasterCol.Expandable then
begin
Dec(TextRect.Right, I);
ButtonRect := TitleRect;
ButtonRect.Left := TextRect.Right;
I := SaveDC(Canvas.Handle);
try
Canvas.FillRect(ButtonRect);
InflateRect(ButtonRect, -1, -1);
IntersectClipRect(Canvas.Handle, ButtonRect.Left,
ButtonRect.Top, ButtonRect.Right, ButtonRect.Bottom);
InflateRect(ButtonRect, 1, 1);
{ DrawFrameControl doesn't draw properly when orienatation has changed.
It draws as ExtTextOut does. }
InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
if InBiDiMode then { stretch the arrows box }
Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
ScrollArrows[InBiDiMode, MasterCol.Expanded] or DFCS_FLAT);
finally
RestoreDC(Canvas.Handle, I);
end;
end;
with MasterCol.Title do
WriteText(Canvas, TextRect, FrameOffs, FrameOffs, Caption, Alignment,
IsRightToLeft);
if ([dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines])
and CTL3D then
begin
InflateRect(TitleRect, 1, 1);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
AState := AState - [gdFixed]; // prevent box drawing later
end;

var
OldActive: Integer;
Indicator: Integer;
Highlight: Boolean;
Value: string;
DrawColumn: TColumn;
MultiSelected: Boolean;
ALeft: Integer;
ARect1: TRect;
begin
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;

Dec(ARow, FTitleOffset);
Dec(ACol, FIndicatorOffset);

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) and CTL3D then
begin
InflateRect(ARect, -1, -1);
FrameOffs := 1;
end
else
FrameOffs := 2;
// 左边提示行
if (gdFixed in AState) and (ACol < 0) then
begin
Canvas.Brush.Color := FixedColor;
Canvas.FillRect(ARect);
if Assigned(DataLink) and DataLink.Active then
begin
MultiSelected := False;
if ARow >= 0 then
begin
OldActive := DataLink.ActiveRecord;
try
Datalink.ActiveRecord := ARow;
MultiSelected := RowIsMultiselected;
finally
Datalink.ActiveRecord := OldActive;
end;
end;
if (ARow = DataLink.ActiveRecord) or MultiSelected then
begin
Indicator := 0;
if DataLink.DataSet <> nil then
case DataLink.DataSet.State of
dsEdit: Indicator := 1;
dsInsert: Indicator := 2;
dsBrowse:
if MultiSelected then
if (ARow <> Datalink.ActiveRecord) then
Indicator := 3
else
Indicator := 4; // multiselected and current row
end;
FIndicators.BkColor := FixedColor;
ALeft := ARect.Right - FIndicators.Width - FrameOffs;
if Canvas.CanvasOrientation = coRightToLeft then Inc(ALeft);
// FIndicators.Draw(Canvas, ALeft,
// (ARect.Top + ARect.Top + DefaultRowHeight - FIndicators.Height) shr 1, Indicator, True);
if ARow = Datalink.ActiveRecord then
FSelRow := ARow + FTitleOffset;
end;
end;
end
else with Canvas do
begin
DrawColumn := Columns[ACol];

if not DrawColumn.Showing then Exit; // 为何要去掉
// 设置字体
if not (gdFixed in AState) then
begin
Font := DrawColumn.Font;
Brush.Color := DrawColumn.Color;
end
else begin
Font := DrawColumn.Title.Font;
Brush.Color := DrawColumn.Title.Color;
end;
// 上方固定行,先正常绘制最底行
// if ARow < 0 then
// DrawTitleCell(ACol, ARow + FTitleOffset, DrawColumn, AState)
if ARow < 0 then with DrawColumn.Title do begin
ARect1 := ARect;
if (FUseMultiTitle = True) then begin
Font := TitleFont;
ARect.Top := ARect.Bottom - FLeafFieldArr[ACol].FLeaf.Height + 1;
WriteTextEH(Canvas, ARect, FrameOffs, FrameOffs, FLeafFieldArr[ACol].FLeaf.Text, taCenter,True,0);
end
else
WriteTextEH(Canvas, ARect, FrameOffs, FrameOffs, Caption, Alignment,True,0);
end
// 正文CELL，无内容直接清除
else if (DataLink = nil)
or not DataLink.Active
or (ARow>=DataLink.RecordCount) then
FillRect(ARect)
else
// 标准正文
begin
Value := '';
OldActive := DataLink.ActiveRecord;
try
DataLink.ActiveRecord := ARow;
if Assigned(DrawColumn.Field) then begin
Value := DrawColumn.Field.DisplayText;
end;
Highlight := HighlightCell(ACol, ARow, Value, AState);
if Highlight then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end;
if not Enabled then
Font.Color := clGrayText;

// 绘制单元格
ARect1:=ARect;
if ARect.Bottom-ARect.Top>DefaultRowHeight then begin
ARect1.Bottom:=ARect.Top+DefaultRowHeight;
end;
if DefaultDrawing then
WriteText(Canvas, ARect1, 2, 2, Value, DrawColumn.Alignment,
UseRightToLeftAlignmentForField(DrawColumn.Field, DrawColumn.Alignment));
// 绘制汇总行
if (FBottomSumRows>0) and (ARow=MaxRowCount-1) then begin
DrawSumCell(ACol);
end;
if Columns.State = csDefault then
DrawDataCell(ARect, DrawColumn.Field, AState);
DrawColumnCell(ARect, ACol, DrawColumn, AState);
finally
DataLink.ActiveRecord := OldActive;
end;
// 彻底不需要焦点
{ if DefaultDrawing and (gdSelected in AState)
and ((dgAlwaysShowSelection in Options) or Focused)
and not (csDesigning in ComponentState)
and not (dgRowSelect in Options)
and (UpdateLock = 0)
and (ValidParentForm(Self).ActiveControl = Self) then
Windows.DrawFocusRect(Handle, ARect);}
end;
end;

// 无论任何固定行均需处理凸凹
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) and Ctl3D then
begin
InflateRect(ARect, 1, 1);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
end;

// 最后绘制抬头
if (ARow < 0) and (ACol >=0) and (FUseMultiTitle = True) then
with DrawColumn.Title do begin
if(FLeafFieldArr[ACol].FLeaf.Host <> nil) and
(FLeafFieldArr[ACol].FLeaf.Host.Drawed = False) then
begin
Canvas.Pen.Color:=FLineColor;
DrawHost(FLeafFieldArr[ACol].FLeaf,ARect);
end;
end;


end;

// PAINT方法所需函数
function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
begin
Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
and (Row <= Rect.Bottom);
end;

procedure FillDWord(var Dest; Count, Value: Integer); register;
asm
XCHG EDX, ECX
PUSH EDI
MOV EDI, EAX
MOV EAX, EDX
REP STOSD
POP EDI
end;

{ StackAlloc allocates a 'small' block of memory from the stack by
decrementing SP. This provides the allocation speed of a local variable,
but the runtime size flexibility of heap allocated memory. }
function StackAlloc(Size: Integer): Pointer; register;
asm
POP ECX { return address }
MOV EDX, ESP
ADD EAX, 3
AND EAX, not 3 // round up to keep ESP dword aligned
CMP EAX, 4092
JLE @@2
@@1:
SUB ESP, 4092
PUSH EAX { make sure we touch guard page, to grow stack }
SUB EAX, 4096
JNS @@1
ADD EAX, 4096
@@2:
SUB ESP, EAX
MOV EAX, ESP { function result = low memory address of block }
PUSH EDX { save original SP, for cleanup }
MOV EDX, ESP
SUB EDX, 4
PUSH EDX { save current SP, for sanity check (sp = [sp]) }
PUSH ECX { return to caller }
end;

{ StackFree pops the memory allocated by StackAlloc off the stack.
- Calling StackFree is optional - SP will be restored when the calling routine
exits, but it's a good idea to free the stack allocated memory ASAP anyway.
- StackFree must be called in the same stack context as StackAlloc - not in
a subroutine or finally block.
- Multiple StackFree calls must occur in reverse order of their corresponding
StackAlloc calls.
- Built-in sanity checks guarantee that an improper call to StackFree will not
corrupt the stack. Worst case is that the stack block is not released until
the calling routine exits. }
procedure StackFree(P: Pointer); register;
asm
POP ECX { return address }
MOV EDX, DWORD PTR [ESP]
SUB EAX, 8
CMP EDX, ESP { sanity check #1 (SP = [SP]) }
JNE @@1
CMP EDX, EAX { sanity check #2 (P = this stack block) }
JNE @@1
MOV ESP, DWORD PTR [ESP+4] { restore previous SP }
@@1:
PUSH ECX { return to caller }
end;

procedure TxDBGrid.Paint;
var
LineColor: TColor;
DrawInfo: TGridDrawInfo;
Sel: TGridRect;
UpdateRect: TRect;
//AFocRect, FocRect: TRect;
PointsList: PIntArray;
StrokeList: PIntArray;
MaxStroke: Integer;
FrameFlags1, FrameFlags2: DWORD;

procedure DrawLines(DoHorz, DoVert: Boolean; Col, Row: Longint;
const CellBounds: array of Integer; OnColor, OffColor: TColor);

{ Cellbounds is 4 integers: StartX, StartY, StopX, StopY
Horizontal lines: MajorIndex = 0
Vertical lines: MajorIndex = 1 }

const
FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;

procedure DrawAxisLines(const AxisInfo: TGridAxisDrawInfo;
Cell, MajorIndex: Integer; UseOnColor: Boolean);
var
Line: Integer;
LogBrush: TLOGBRUSH;
Index: Integer;
Points: PIntArray;
StopMajor, StartMinor, StopMinor: Integer;
begin
with Canvas, AxisInfo do
begin
if EffectiveLineWidth <> 0 then
begin
Pen.Width := GridLineWidth;
if UseOnColor then
Pen.Color := OnColor
else
Pen.Color := OffColor;
if Pen.Width > 1 then
begin
LogBrush.lbStyle := BS_Solid;
LogBrush.lbColor := Pen.Color;
LogBrush.lbHatch := 0;
Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
end;
Points := PointsList;
Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
GetExtent(Cell);
//!!! ??? Line needs to be incremented for RightToLeftAlignment ???
if UseRightToLeftAlignment and (MajorIndex = 0) then Inc(Line);
StartMinor := CellBounds[MajorIndex xor 1];
StopMinor := CellBounds[2 + (MajorIndex xor 1)];
StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
Index := 0;
repeat
Points^[Index + MajorIndex] := Line; { MoveTo }
Points^[Index + (MajorIndex xor 1)] := StartMinor;
Inc(Index, 2);
Points^[Index + MajorIndex] := Line; { LineTo }
Points^[Index + (MajorIndex xor 1)] := StopMinor;
Inc(Index, 2);
Inc(Cell);
Inc(Line, GetExtent(Cell) + EffectiveLineWidth);
until Line > StopMajor;
{ 2 integers per point, 2 points per line -> Index div 4 }
PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
end;
end;
end;

begin
if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then Exit;
if not DoHorz then
begin
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
end
else
begin
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
end;
end;

procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
Color: TColor; IncludeDrawState: TGridDrawState);
var
CurCol, CurRow: Longint;
{AWhere,} Where, TempRect: TRect;
DrawState: TGridDrawState;
Focused: Boolean;
begin
CurRow := ARow;
Where.Top := StartY;
while (Where.Top < StopY) do begin
if (CurRow < RowCount) then
begin
CurCol := ACol;
Where.Left := StartX;
Where.Bottom := Where.Top + RowHeights[CurRow];
while (Where.Left < StopX) and (CurCol < ColCount) do
begin
Where.Right := Where.Left + ColWidths[CurCol];
if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
begin
DrawState := IncludeDrawState;
Focused := IsActiveControl;
if Focused and (CurRow = Row) and (CurCol = Col) then
Include(DrawState, gdFocused);
if PointInGridRect(CurCol, CurRow, Sel) then
Include(DrawState, gdSelected);
if not (gdFocused in DrawState) or not (dgEditing in Options) or
not EditorMode or (csDesigning in ComponentState) then
begin
if DefaultDrawing or (csDesigning in ComponentState) then
with Canvas do
begin
Font := Self.Font;
if (gdSelected in DrawState) and
(not (gdFocused in DrawState) or
([{goDrawFocusSelected, }dgRowSelect] * Options <> [])) then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end
else
Brush.Color := Color;
// 减少刷新范围，避免将统计值清空
tempRect:=Where;
if tempRect.Bottom-tempRect.Top>DefaultRowHeight then
tempRect.Bottom:=Where.Top+DefaultRowHeight;
if (CurRow>0) and not (gdFixed in DrawState) then
FillRect(tempRect);
end;
DrawCell(CurCol, CurRow, Where, DrawState);
if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
((FrameFlags1 or FrameFlags2) <> 0) then
begin
TempRect := Where;
if (FrameFlags1 and BF_RIGHT) = 0 then
Inc(TempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
else if (FrameFlags1 and BF_BOTTOM) = 0 then
Inc(TempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
if not ((CurRow=0) and (CurCol>0)) then begin
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1);
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2);
end;
end;
// 彻底不需要焦点
{ if DefaultDrawing and not (csDesigning in ComponentState) and
(gdFocused in DrawState) and
([dgEditing, dgAlwaysShowEditor] * Options <>
[dgEditing, dgAlwaysShowEditor])
and not (dgRowSelect in Options) then
begin
if not UseRightToLeftAlignment then
DrawFocusRect(Canvas.Handle, Where)
else
begin
AWhere := Where;
AWhere.Left := Where.Right;
AWhere.Right := Where.Left;
DrawFocusRect(Canvas.Handle, AWhere);
end;
end;}
end;
end;
Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
Inc(CurCol);
end;
Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
Inc(CurRow);
end
else begin
CurCol := ACol;
Where.Left := StartX;
Where.Bottom := Where.Top + DefaultRowHeight{RowHeights[CurRow]};
while (Where.Left < StopX) and (CurCol < ColCount) do
begin
Where.Right := Where.Left + ColWidths[CurCol];
if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
begin
with Canvas do begin
Brush.Color := Color;
FillRect(Where);
end;
end;
Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
Inc(CurCol);
end;
Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
Inc(CurRow);
end;
end; { end of while }
end;

var
i: Integer;
begin
// if UseRightToLeftAlignment then ChangeGridOrientation(True);
if dgTitles in Options then
FHeadTree.DoForAllNode(ClearPainted);

UpdateRect := Canvas.ClipRect;
CalcDrawInfo(DrawInfo);
with DrawInfo do
begin
if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then
begin
{ Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
(fixed, variable) and (variable, variable) }
LineColor := FLineColor;
MaxStroke := Max(Horz.LastFullVisibleCell - LeftCol + FixedCols,
MaxRowCount{Vert.LastFullVisibleCell - TopRow} + FixedRows) + 3;
PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
FillDWord(StrokeList^, MaxStroke, 2);

if ColorToRGB(Color) = clSilver then LineColor := clGray;
DrawLines(dgRowLines in Options, dgColLines in Options,
0, 0, [0, 0, Horz.FixedBoundary, Vert.FixedBoundary],
FLineColor, FixedColor);
// 抬头的格线由标题单元格自行绘制
if CTL3D then
DrawLines(dgRowLines in Options, dgColLines in Options,
LeftCol, 0, [Horz.FixedBoundary, 0, Horz.GridBoundary,
Vert.FixedBoundary], FLineColor, FixedColor);
// 提示行格线必须绘制，无论有多少行
DrawLines(dgRowLines in Options, dgColLines in Options,
0, TopRow, [0, Vert.FixedBoundary, Horz.FixedBoundary,
MaxRowHeight+1{ Vert.GridBoundary}], FLineColor, FixedColor);

// 正文格线同样，无论实际多少行
DrawLines(dgRowLines in Options, dgColLines in Options, LeftCol,
TopRow, [Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridBoundary,
MaxRowHeight+1{ Vert.GridBoundary}], LineColor, Color);

StackFree(StrokeList);
StackFree(PointsList);
end;

{ Draw the cells in the four areas }
Sel := Selection;
FrameFlags1 := 0;
FrameFlags2 := 0;
if dgColLines in Options then
begin
FrameFlags1 := BF_RIGHT;
FrameFlags2 := BF_LEFT;
end;
if dgRowLines in Options then
begin
FrameFlags1 := FrameFlags1 or BF_BOTTOM;
FrameFlags2 := FrameFlags2 or BF_TOP;
end;
DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, FixedColor,
[gdFixed]);
DrawCells(LeftCol, 0, Horz.FixedBoundary {- FColOffset}, 0, Horz.GridBoundary, //!! clip
Vert.FixedBoundary, FixedColor, [gdFixed]);
DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary,
MaxRowHeight+1{Vert.GridBoundary}, FixedColor, [gdFixed]);
DrawCells(LeftCol, TopRow, Horz.FixedBoundary {- FColOffset}, //!! clip
Vert.FixedBoundary, Horz.GridBoundary, MaxRowHeight+1{Vert.GridBoundary}, Color, []);

// 强制重绘汇总行
if FBottomSumRows>0 then
for i:=0 to ColCount-FIndicatorOffset-1 do
DrawSumCell(i);
// 彻底取消绘制焦点
{ if not (csDesigning in ComponentState) and
(dgRowSelect in Options) and DefaultDrawing and Focused then
begin
GridRectToScreenRect(Selection, FocRect, False);
if not UseRightToLeftAlignment then
Canvas.DrawFocusRect(FocRect)
else
begin
AFocRect := FocRect;
AFocRect.Left := FocRect.Right;
AFocRect.Right := FocRect.Left;
DrawFocusRect(Canvas.Handle, AFocRect);
end;
end;}

{ Fill in area not occupied by cells }
// 右方空白区域必须向下延伸到最后
if Horz.GridBoundary < Horz.GridExtent then
begin
Canvas.Brush.Color := Color;
// if FBottomSumRows>0 then
Canvas.FillRect(Rect(Horz.GridBoundary, 0,
Horz.GridExtent, MaxRowHeight+2))
// else
// Canvas.FillRect(Rect(Horz.GridBoundary, 0,
// Horz.GridExtent, Vert.GridBoundary));
end;
// 下方空白区域必须从最大处开始
if Vert.GridBoundary < Vert.GridExtent then
begin
Canvas.Brush.Color := Color;
// if FBottomSumRows>0 then
Canvas.FillRect(Rect(0, MaxRowHeight+2,
Horz.GridExtent, Vert.GridExtent))
// else
// Canvas.FillRect(Rect(0, Vert.GridBoundary,
// Horz.GridExtent, Vert.GridExtent));
end;
end;

// if UseRightToLeftAlignment then ChangeGridOrientation(False);
end;

procedure TxDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
if not FNoAppend then
inherited KeyDown(Key,Shift)
else begin
if (Key = VK_DOWN)
and (not (ssCtrl in Shift)) then begin
if (Datalink.DataSet.Eof) then
exit;
Datalink.DataSet.Next;
if Datalink.DataSet.Eof then exit;
end
else
inherited KeyDown(Key,Shift);
end;
end;

function TxDBGrid.IsActiveControl: Boolean;
var
H: Hwnd;
ParentForm: TCustomForm;
begin
Result := False;
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) then
begin
if (ParentForm.ActiveControl = Self) then
Result := True
end
else
begin
H := GetFocus;
while IsWindow(H) and (Result = False) do
begin
if H = WindowHandle then
Result := True
else
H := GetParent(H);
end;
end;
end;

function TxDBGrid.CreateEditor: TInplaceEdit;
begin
Result := TxDBGridInplaceEdit.Create(Self);
end;

procedure TxDBGrid.SizeChanged(OldColCount, OldRowCount: Longint);
begin
if FBottomSumRows<=0 then exit;
if OldRowCount<>FTitleOffset+MaxRowCount-1 then begin
RowCount:=FTitleOffSet+MaxRowCount-1;
RowHeights[RowCount-1]:=DefaultRowHeight*2+1;
end;
end;

function TxDBGrid.IndexOfColumn(fld: TField): Integer;
var
i: Integer;
begin
if fld=nil then begin result:=-1; exit; end;

Result:=-1;
for i:=0 to Columns.Count-1 do begin
if fld.FieldName=Columns.FieldName then begin
result:=i;
break;
end
else
Result:=-1;
end;
end;

function TxDBGrid.IndexOfSumFlag(ACol: Integer): string;
var
s: string;
idx, i: Integer;
begin
s:=FSumFlag;
i:=0;
while (i<=ACol) do begin
idx:=pos(',', s);
if (idx>0) then
result:=Copy(s,1,idx-1)
else begin
result:='';
exit;
end;
s:=Copy(s,idx+1,Length(s)-idx);
Inc(i);
end;
end;

procedure TxDBGrid.WriteSumFlag(flag: string);
begin
FSumFlag:=flag;
if FSumFlag<>'' then FBottomSumRows:=1
else FBottomSumRows:=0;
end;

procedure TxDBGrid.SetSumFlag(ACol: Integer; flag: string);
var
s, s1: string;
idx, i: Integer;
begin
s:=FSumFlag;
s1:='';
i:=0;
while (i<=ACol) do begin
idx:=pos(',', s);
if (idx>0) then begin
if (i<ACol) then s1:=s1+Copy(s,1,idx);
end
else
exit;
s:=Copy(s,idx+1,Length(s)-idx);
Inc(i);
end;
FSumFlag:=s1+flag+','+s;
end;

procedure TxDBGrid.DrawSumCell(ACol: Integer);
var
r: TRect;
sum: string;
alig: TAlignment;
AText: string;
begin
if FBottomSumRows<=0 then exit;
r:=CellRect(ACol+FIndicatorOffset, FTitleOffset);
r.Top:=MaxRowHeight-DefaultRowHeight+1;
r.Bottom:=r.Top+DefaultRowHeight;
Canvas.Brush.Color := FSumColor;
Canvas.Font.Color := clBlack;
Canvas.Pen.Color := FLineColor;
Canvas.MoveTo(r.Left,r.Top-1);
Canvas.LineTo(r.Right,r.Top-1);
with Columns[ACol] do begin
sum:=IndexOfSumFlag(ACol);
if sum='1' then begin
if VarIsNull(FSumArray[ACol]) then
AText:=FormatSum(0, Field)
else
AText:=FormatSum(FSumArray[ACol],Field);
alig:=Alignment;
end
else begin
AText:=Sum;
alig:=taCenter;
end;
WriteText(Canvas, r, 2, 2, AText, alig,
UseRightToLeftAlignmentForField(Field, Alignment));
end;
end;

procedure TxDBGrid.LinkActive(Value: Boolean);
var
i: Integer;
f: TFieldNotifyEvent;
f1: TDataSetNotifyEvent;
begin
inherited LinkActive(Value);
if DataLink.DataSet=nil then exit;
// 数据库关闭
if not Value then begin
if Assigned(FMasterQuery) and (FMasterQuery.DataSource<>nil) then begin
f1:=OnMasterScroll;
if Assigned(FEventMasterScroll) and (@f1<>@FEventMasterScroll) then
FMasterQuery.DataSource.DataSet.AfterScroll:=FEventMasterScroll
else
FMasterQuery.DataSource.DataSet.AfterScroll:=nil;
end;
FMasterQuery:=nil;
FEventMasterScroll:=nil; // 专为处理主从表

f1:=OnBeforeDelete;
if Assigned(FEventBeforeDelete) and (@f1<>@FEventBeforeDelete) then
DataLink.DataSet.BeforeDelete:=FEventBeforeDelete
else
DataLink.DataSet.BeforeDelete:=nil;

f1:=OnBeforeCancel;
if Assigned(FEventBeforeCancel) and (@f1<>@FEventBeforeCancel) then
DataLink.DataSet.BeforeCancel:=FEventBeforeCancel
else
DataLink.DataSet.BeforeCancel:=nil;

f1:=OnAfterCancel;
if Assigned(FEventAfterCancel) and (@f1<>@FEventAfterCancel) then
DataLink.DataSet.AfterCancel:=FEventAfterCancel
else
DataLink.DataSet.AfterCancel:=nil;

for i:=0 to Columns.Count-1 do begin
if (Columns.Field<>nil) then begin
f:=OnFieldChange;
if (Assigned(FEventArray)) and (@f<>@FEventArray) then
Columns.Field.OnChange:=FEventArray
else
Columns.Field.OnChange:=nil;
end;
FEventArray:=nil;
FSumArray:=0;
FOldValues:=0;
end;
exit;
end;
// 求初始的统计值
with DataLink.DataSet do begin
if not Active then exit;
// 保存开始的事件
if DataLink.DataSet.InheritsFrom(TQuery) then begin
FMasterQuery:=TQuery(DataLink.DataSet);
if FMasterQuery.DataSource<>nil then begin
f1:=OnMasterScroll;
if (Assigned(FMasterQuery.DataSource.DataSet.AfterScroll))
and (@f1<>@FMasterQuery.DataSource.DataSet.AfterScroll) then
FEventMasterScroll:=FMasterQuery.DataSource.DataSet.AfterScroll
else
FEventMasterScroll:=nil;
FMasterQuery.DataSource.DataSet.AfterScroll:=OnMasterScroll;
end;
end;

f1:=OnBeforeDelete;
if (Assigned(DataLink.DataSet.BeforeDelete))
and (@f1<>@DataLink.DataSet.BeforeDelete) then
FEventBeforeDelete:=DataLink.DataSet.BeforeDelete
else
FEventBeforeDelete:=nil;
DataLink.DataSet.BeforeDelete:=OnBeforeDelete;

f1:=OnBeforeCancel;
if (Assigned(DataLink.DataSet.BeforeCancel))
and (@f1<>@DataLink.DataSet.BeforeCancel) then
FEventBeforeCancel:=DataLink.DataSet.BeforeCancel
else
FEventBeforeCancel:=nil;
DataLink.DataSet.BeforeCancel:=OnBeforeCancel;

f1:=OnAfterCancel;
if (Assigned(DataLink.DataSet.AfterCancel))
and (@f1<>@DataLink.DataSet.AfterCancel) then
FEventAfterCancel:=DataLink.DataSet.AfterCancel
else
FEventAfterCancel:=nil;
DataLink.DataSet.AfterCancel:=OnAfterCancel;

// 修正BUG，不应用DATASET的次序而非COLUMNS的次序。
for i:=0 to Columns.Count-1 do begin
// 检测标志位，看是否需计总
if IndexOfSumFlag(i)='1' then begin
if (Columns.Field<>nil) and (Columns.Field.DataType in
[ftSmallint, ftInteger, ftFloat, ftBCD, ftCurrency, ftLargeint]) then
begin
if Assigned(Columns.Field.OnChange) then begin
f:=OnFieldChange;
if @f<>@Columns.Field.OnChange then
FEventArray:=Columns.Field.OnChange
else
FEventArray:=nil;
end;
FSumArray:=0;
FOldValues:=0;
Columns.Field.OnChange:=OnFieldChange;
end
// 修正标志位
else begin
SetSumFlag(i, '');
end;
end;
end;
CalcSum;
end;
end;

procedure TxDBGrid.CalcSum;
var
i: Integer;
begin
with DataLink.DataSet do begin
if not Active then exit;
for i:=0 to MaxField do begin
FSumArray:=0;
FOldValues:=0;
end;

DisableControls;
First;
while not eof do begin
for i:=0 to Columns.Count-1 do begin
// 直接检测标志位，看是否需计总
if (IndexOfSumFlag(i)='1') and
not VarIsNull(Columns.Field.Value) then
FSumArray:=FSumArray+Columns.Field.Value;
end;
next;
end;
First;
EnableControls;
end;
Invalidate;
end;

procedure TxDBGrid.OnMasterScroll(DataSet: TDataSet);
var
f: TDataSetNotifyEvent;
begin
f:=OnMasterScroll;
if (Assigned(FEventMasterScroll)) and (@FEventMasterScroll<>@f) then
FEventMasterScroll(DataSet);
CalcSum;
end;

procedure TxDBGrid.OnBeforeDelete(DataSet: TDataSet);
var
i: Integer;
f: TDataSetNotifyEvent;
begin
f:=OnBeforeDelete;
if (Assigned(FEventBeforeDelete)) and (@FEventBeforeDelete<>@f) then
FEventBeforeDelete(DataSet);

if (DataSet=nil) or (not DataSet.Active) then exit;
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if (IndexOfSumFlag(i)='1') then begin
FSumArray:=FSumArray-Columns.Field.AsFloat;
DrawSumCell(i);
end;
end;
end;

procedure TxDBGrid.OnBeforeCancel(DataSet: TDataSet);
var
i: Integer;
f: TDataSetNotifyEvent;
begin
f:=OnBeforeCancel;
if (Assigned(FEventBeforeCancel)) and (@FEventBeforeCancel<>@f) then
FEventBeforeCancel(DataSet);

if (DataSet=nil) or (not DataSet.Active) then exit;
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if (IndexOfSumFlag(i)='1') then
FOldValues:=Columns.Field.Value;
end;
end;

procedure TxDBGrid.OnAfterCancel(DataSet: TDataSet);
var
i: Integer;
f: TDataSetNotifyEvent;
begin
f:=OnAfterCancel;
if (Assigned(FEventAfterCancel)) and (@FEventAfterCancel<>@f) then
FEventAfterCancel(DataSet);

if (DataSet=nil) or (not DataSet.Active) then exit;
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if (IndexOfSumFlag(i)='1') then begin
FSumArray:=FSumArray-FOldValues+Columns.Field.Value;
DrawSumCell(i);
end;
end;
end;

function TxDBGrid.GetEditText(ACol, ARow: Longint): string;
var
s: string;
i: Integer;
f: TFieldNotifyEvent;

///////////////////////////////////////////////////////////
// 清除格式化字符
function NumberString(str: string): string;
begin
while (pos(',',str)>0) do Delete(Str, Pos(',',str), 1);
while (pos('$',str)>0) do Delete(Str, Pos('$',str), 1);
while (pos('￥', str)>0) do Delete(Str, Pos('￥',str), 2);
if str='' then result:='0'
else result:=str;
end;

begin
// 修正BUG，计算字段，无论何时全都存放计算字段旧值
if (Datalink.Active) then begin
for i:=0 to Columns.Count-1 do begin
if (Columns.Field=nil) then continue;
if {((ACol-FIndicatorOffset=i)
and (Columns.Field.FieldKind<>fkData))
and} (IndexOfSumFlag(i)='1') then begin
// 强制重新赋予ONCHANGE处理例程
f:=OnFieldChange;
if @Columns.Field.OnChange<>@f then begin
FEventArray:=Columns.Field.OnChange;
Columns.Field.OnChange:=OnFieldChange;
end;

if (Columns.Field.Text<>'') then begin
s:=NumberString(Columns.Field.Text);
FOldValues:=StrToFloat(s)
end
else
FOldValues:=0;
end;
end;
end;
Result:=inherited GetEditText(ACol, ARow);
end;

///////////////////////////////////////////////////////////
// 以下函数组合专为处理字段统计用
procedure TxDBGrid.OnFieldChange(Sender: TField);
var
idx: Integer;
f: TFieldNotifyEvent;
begin
if (Sender=nil) then exit;
idx:=IndexOfColumn(Sender);
if idx<0 then exit;
f:=OnFieldChange;
if (Assigned(FEventArray[idx])) and (@f<>@FEventArray[idx]) then
FEventArray[idx](Sender);
if Sender.Value<>FOldValues[idx] then
FSumArray[idx]:=FSumArray[idx]+Sender.Value-FOldValues[idx];
DrawSumCell(idx);
end;

{procedure TxDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
var
ANewValue: real;
i: Integer;
begin
inherited SetEditText(ACol, ARow, Value);
if (Datalink.Active) then begin
for i:=0 to Columns.Count-1 do begin
// 避免产生BUG，无论如何全计算
if ((ACol-FIndicatorOffset=i) // （当前列
or (Columns.Field.FieldKind<>fkData)) // 或 计算字段）
and (IndexOfSumFlag(i)='1') then begin // 且（含计算标志）
ANewValue:=Columns.Field.AsFloat;
// AnewValue:=StrToFloat(NumberString(Columns.Field.Text));
if ANewValue<>FOldValues then begin
FSumArray:=FSumArray+ANewValue-FOldValues;
DrawSumCell(i);
end;
end;
end;
end;
end;}

function TxDBGrid.FIndicatorOffset: Integer;
begin
if dgIndicator in Options then result:=1
else result:=0;
end;

function TxDBGrid.FormatSum(Value: Variant; AField: TField): string;
var
L: Longint;
F: Double;
FmtStr: string;
Format: TFloatFormat;
Digits: Integer;
Text: string;
begin
if AField=nil then exit;
FmtStr := TNumericField(AField).DisplayFormat;
if not AField.InheritsFrom(TFloatField) then begin
L := Value;
if FmtStr = '' then Str(L, Text) else Text:=FormatFloat(FmtStr, L);
end
else begin
F := Value;
if FmtStr = '' then begin
if TFloatField(AField).Currency then begin
Format := ffCurrency;
Digits := CurrencyDecimals;
end
else begin
Format := ffGeneral;
Digits := 0;
end;
Text := FloatToStrF(F, Format, TFloatField(AField).Precision, Digits);
end else
Text := FormatFloat(FmtStr, F);
end;
Result:=Text;
end;

function TxDBGrid.GetSums(idx: Integer): real;
var
sum: string;
begin
sum:=IndexOfSumFlag(idx);
if sum='1' then begin
if VarIsNull(FSumArray[idx]) then
result:=0
else
Result:=FSumArray[idx];
end
else
Result:=0;
end;

end.

代碼相當長，有空試看看

没人感兴趣啊，可惜我这200分啊

你贴那么长的代码,让人家看了都头痛.
或许你可以一个一个问题来解决啊.
把重要的代码贴上就好了嘛

好长的代码啊！！！！！！！！！！！！！！！！！！！！！！！！！
！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！1

兄台，代码可真短阿，能否再放一个Demo上来阿，看起来累

更新从表的时候跟踪过去，没有对应的更新合计的代码？你说说是哪个函数会更新对应的从表