SmartCost/Components/SmartDataSet/Source/sdDB.pas

{
  zhangyin
  2017-11-14 TsdDataView增加主从表功能，用法同TDataSet

  2017-11-30 TsdDataView增加Filter，用法同TDataSet.
    大小写不敏感。
    每个判断必须是[字段][运算符][值]的形式，例如 Type = 3。
    判断之间只支持and, or
    支持TsdDataSet所有字段类型。
    Boolean类型支持直接写True, False。
    所有类型支持Null值
    注意：1、Filter和SetRange某种程度上可以共存，先设置好Filter，再SetRange，
          Filter依然起作用，以后再SetRange，Filter也是起作用的。
          但是SetRange完，再Filtered := True, Range就不起作用了。
          为保险起见，还是不要一起用。
          2、OnFilterRecord事件仍然有效，每条记录先Filter，再触发事件
          3、SetRange比Filter效率高得多，但是单次操作对比不会很明显。
            (单字段过滤300条记录大约是0.001秒和0.00015秒的区别。
             Filter的速度跟记录数和作为条件的字段数量成正比。
             SetRange的速度跟索引的分布有关系，
             以Code这种分散的字段为索引，时间是0.00015秒，以Type这种集中的字段为索引，时间趋近于0)
          4、Filter使用更灵活，SetRange必须有对应索引，限制较多。
          Filter适合条件较复杂的情况，SetRange适合条件单一并且适合建立索引的情况。

  2017-12-1 补充
  典型测试：
    “K线”项目Bills表，3211条记录。
    过滤条件'(ID > 10000) and (Flag = 0)'。
    Filter：0.031秒

  极限测试：
    “K线”项目GLJList表，92041条记录。
    过滤条件'(Type = 3) and (BillsItemID = 5722)'。
    全部加载42秒，Filter 0.828秒，SetRange 0.015秒。
    Filter和SetRange效率上有数量级的差距。
    另：这么大的表不建议直接连接表格

  2018-7-7
  增加TsdDataRecord.Cancel方法，用于回滚记录。
  调用后，新增记录直接删除，修改值恢复。
  在事件中调用，必须在AfterValueChanged事件及以前。
  必须与BeginUpdate配合使用，否则报错。
  调用一次Cancel即终止所有嵌套的BeginUpdate。
  注意：事件中Cancel会对外部的嵌套BeginUpdate造成不好处理的情况，
        所以原则上除非是对界面触发事件的处理，不要把代码写在事件里。
        树结构暂不能支持新增节点的Cancel

  2018-08-28
  事件顺序调整，凡DataSet和DataView共有的事件，一律DataView的事件先触发，
  DataSet的事件后触发

  Lookup字段默认不可编辑，实在需要自动编辑，可在OnSetText事件中修改参数Allow

  2019
  Lookup改为可编辑，只读由界面控制

  2019-05-28
  TsdDataView.Filter增加Like运算符，可使用通配符用于字符串比较，详情可查看MatchesMask函数帮助

  2024-12-11
  zhangyin
  偶然发现Delphi的神奇现象
  一个Boolean类型大小是一个bit，但是内存一次为其分配四个Byte
  但是神奇的是，四个Boolean类型放到一起，还是只分配四个Byte
  注意必须放一起，分开就不行
  本次优化将TsdValue一个多余的Boolean字段删除，将三处分开的Boolean类型合并到一处，
  一共节省8Byte(44->36, 18%)，200,000条30个字段(GLJList有29个字段)的记录节省48MB内存，对于大项目还是有意义的。
  实测一个大项目占用内存由1494.7MB减小到1349.6MB。

  其他类的Boolean类型也做了相应的优化。

  2024-12-18
  zhangyin
  继续优化TsdValue：
  1.删除无用字段FOldValue，FCachedValue及相关属性方法
  2.将FEnableEvents上移到TsdDataSet.FEnableValueEvents
  3.将FTag改为Byte类型，并与前三个Boolean类型放到一起，这样一共只占用4个Byte
  共节省内存12Byte，现在实例占用内存24Byte
  实测前述大项目内存减小到1199.6MB
}

unit sdDB;
interface

uses
  SysUtils, Classes, DB, DBConsts, Windows, Variants, sdInterface, FmtBcd,
  sdLogicalExprs;

type
  EsdDataSet = class(Exception);
  EsdLog = class(Exception);

  TsdDataRecord = class;
  TsdField = class;

  TFieldName = string;


  { 暂时只支持
    ftString, ftWideString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
    ftCurrency, ftDateTime, ftBCD, ftFMTBCD, ftMemo}
  TsdValue = class(TObject)
  private
    FIsNull: Boolean;
    FForceWriteData: Boolean;
    FOriginalCached: Boolean;
    FTag: Byte;
    FData: Pointer;
    FField: TsdField;
    FOwner: TsdDataRecord;
    FOriginalValue: Pointer;
    function GetAsBoolean: Boolean;
    function GetAsCurrency: Currency;
    function GetAsDateTime: TDateTime;
    function GetAsFloat: Double;
    function GetAsExtended: Extended;
    function GetAsInteger: Longint;
    function GetAsString: string;
    function GetAsWideString: WideString;
    function GetAsVariant: Variant;
    function GetAsBCD: TBCD;
    function GetDataSize: Integer;
    function GetDataType: TFieldType;
    function GetDisplayText: string;
    function GetEditText: string;
    function GetFieldName: string;
    function GetFieldNo: Integer;
    function GetIsNull: Boolean;
    procedure SetAsBoolean(const Value: Boolean);
    procedure SetAsCurrency(const Value: Currency);
    procedure SetAsDateTime(const Value: TDateTime);
    procedure SetAsFloat(const Value: Double);
    procedure SetAsExtended(const Value: Extended);
    procedure SetAsInteger(const Value: Longint);
    procedure SetAsString(const Value: string);
    procedure SetAsWideString(const Value: WideString);
    procedure SetAsVariant(const Value: Variant);
    procedure SetAsBCD(const Value: TBCD);
    procedure SetEditText(const Value: string);
    function ActualLength: Integer;
    procedure ConvertDataBeforeWriteData(const Value: string; var Data: Pointer;
      var NewValue: Variant; var Length: Integer; var NoNull: Boolean);
    function CanWriteData(Data, ACache: Pointer; Length: Integer; NoNull: Boolean): Boolean;
    procedure InnerWriteData(Data: Pointer; const NewValue: Variant; Length: Integer; NoNull: Boolean);
    procedure ReadData(var Data: Pointer; Length: Integer = 0);
    procedure WriteData(Data: Pointer; const NewValue: Variant; Length: Integer = 0; NoNull: Boolean = True);
    procedure TypeErrorOnWriting(const Value: Variant);
    function CopyCache: Pointer;
    procedure ClearCache(ACache: Pointer);
    //function GetSize: Integer;
    procedure InnerClear;
    procedure InnerCopy(AValue: Variant);
    function InnerCacheLength(ACache: Pointer): Integer;
    procedure InnerCopyCache(var ACache: Pointer);
    procedure InnerSetCache(var ACache: Pointer; AValue: Variant);
    function InnerGetCache(ACache: Pointer): Variant;
    function GetOriginalValue: Variant;
    procedure CacheOriginalValue;
    procedure ClearOriginalValue;
  protected
    procedure SetField(Field: TsdField);
    // zhangyin 2017-12-27 ！！！for test only！！！
    function _CopyTo(Destination: Pointer): Integer;
    function _CopyFrom(Source: Pointer): Integer;
    function _MemorySize: Integer;
    procedure DisableEvents;
    procedure EnableEvents;
  public
    constructor Create(AOwner: TsdDataRecord); virtual;
    destructor Destroy; override;
    procedure Assign(Source: TsdValue);
    procedure Clear;

    property DataSize: Integer read GetDataSize;
    property DataType: TFieldType read GetDataType;
    property FieldName: string read GetFieldName;
    property FieldNo: Integer read GetFieldNo;
    property Field: TsdField read FField;
    property Owner: TsdDataRecord read FOwner;
    //property Size: Integer read GetSize;

    property IsNull: Boolean read GetIsNull;
    property Text: string read GetEditText write SetEditText;
    property DisplayText: string read GetDisplayText;
    property Value: Variant read GetAsVariant write SetAsVariant;
    property OriginalValue: Variant read GetOriginalValue;// write SetOriginalValue;
    property Tag: Byte read FTag write FTag;
    property ForceWriteData: Boolean read FForceWriteData write FForceWriteData;

    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsExtended: Extended read GetAsExtended write SetAsExtended;
    property AsInteger: Longint read GetAsInteger write SetAsInteger;
    property AsString: string read GetAsString write SetAsString;
    property AsWideString: WideString read GetAsWideString write SetAsWideString;
    property AsVariant: Variant read GetAsVariant write SetAsVariant;
    property AsBCD: TBCD read GetAsBCD write SetAsBCD;
  end;

  TsdValueList = class(TObject)
  private
    FOwner: TsdDataRecord;
    FList: TList;
    function GetValues(Index: Integer): TsdValue;
    function GetCount: Integer;
    function FindValue(Field: TsdField; var Value: TsdValue): Boolean;
  protected
    function Add(Field: TsdField): TsdValue;
    procedure Clear;
  public
    constructor Create(AOwner: TsdDataRecord); virtual;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Values[Index: Integer]: TsdValue read GetValues; default;
  end;

  TsdIndex = class;
  TsdDataSet = class;
  TsdOperation = (sroAdd, sroModify, sroDelete, sdoActive, sdoRefresh, sdoReset);

  TsdDataRecordCache = class;

  TsdValueCache = class(TObject)
  private
    FModified: Boolean;
    FValue: Variant;
    procedure SetValue(const Value: Variant);
  public
    constructor Create(AOwner: TsdDataRecordCache); virtual;
    destructor Destroy; override;
    property Value: Variant read FValue write SetValue;
    property Modified: Boolean read FModified;
  end;

  TsdDataRecordCache = class(TObject)
  private
    FRecord: TsdDataRecord;
    FList: TList;
    procedure AddValues;
    function GetCount: Integer;
    function GetValues(I: Integer): TsdValueCache;
  public
    constructor Create(AOwner: TsdDataRecord); virtual;
    destructor Destroy; override;
    property Values[I: Integer]: TsdValueCache read GetValues;
    property Count: Integer read GetCount;
  end;

  TsdDataRecord = class(TObject)
  private
    FDeleted: Boolean;
    FIsInEvent: Boolean;
    FCanceled: Boolean;
    FIndex: Integer;
    FOwner: TsdDataSet;
    FUpdateLock: Integer;
    FInserting: Integer;
    FData: Pointer;
    FPData: Pointer;
    FCache: TsdDataRecordCache;
    procedure Clear;
    function GetValues(FieldNo: Integer): TsdValue;
    function GetIsUpdating: Boolean;
    function GetFieldValue(const FieldName: string): Variant;
    procedure NotifyIndex(Value: TsdValue);
    procedure ForceNotifyIndex;
    procedure NotifyLookup(Field: TsdField);
    function GetCount: Integer;
    function GetInserting: Boolean;
    procedure SetInserting(Value, NeedBeginUpdate: Boolean);
    procedure SetData(const Value: Pointer);
    procedure BeginTrans;
    procedure EndTrans;
    procedure Rollback;
    procedure CacheModified(Source: TsdValue);
  protected
    FRecNo: Integer;
    FNew: Boolean;
    FModified: Boolean;
    FNeedNotifyIndex: Boolean;
    FValueList: TsdValueList;
    FChangedValueList: TList;
    procedure Changed(Value: TsdValue); virtual;
    procedure DoAfterAddFields; virtual;
    procedure SetPData(Value: Pointer);
    property FieldValues[const FieldName: string]: Variant read GetFieldValue;
    property IsInEvent: Boolean read FIsInEvent;
    property Canceled: Boolean read FCanceled;
  public
    constructor Create(AOwner: TsdDataSet); virtual;
    destructor Destroy; override;
    procedure AddFields;
    function AddValue(FieldNo: Integer; DBField: TField): TsdValue; overload;
    function AddValue(Field: TsdField; Value: Variant; IsNull: Boolean = False): TsdValue; overload;
    function AddValue(FieldName: string; Value: Variant; IsNull: Boolean = False): TsdValue; overload;
    function ValueByName(FieldName: string): TsdValue;
    procedure Loaded;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure Cancel;
    procedure DoAfterSaved;
    procedure EnterEvent;
    procedure ExitEvent;
    procedure Delete;
    property MainIndex: Integer read FIndex;
    property Deleted: Boolean read FDeleted;
    property Modified: Boolean read FModified;
    // 标记未保存的新增记录
    property New: Boolean read FNew;
    property Owner: TsdDataSet read FOwner;
    property RecNo: Integer read FRecNo;
    property Count: Integer read GetCount;
    property IsUpdating: Boolean read GetIsUpdating;
    // 标记正在插入的记录
    property Inserting: Boolean read GetInserting;
    property Values[FieldNo: Integer]: TsdValue read GetValues; default;
    property Data: Pointer read FData write SetData;
    // 私有指针，暂时仅用于存放IDTree对应节点(树有Link的情况下，存放原始节点)
    property PData: Pointer read FPData;
  end;

{
  TsdIndexData
  索引原理

  数据结构：

  排序后的          |   Field 1 (Level 1)   |   Field 2 (Level 2)   |...
  RecordIndex       | Key Index | Key Value | Key Index | Key Value |...
  -------------------------------------------------------------------
  0                 |           |           |           |           |...
                    |           |           |           |           |
  1                 |           |           |      0    |      1    |...
                    |           |           |           |           |
  2                 |      0    |      6    |           |           |...
                    |           |           |-----------------------|
  3                 |           |           |           |           |...
                    |           |           |      1    |      3    |
  4                 |           |           |           |           |...
                    |-----------------------------------------------|
  5                 |           |           |           |           |...
                    |           |           |      2    |      1    |
  6                 |      1    |      8    |           |           |...
                    |           |           |-----------------------|
  7                 |           |           |      3    |      2    |...
                    |-----------------------------------------------|
  8                 |      2    |     11    |      4    |      1    |...
  -------------------------------------------------------------------

  将索引数据建立成树结构方便维护

  2017/9/25
  此索引结构有一个缺陷，当使用两个或以上字段SetRange时，字段之间并不是and关系，而是根据树结构进行过滤。
  例如，上面的数据SetRange([0, 0], [9, 1])时，只要Filed 1值在1-8之间的记录都会被过滤出来，
  不论Field 2的值是否在0-1之间。因为根据树结构，不管Field 2是什么值，它们都是1-8的子节点。
  此时采用Filter才能过滤出正确的结果。
  对ClientDataSet进行了验证，也是相同的结果，所以暂不进行修改。
}
  EsdIndex = class(Exception);

  TsdIndexNode = class(TObject)
  private
    FOwner: TsdIndex;
    FRecIndex: Integer;
    FParent: TsdIndexNode;
    FPrevSibling: TsdIndexNode;
    FNextSibling: TsdIndexNode;
    FFirstChild: TsdIndexNode;
    FValue: Variant;
    FDataType: TFieldType;
    procedure SetFirstChild(const Value: TsdIndexNode);
    procedure SetNextSibling(const Value: TsdIndexNode);
    procedure SetParent(const Value: TsdIndexNode);
    procedure SetPrevSibling(const Value: TsdIndexNode);
    procedure SetRecIndex(const Value: Integer);
    procedure SetValue(const Value: Variant);
    function GetRecordCount: Integer;
    function GetLastPosterity: TsdIndexNode;
    function GetLastChild: TsdIndexNode;
    function GetChildCount: Integer;
    function GetLevel: Integer;
    procedure SetDataType(const Value: TFieldType);
    function NextNodeByLevel: TsdIndexNode;
    function GetChildren(Index: Integer): TsdIndexNode;
  public
    constructor Create(AOwner: TsdIndex); virtual;
    destructor Destroy; override;
    function HasRecord(ARecord: TsdDataRecord): Boolean;
    property Parent: TsdIndexNode read FParent write SetParent;
    property FirstChild: TsdIndexNode read FFirstChild write SetFirstChild;
    property PrevSibling: TsdIndexNode read FPrevSibling write SetPrevSibling;
    property NextSibling: TsdIndexNode read FNextSibling write SetNextSibling;
    property LastChild: TsdIndexNode read GetLastChild;
    property LastPosterity: TsdIndexNode read GetLastPosterity;
    property RecIndex: Integer read FRecIndex write SetRecIndex;
    property Value: Variant read FValue write SetValue;
    property DataType: TFieldType read FDataType write SetDataType;
    property Level: Integer read GetLevel;
    property Children[Index: Integer]: TsdIndexNode read GetChildren;
    property ChildCount: Integer read GetChildCount;
    property RecordCount: Integer read GetRecordCount;
  end;

  TsdIndexList = class;

  // 索引寻找标志：小于最小值，找到指定索引，在两个值中间，大于最大值，空（索引子节点为空）
  TsdIndexFlag = (sifLessThanMin, sifFoundIndex, sifInTheMid, sifMoreThanMax, sifNull);

  TsdIndex = class(TPersistent)
  private
    FDescend: Boolean;
    FSortNullToLast: Boolean;
    FFieldNames: string;
    FName: string;
    procedure Clear;
    function GetKeyCount(Level: Integer): Integer;
    function GetRecords(Index: Integer): TsdDataRecord;
    function FindExistKeyIndex(ARecordIndex: Integer): Integer;
    procedure SetFieldNames(const Value: string);
    procedure ParseFields;
    function GetLevelCount: Integer;
    procedure SetName(const Value: string);
    function GetDataSet: TsdDataSet;
    procedure SetDescend(const Value: Boolean);
    function GetFields(Index: Integer): TsdField;
    function GetRecordCount: Integer;
  protected
    FOwner: TsdIndexList;
    FDataList: TList;
    FFieldList: TList;
    FIndexNodeList: TList;
    FIndexRoot: TsdIndexNode;
    FChangedList: TList;
    function GetValue(ARecord: TsdDataRecord; ALevel: Integer): Variant; virtual;
    function CompareData(ARec1, ARec2: TsdDataRecord): Integer; virtual;
    function CompareValue(const AValue1, AValue2: Variant): Integer; virtual;
    function CompareIndex(ARec1, ARec2: TsdDataRecord): Integer; virtual;
    procedure Sort; virtual;
    function Check(ARecord: TsdDataRecord): Integer; virtual;
    function FindIndexNode(KeyValues: Variant): TsdIndexNode;
    function KeyCount(KeyValues: Variant): Integer;
    procedure InnerDelete(ARecord: TsdDataRecord); virtual;
    procedure AddChangedRecord(ARecord: TsdDataRecord);
    procedure LoadProperty(Reader: TReader); virtual;
    procedure SaveProperty(Writer: TWriter); virtual;
  public
    constructor Create(AOwner: TsdIndexList); virtual;
    destructor Destroy; override;
    function FindKeyIndex(KeyValues: Variant): Integer;
    function FindKeyLastIndex(KeyValues: Variant): Integer;
    function FindKey(KeyValues: Variant): TsdDataRecord;
    // 找到最接近的索引，找到：返回 True，RecIndex返回索引值；找不到：返回False， RecIndex返回最接近的前一个节点索引值
    function FindNearestKeyIndex(KeyValues: Variant; var RecIndex: Integer;
      AIsEnd: Boolean = False): TsdIndexFlag;
    // for debug
    procedure GetDebugData;
    function SameKeyFields(AFieldNames: string): Boolean;
    function HasKeyFields(AFieldNames: string): Boolean;
    function IsKeyField(AFieldName: string): Boolean;
    function IndexOf(ARecord: TsdDataRecord): Integer;
    procedure AssignRecords(AList: TList);
    function Exchange(const Index1, Index2: Integer): Integer; overload;
    function Exchange(ARecord1, ARecord2: TsdDataRecord): Integer; overload;
    function Insert(ARecord: TsdDataRecord; Index: Integer): Integer;
    procedure Delete(ARecord: TsdDataRecord);
    // 获取指定索引指定关键字的记录列表，KeyValues为空则获取按该索引排序的所有记录
    function RecordsByKey(KeyValues: Variant; List: TList): Integer;
    function RecordCountByKey(KeyValues: Variant): Integer;
    property DataSet: TsdDataSet read GetDataSet;
    property LevelCount: Integer read GetLevelCount;
    // 注意：在DataSet添加了记录，但是还未对索引排序的时候，索引的RecordCount比DataSet少一个
    property RecordCount: Integer read GetRecordCount;
    property Records[Index: Integer]: TsdDataRecord read GetRecords;
    property Fields[Index: Integer]: TsdField read GetFields;
  published
    property Name: string read FName write SetName;
    property FieldNames: string read FFieldNames write SetFieldNames;
    property Descend: Boolean read FDescend write SetDescend default False;
    property SortNullToLast: Boolean read FSortNullToLast write FSortNullToLast default True;
  end;

  TsdIndexList = class(TPersistent)
  private
    FOwner: TsdDataSet;
    FList: TList;
    function GetItems(I: Integer): TsdIndex;
    function GetCount: Integer;
  public
    constructor Create(AOwner: TsdDataSet); virtual;
    destructor Destroy; override;
    procedure Clear;
    procedure ClearData;
    function Add: TsdIndex;
    procedure Delete(Name: string); overload;
    procedure Delete(Index: TsdIndex); overload;
    procedure Exchange(Index1, Index2: TsdIndex);
    function FindByName(Name: string): TsdIndex;
    function FindByKeyFields(KeyFields: string; Partial: Boolean): TsdIndex;
    function IsKeyField(AFieldName: string): Boolean;
    procedure Check(ARecord: TsdDataRecord);
    procedure DeleteRecord(ARecord: TsdDataRecord);
    procedure Sort;
    property Count: Integer read GetCount;
    property Items[I: Integer]: TsdIndex read GetItems; default;
  end;

  // 进度事件，参数AProgress为0-100的整数
  TsdOnProgressEvent = procedure (AProgress: Integer) of object;

  TsdRecordClass = class of TsdDataRecord;

  TsdFieldList = class;
  TsdViewColumn = class;

  TsdField = class(TPersistent)
  private
    FIsKey: Boolean;
    FNeedProcessName: Boolean;
    FOwner: TsdFieldList;
    FDataSize: Integer;
    FFieldName: string;
    FDataType: TFieldType;
    FName: string;
    FInnerValidChars: TFieldChars;
    FValidChars: TFieldChars;
    FLookupList: TList;
    FSize: Integer;
    FPrecision: Integer;
    function GetFieldNo: Integer;
    procedure SetDataSize(const Value: Integer);
    procedure SetFieldName(const Value: string);
    function GetDataSize: Integer;
    procedure SetDataType(const Value: TFieldType);
    function IsBlobField: Boolean;
    function GetDataSet: TsdDataSet;
    procedure RefreshLookup;
    function HasLookup: Boolean;
    procedure ClearLookupField;
    procedure ClearLookupDataSet;
    procedure SetPrecision(const Value: Integer);
    procedure SetSize(const Value: Integer);
  protected
    procedure LoadProperty(Reader: TReader); virtual;
    procedure SaveProperty(Writer: TWriter); virtual;
  public
    constructor Create(AOwner: TsdFieldList); virtual;
    destructor Destroy; override;
    procedure ProcessFieldName(FieldName: string);
    function IsValidChar(InputChar: Char): Boolean; virtual;
    function IsVarField: Boolean;
    procedure AddLookupCol(AViewCol: TsdViewColumn);
    procedure RemoveLookupCol(AViewCol: TsdViewColumn);
    property DataSet: TsdDataSet read GetDataSet;
    property FieldNo: Integer read GetFieldNo;
    property NeedProcessName: Boolean read FNeedProcessName write FNeedProcessName;
    property IsKey: Boolean read FIsKey write FIsKey;
    property ValidChars: TFieldChars read FValidChars write FValidChars;
  published
    property Name: string read FName write FName;
    property DataSize: Integer read GetDataSize write SetDataSize;
    property DataType: TFieldType read FDataType write SetDataType;
    property FieldName: string read FFieldName write SetFieldName;
    // 这两个字段为FmtBcd字段专用
    property Precision: Integer read FPrecision write SetPrecision;
    property Size: Integer read FSize write SetSize;
  end;

  TsdFieldList = class(TPersistent)
  private
    FDataSet: TsdDataSet;
    FList: TList;
    function GetFields(Index: Integer): TsdField;
    function GetCount: Integer;
    procedure ClearLookup;
  protected

  public
    constructor Create(AOwner: TsdDataSet); virtual;
    destructor Destroy; override;
    function Add: TsdField; overload;
    function Add(const FieldName: String; DataType: TFieldType;
      Size: Integer = 0): TsdField; overload;
    procedure Exchange(Field1, Field2: TsdField);
    procedure Clear;
    function Delete(Index: Integer): Boolean;
    function FieldByName(FieldName: string): TsdField;
    property Count: Integer read GetCount;
    property Fields[Index: Integer]: TsdField read GetFields; default;
  end;

  IsdHistoryObject = interface
    ['{58FE79E8-056B-4E1A-AE17-9CA9297EA5D4}']
    procedure Redo(AData: Pointer);
    procedure Undo(AData: Pointer);
    procedure FreeHistoryData(AData: Pointer);
  end;

  TsdRecordEvent = procedure (ARecord: TsdDataRecord) of object;
  TsdAllowRecordEvent = procedure (ARecord: TsdDataRecord; var Allow: Boolean) of object;
  TsdValueEvent = procedure (AValue: TsdValue) of object;
  TsdAllowValueEvent = procedure (AValue: TsdValue; const NewValue: Variant; var Allow: Boolean) of object;
  TsdGetRecordClass = procedure (var ARecordClass: TsdRecordClass) of object;

  TsdDataView = class;
  TsdHistoryList = class;
  TsdHistoryRecord = class;
  TsdOperationManager = class;

  TsdDataSet = class(TComponent{, IsdDataSet})
  private
    FDataList: TList;
    FIndexList: TsdIndexList;
    FFieldList: TsdFieldList;
    FActive: Boolean;
    FRecordClass: TsdRecordClass;
    FProvider: IsdProvider;
    FAutoGetFields: Boolean;
    FHasKey: Boolean;
    FIsLoading: Boolean;
    FUpdateLock: Integer;
    FViewList: TList;
    FOnProgress: TsdOnProgressEvent;
    FBeforeDeleteRecord: TsdAllowRecordEvent;
    FBeforeAddRecord: TsdAllowRecordEvent;
    FAfterDeleteRecord: TsdRecordEvent;
    FAfterAddRecord: TsdRecordEvent;
    FAfterRecordChanged: TsdRecordEvent;
    FDesigner: TObject;
    FIndexDesigner: TObject;
    FStreamedActive: Boolean;
    FLoadDefaultFields: Boolean;
    FOnGetRecordClass: TsdGetRecordClass;
    FDisableCount: Integer;
    FAfterClose: TNotifyEvent;
    FAfterOpen: TNotifyEvent;
    FBeforeValueChange: TsdAllowValueEvent;
    FAfterValueChanged: TsdValueEvent;
    FBeforeRecordUpdate: TsdRecordEvent;
    FAfterRecordUpdated: TsdRecordEvent;
    FChangedLookupFields: TList;
    FKeepPosition: Boolean;
    FFiltered: Boolean;
    FFilter: string;
    FUseSavePoint: Boolean;
    FOperationManager: TsdOperationManager;
    FSavedPoint: Integer;
    function GetRecordCount: Integer;
    function GetRecords(Index: Integer): TsdDataRecord;
    procedure SetActive(const Value: Boolean);
    procedure SetRecordClass(const Value: TsdRecordClass);
    procedure SortDeletedRecords;
    procedure SortIndex;
    procedure ClearIndexData;
    procedure SetOnProgress(const Value: TsdOnProgressEvent);
    procedure CheckIndex(ARec: TsdDataRecord);
    procedure DeleteRecordIndex(ARec: TsdDataRecord);
    function IsDesigning: Boolean;
    function GetProvider: IsdProvider;
    procedure SetProvider(const Value: IsdProvider);
    function InnerLocate(const KeyFields: string; const KeyValues: Variant): TsdDataRecord;
    procedure Changed(const Sender: TObject; AOperation: TsdOperation);
    procedure NotifyChanged(const Sender: TObject;
      AOperation: TsdOperation);
    procedure AddToDeletedList(ARecord: TsdDataRecord);
    function GetHasKey: Boolean;
    procedure ClearViews;
    procedure SetAfterAddRecord(const Value: TsdRecordEvent);
    procedure SetAfterDeleteRecord(const Value: TsdRecordEvent);
    procedure SetAfterRecordChanged(const Value: TsdRecordEvent);
    procedure SetBeforeAddRecord(const Value: TsdAllowRecordEvent);
    procedure SetBeforeDeleteRecord(const Value: TsdAllowRecordEvent);
    procedure DoBeforeAddRecord(ARecord: TsdDataRecord; var Allow: Boolean);
    procedure DoAfterAddRecord(ARecord: TsdDataRecord);
    procedure DoAfterRecordChanged(ARecord: TsdDataRecord);
    procedure DoBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
    procedure DoAfterValueChanged(AValue: TsdValue);
    procedure DoBeforeDeleteRecord(ARecord: TsdDataRecord; var Allow: Boolean);
    procedure DoAfterDeleteRecord(ARecord: TsdDataRecord);
    function GetFieldCount: Integer;
    procedure ProcessFieldNames;
    procedure SetOnGetRecordClass(const Value: TsdGetRecordClass);
    procedure SetAfterClose(const Value: TNotifyEvent);
    procedure SetAfterOpen(const Value: TNotifyEvent);
    procedure SetAfterRecordChange(const Value: TsdRecordEvent);
    procedure SetAfterValueChanged(const Value: TsdValueEvent);
    procedure SetBeforeValueChange(const Value: TsdAllowValueEvent);
    procedure SetAfterRecordUpdated(const Value: TsdRecordEvent);
    procedure SetBeforeRecordUpdate(const Value: TsdRecordEvent);
    procedure DoBeforeRecordUpdate(ARecord: TsdDataRecord);
    procedure DoAfterRecordUpdated(ARecord: TsdDataRecord);
    function GetModified: Boolean;
    procedure CheckChangedLookupFields(AField: TsdField; ARecord: TsdDataRecord = nil);
    procedure IndexDeleted(AIndexName: string);
    procedure SetFilter(const Value: string);
    procedure SetFiltered(const Value: Boolean);
    function GetSavePoint: Integer;
    procedure SetSavePoint(const Value: Integer);
    procedure SetUseSavePoint(const Value: Boolean);
  protected
    FCurrentView: TsdDataView;
    FEventRec: TsdDataRecord;
    FDeletedList: TList;
    FChangedList: TList;
    FHistory: TsdHistoryList;
    FTableName: string;
    FEnableValueEvents: Boolean;
    function CreateRecord: TsdDataRecord; virtual;
    procedure LoadRecords; virtual;
    procedure SaveRecords; virtual;
    procedure ClearRecords(AClearAutoFields: Boolean); virtual;
    procedure InitRecord(ARecord: TsdDataRecord);
    function AddRecord(ARecord: TsdDataRecord; NeedBeginUpdate: Boolean = False): Integer; virtual;
    function RemoveRecord(ARec: TsdDataRecord; FreeRecord: Boolean = True): Boolean; virtual;
    procedure RenumberIndex(AFromIndex: Integer = 0);
    procedure DeleteRecNo(ARecNo: Integer);
    procedure InsertRecNo(ARecNo: Integer);
    procedure ClearDeletedList;
    procedure ClearChangedList;
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadFields(Stream: TStream);
    procedure WriteFields(Stream: TStream);
    procedure ReadIndexes(Stream: TStream);
    procedure WriteIndexes(Stream: TStream);
    procedure Loaded; override;
    procedure CheckActive;
    procedure CheckForSave;
    procedure CancelRecord(ARecord: TsdDataRecord);
    // 根据AFields比较记录，-1: ARec1 < ARec2; 0: ARec1 = ARec2; 1: ARec1 > ARec2
    function CompareRec(ARec1, ARec2: TsdDataRecord; AKeyFields: string): Integer;
    // 根据AFields对AList中的记录排序
    procedure SortList(AList: TList; AKeyFields: string);
    property HasKey: Boolean read GetHasKey;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Save;
    procedure BeginLoad;
    procedure EndLoad;
    procedure BeginUpdate;
    procedure EndUpdate;
    function IsUpdating: Boolean;
    procedure BeginUpdateHistoryRecord(ARecord: TsdDataRecord);
    procedure EndUpdateHistoryRecord;
    procedure RegisterView(AView: TObject);
    procedure UnregisterView(AView: TObject);
    procedure GetFieldNames(AFieldNames: TStringList);
    function FieldByName(AFieldName: string): TsdField;
    function Add(NeedBeginUpdate: Boolean = False): TsdDataRecord;
    function AddField(const FieldName: string): TsdField;
    function AddIndex(const Name, Fields: string): TsdIndex;
    function Delete(AIndex: Integer): Boolean;
    procedure DeleteAll;
    procedure ClearIndex;
    function Remove(ARec: TsdDataRecord): Boolean;
    function IndexOf(ARecord: TsdDataRecord): Integer;
    function FindKey(AIndexName: string; KeyValues: Variant): TsdDataRecord;
    function FindIndex(AIndexName: string): TsdIndex;
    function Locate(const KeyFields: string; const KeyValues: Variant): TsdDataRecord;
    function Lookup(const KeyFields: string; const KeyValues: Variant;
      const ResultFields: string): Variant;
    // 获取指定索引指定关键字的记录列表，KeyValues为空则获取按该索引排序的所有记录
    function RecordsByKey(const AIndexName: string; const KeyValues: Variant;
      List: TList): Integer;
    procedure AssignRecords(AList: TList);
    function ControlsDisabled: Boolean;
    procedure DisableControls;
    procedure EnableControls;
    function CurrentView: TsdDataView;
    procedure LoadFromXML(AFileName: string);
    procedure SaveToXML(AFileName: string);
    procedure FreeProviderNotify;
    procedure Reload;
    procedure SortByFields(const KeyFields: string; AList: TList);
    procedure FilterBy(const AFilter: string; AList: TList;
      AKeyFields: string = '');
    procedure ClearCurrentView;
    // 供外部对象（IsdHistoryObject）记录额外信息
    procedure WriteHistoryData(AOperation: TsdOperation; AObject: IsdHistoryObject; AData: Pointer);
    procedure Undo(AID: Integer);
    procedure Redo(AID: Integer);
    // 挂起，暂停操作记录
    procedure SuspendHistory;
    // 继续记录
    procedure ResumeHistory;
    property RecordClass: TsdRecordClass read FRecordClass write SetRecordClass;
    property RecordCount: Integer read GetRecordCount;
    property FieldCount: Integer read GetFieldCount;
    property Records[Index: Integer]: TsdDataRecord read GetRecords; default;
    property Designer: TObject read FDesigner write FDesigner;
    property IndexDesigner: TObject read FIndexDesigner write FIndexDesigner;
    property LoadDefaultFields: Boolean read FLoadDefaultFields write FLoadDefaultFields;
    property Modified: Boolean read GetModified;
    property SavePoint: Integer read GetSavePoint write SetSavePoint;
    // 保存到数据库的SavePoint
    property SavedPoint: Integer read FSavedPoint;
    property TableName: string read FTableName;
    property OperationManager: TsdOperationManager read FOperationManager;
  published
    property Active: Boolean read FActive write SetActive;
    property Fields: TsdFieldList read FFieldList;
    property Filter: string read FFilter write SetFilter;
    property Filtered: Boolean read FFiltered write SetFiltered;
    property IndexList: TsdIndexList read FIndexList;
    property Provider: IsdProvider read GetProvider write SetProvider;
    property UseSavePoint: Boolean read FUseSavePoint write SetUseSavePoint;
    property BeforeAddRecord: TsdAllowRecordEvent read FBeforeAddRecord write SetBeforeAddRecord;
    property AfterAddRecord: TsdRecordEvent read FAfterAddRecord write SetAfterAddRecord;
    property BeforeDeleteRecord: TsdAllowRecordEvent read FBeforeDeleteRecord write SetBeforeDeleteRecord;
    property AfterDeleteRecord: TsdRecordEvent read FAfterDeleteRecord write SetAfterDeleteRecord;
    property AfterRecordChanged: TsdRecordEvent read FAfterRecordChanged write SetAfterRecordChanged;
    property BeforeValueChange: TsdAllowValueEvent read FBeforeValueChange write SetBeforeValueChange;
    property AfterValueChanged: TsdValueEvent read FAfterValueChanged write SetAfterValueChanged;
    property BeforeRecordUpdate: TsdRecordEvent read FBeforeRecordUpdate write SetBeforeRecordUpdate;
    property AfterRecordUpdated: TsdRecordEvent read FAfterRecordUpdated write SetAfterRecordUpdated;
    property AfterClose: TNotifyEvent read FAfterClose write SetAfterClose;
    property AfterOpen: TNotifyEvent read FAfterOpen write SetAfterOpen;
    property OnProgress: TsdOnProgressEvent read FOnProgress write SetOnProgress;
    property OnGetRecordClass: TsdGetRecordClass read FOnGetRecordClass write SetOnGetRecordClass;
  end;

  EsdDataView = class(Exception);

  TsdViewColumn = class(TCollectionItem)
  private
    FFieldName: string;
    FField: TsdField;
    FDisplayFormat: string;
    FEditFormat: string;
    FLookupField: TsdField;
    FKeyFields: string;
    FLookupKeyFields: string;
    FLookupResultField: string;
    FLookupDataSet: TsdDataSet;
    FData: Pointer;
    procedure SetFieldName(const Value: string);
    procedure SetDisplayFormat(const Value: string);
    procedure SetEditFormat(const Value: string);
    function GetDataView: TsdDataView;
    function GetIsLookup: Boolean;
    procedure SetKeyFields(const Value: string);
    procedure SetLookupDataSet(const Value: TsdDataSet);
    procedure SetLookupKeyFields(const Value: string);
    procedure SetLookupResultField(const Value: string);
    procedure CheckLookupField;
    procedure LookupChanged;
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    function FormatText(Value: TsdValue; DisplayText: Boolean): string;
    procedure Assign(Source: TPersistent); override;
    property Field: TsdField read FField;
    property LookUpField: TsdField read FLookupField;
    property DataView: TsdDataView read GetDataView;
    property IsLookup: Boolean read GetIsLookup;
    property Data: Pointer read FData write FData;
  published
    property FieldName: string read FFieldName write SetFieldName;
    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
    property EditFormat: string read FEditFormat write SetEditFormat;
    property KeyFields: string read FKeyFields write SetKeyFields;
    property LookupDataSet: TsdDataSet read FLookupDataSet write SetLookupDataSet;
    property LookupKeyFields: string read FLookupKeyFields write SetLookupKeyFields;
    property LookupResultField: string read FLookupResultField write SetLookupResultField;
  end;

  TsdViewColumnClass = class of TsdViewColumn;

  TsdViewColumnList = class(TCollection)
  private
    FDataView: TsdDataView;
    function GetItem(Index: Integer): TsdViewColumn;
    procedure SetItem(Index: Integer; const Value: TsdViewColumn);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(ADataView: TsdDataView; ItemClass: TsdViewColumnClass);
    function Add: TsdViewColumn;
    function IndexByName(const AFieldName: string): Integer;
    function FindColumn(const AFieldName: string): TsdViewColumn;
    procedure Assign(Source: TPersistent); override;
    property DataView: TsdDataView read FDataView;
    property Items[Index: Integer]: TsdViewColumn read GetItem write SetItem; default;
  end;

  TsdColumnGetTextEvent = procedure (var Text: string; ARecord: TsdDataRecord;
    AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean) of object;
  TsdColumnSetTextEvent = procedure (var Text: string; ARecord: TsdDataRecord;
    AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean) of object;
  TsdNeedLookupRecordEvent = procedure (ARecord: TsdDataRecord;
    AColumn: TsdViewColumn; ANewText: string) of object;
  TsdCustomSortEvent = procedure (RecordList: TList) of object;

  TsdDataView = class(TComponent)
  private
    FActive: Boolean;
    FStreamedActive: Boolean;
    FDataList: TList;
    FIndexName: string;
    FIndex: TsdIndex;
    FOnFilterRecord: TsdAllowRecordEvent;
    FDataSet: TsdDataSet;
    FColumns: TsdViewColumnList;
    FOnGetText: TsdColumnGetTextEvent;
    FOnSetText: TsdColumnSetTextEvent;
    FFiltered: Boolean;
    FRangeFrom: Variant;
    FRangeTo: Variant;
    FControlList: TInterfaceList;
    FCurrent: TsdDataRecord;
    FCurrentIndex: Integer;
    FBeforeDeleteRecord: TsdAllowRecordEvent;
    FBeforeAddRecord: TsdAllowRecordEvent;
    FBeforeValueChange: TsdAllowValueEvent;
    FAfterAddRecord: TsdRecordEvent;
    FAfterDeleteRecord: TsdRecordEvent;
    FAfterValueChanged: TsdValueEvent;
    FBeforeSortAddedRecord: TsdRecordEvent;
    FAfterClose: TNotifyEvent;
    FAfterOpen: TNotifyEvent;
    FOnCurrentChanged: TsdRecordEvent;
    FOnNeedLookupRecord: TsdNeedLookupRecordEvent;
    FRangeLock: Integer;
    FAfterRecordChanged: TsdRecordEvent;
    FMasterField: string;
    FKeyField: string;
    FMasterDataView: TsdDataView;
    FDetailList: TList;
    FFilterHelper: TsdLogicalExprs;
    FFilter: string;
    FNewCurrent: TsdDataRecord;
    FCurrentChanging: Boolean;
    FOnCustomSort: TsdCustomSortEvent;
    FBeforeCurrentChange: TsdRecordEvent;
    FOldCurrentIndex: Integer;
    FOldCurrent: TsdDataRecord;
    FAutoGetFields: Boolean; 
    function GetFieldCount: Integer;
    function GetIndex: TsdIndex;
    function GetRecord(Index: Integer): TsdDataRecord;
    function GetRecordCount: Integer;
    procedure SetActive(const Value: Boolean);
    procedure SetDataSet(const Value: TsdDataSet);
    procedure SetIndexName(const Value: string);
    procedure SetOnFilterRecord(const Value: TsdAllowRecordEvent);
    function GetDisplayText(RecIndex, Col: Integer): string;
    function GetText(RecIndex, Col: Integer): string;
    procedure SetText(RecIndex, Col: Integer; const Value: string);
    procedure SetOnGetText(const Value: TsdColumnGetTextEvent);
    procedure SetOnSetText(const Value: TsdColumnSetTextEvent);
    procedure SetFiltered(const Value: Boolean);
    function GetValue(RecIndex, Col: Integer): TsdValue; overload;
    function GetValue(RecIndex, Col: Integer; var NeedLookupRecord: Boolean): TsdValue; overload;
    procedure FilterRecords;
    function FilterRecord(ARecord: TsdDataRecord): Boolean;
    procedure InitRecords;
    procedure ResetIndex;
    procedure RefreshRange;
    function CheckRange(ARecord: TsdDataRecord; AValue: TsdValue = nil): Integer;
    procedure SetAfterAddRecord(const Value: TsdRecordEvent);
    procedure SetAfterDeleteRecord(const Value: TsdRecordEvent);
    procedure SetAfterValueChanged(const Value: TsdValueEvent);
    procedure SetBeforeAddRecord(const Value: TsdAllowRecordEvent);
    procedure SetBeforeDeleteRecord(const Value: TsdAllowRecordEvent);
    procedure SetBeforeValueChange(const Value: TsdAllowValueEvent);
    procedure SetBeforeSortAddedRecord(const Value: TsdRecordEvent);
    procedure SetColumns(const Value: TsdViewColumnList);
    procedure NotifyDataChanged(RecIndex: Integer = -1);
    procedure SetAfterClose(const Value: TNotifyEvent);
    procedure SetAfterOpen(const Value: TNotifyEvent);
    procedure DoBeforeAddRecord(ARecord: TsdDataRecord; var Allow: Boolean);
    procedure DoAfterAddRecord(ARecord: TsdDataRecord);
    procedure DoBeforeDeleteRecord(ARecord: TsdDataRecord; var Allow: Boolean);
    procedure DoAfterDeleteRecord(ARecord: TsdDataRecord);
    procedure DoBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
    procedure DoAfterValueChanged(AValue: TsdValue);
    procedure DoAfterRecordChanged(ARecord: TsdDataRecord);
    procedure DoBeforeSortAddedRecord(ARecord: TsdDataRecord);
    procedure DoOnGetText(var Text: string; ARecord: TsdDataRecord;
      AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean);
    procedure DoOnSetText(var Text: string; ARecord: TsdDataRecord;
      AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean);
    procedure DoCustomSort(RecordList: TList);
    procedure DoBeforeCurrentChange(ARecord: TsdDataRecord);
    procedure DoOnCurrentChanged(ARecord: TsdDataRecord);
    function GetCurrent: TsdDataRecord;
    procedure SetOnCurrentChanged(const Value: TsdRecordEvent);
    procedure RefreshField(AViewColumn: TsdViewColumn);
    procedure AddLookupRecord(ARecIndex, ACol: Integer; Text: string);
    procedure SetOnNeedLookupRecord(const Value: TsdNeedLookupRecordEvent);
    procedure NotifyControlActiveChanged;
    procedure NotifyControlDataViewChanged;
    procedure NotifyControlDataChanged(RecIndex: Integer = -1);
    procedure NotifyControlFieldChanged(AFieldName: string);
    procedure NotifyControlActiveRecordChanged(RecIndex: Integer);
    procedure SetValueText(AValue: TsdValue; ARecord: TsdDataRecord; var Text: string; AColumn: TsdViewColumn);
    function GetColumns(Index: Integer): TsdViewColumn;
    function GetRangeLocked: Boolean;
    procedure SetAfterRecordChanged(const Value: TsdRecordEvent);
    function GetCurrentIndex: Integer;
    procedure SetCurrentIndex(const Value: Integer);
    procedure CheckCurrent(AReset: Boolean = False);
    procedure ResetCurrent;
    procedure SetKeyField(const Value: string);
    procedure SetMasterDataView(const Value: TsdDataView);
    procedure SetMasterField(const Value: string);
    function IsDetail: Boolean;
    procedure SetFilter(const Value: string);
    procedure ParseFilter;
    procedure SetOnCustomSort(const Value: TsdCustomSortEvent);
    procedure SetBeforeCurrentChange(const Value: TsdRecordEvent);
  protected
    procedure Loaded; override;
    procedure ReloadFields;
    procedure ChangeCurrent;
    procedure MasterChanged(ACurrent: TsdDataRecord);
    procedure RegisterDetail(ADetail: TsdDataView);
    procedure UnRegisterDetail(ADetail: TsdDataView);
    procedure ClearMasterDataView;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure RefreshFilter;
    function IndexOf(ARecord: TsdDataRecord): Integer;
    function Append(NeedBeginUpdate: Boolean = False): TsdDataRecord;
    function Insert(Index: Integer; NeedBeginUpdate: Boolean = False): TsdDataRecord;
    function Delete(Index: Integer): Boolean;
    function Remove(ARecord: TsdDataRecord): Boolean;
    // edit方法是为了表示从View触发的修改，必须与BeginUpdate和EndUpdate一起使用
    procedure Edit(ARecord: TsdDataRecord);
    function Exchange(const Index1, Index2: Integer): Integer;
    // SetRange时，前一个参数为nil表示最小值，后一个参数为nil则表示最大值
    // 注意主从关系与SetRange冲突，但都可以叠加Filter
    procedure SetRange(const StartValues, EndValues: array of const);
    procedure CancelRange;
    procedure BeginLockRange;
    procedure EndLockRange(ARefresh: Boolean);
    procedure Changed(const Sender: TObject; AOperation: TsdOperation);
    procedure PrepareNewCurrent(ARecord: TsdDataRecord);
    procedure FreeNotify;
    procedure RegisterControl(Control: IsdViewControl);
    procedure UnRegisterControl(Control: IsdViewControl);
    procedure LoadDefaultColumns;
    function FindColumn(const AFieldName: string): TsdViewColumn;
    procedure GetFieldNames(AFieldNames: TStringList);
    function LocateInControl(ARecord: TsdDataRecord): Boolean; overload;
    function LocateInControl(const KeyFields: string; const KeyValues: Variant): Boolean; overload;
    // DataView的Locate未使用索引，效率较低，一般不用
    function Locate(const KeyFields: string; const KeyValues: Variant): TsdDataRecord;
    procedure First;
    procedure Last;
    procedure SaveToXML(AFileName: string);
    procedure AssignRecords(AList: TList);
    property DataSetIndex: TsdIndex read GetIndex;
    property Records[Index: Integer]: TsdDataRecord read GetRecord; default;
    property RecordCount: Integer read GetRecordCount;
    property DisplayText[RecIndex, Col: Integer]: string read GetDisplayText;
    property Text[RecIndex, Col: Integer]: string read GetText write SetText;
    property FieldCount: Integer read GetFieldCount;
    property Column[Index: Integer]: TsdViewColumn read GetColumns;
    // 目前只有调用LocateInControl后Current才有意义
    property Current: TsdDataRecord read GetCurrent;
    property CurrentIndex: Integer read GetCurrentIndex write SetCurrentIndex;
    property RangeLocked: Boolean read GetRangeLocked;
  published
    property Active: Boolean read FActive write SetActive;
    property DataSet: TsdDataSet read FDataSet write SetDataSet;
    property Filter: string read FFilter write SetFilter;
    property Filtered: Boolean read FFiltered write SetFiltered;
    property IndexName: string read FIndexName write SetIndexName;
    property Columns: TsdViewColumnList read FColumns write SetColumns stored True;
    property MasterDataView: TsdDataView read FMasterDataView write SetMasterDataView;
    property MasterField: string read FMasterField write SetMasterField;
    property KeyField: string read FKeyField write SetKeyField;
    property BeforeAddRecord: TsdAllowRecordEvent read FBeforeAddRecord write SetBeforeAddRecord;
    property BeforeSortAddedRecord: TsdRecordEvent read FBeforeSortAddedRecord write SetBeforeSortAddedRecord;
    property AfterAddRecord: TsdRecordEvent read FAfterAddRecord write SetAfterAddRecord;
    property BeforeDeleteRecord: TsdAllowRecordEvent read FBeforeDeleteRecord write SetBeforeDeleteRecord;
    property AfterDeleteRecord: TsdRecordEvent read FAfterDeleteRecord write SetAfterDeleteRecord;
    property BeforeValueChange: TsdAllowValueEvent read FBeforeValueChange write SetBeforeValueChange;
    property AfterValueChanged: TsdValueEvent read FAfterValueChanged write SetAfterValueChanged;
    property AfterRecordChanged: TsdRecordEvent read FAfterRecordChanged write SetAfterRecordChanged;
    property AfterClose: TNotifyEvent read FAfterClose write SetAfterClose;
    property AfterOpen: TNotifyEvent read FAfterOpen write SetAfterOpen;
    property OnFilterRecord: TsdAllowRecordEvent read FOnFilterRecord write SetOnFilterRecord;
    property BeforeCurrentChange: TsdRecordEvent read FBeforeCurrentChange write SetBeforeCurrentChange;
    property OnCurrentChanged: TsdRecordEvent read FOnCurrentChanged write SetOnCurrentChanged;
    property OnGetText: TsdColumnGetTextEvent read FOnGetText write SetOnGetText;
    property OnSetText: TsdColumnSetTextEvent read FOnSetText write SetOnSetText;
    property OnNeedLookupRecord: TsdNeedLookupRecordEvent read FOnNeedLookupRecord write SetOnNeedLookupRecord;
    property OnCustomSort: TsdCustomSortEvent read FOnCustomSort write SetOnCustomSort;
  end;

  TsdAggregator = class(TComponent)
  private
    FIndex: TsdIndex;
    FIndexName: string;
    FDataSet: TsdDataSet;
    procedure SetDataSet(const Value: TsdDataSet);
    procedure SetIndexName(const Value: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Aggregate(const KeyValues: Variant; const FieldName: string): Variant;
  published
    property DataSet: TsdDataSet read FDataSet write SetDataSet;
    property IndexName: string read FIndexName write SetIndexName;
  end;

  // 以下类为主从表Map类，以便快速根据主表关键字对从表排序，
  // 具体算法可见《有序双列表遍历算法》
  // 对于DataSet，使用TsdDataSetMasterDetailMap，主从关键字段必须有相应的Index
  // 对于DataView，使用TsdDataViewMasterDetailMap，主从关键字段必须是DataView已使用的Index
  // 用法：设置好主从表，关键字，调用CreateMap方法
  // Map.Items[I]为主表记录对象，Map.Items[I].DetailRecords为从表对象列表
  // 可参考ProjectGLJ的GatherAll等方法
  // 可通过ItemByRecord方法组合多个Map
  // 需要过滤时，可以使用TsdListMasterDetailMap,对过滤好的List进行Map
  TsdMasterItem = class;
  TsdMasterDetailMap = class;

  TsdDetailList = class(TObject)
  private
    FMasterItem: TsdMasterItem;
    FList: TList;
    function GetCount: Integer;
    function GetRecords(Index: Integer): TsdDataRecord;
    procedure Add(ARecord: TsdDataRecord);
  public
    constructor Create(AMasterItem: TsdMasterItem); virtual;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Records[Index: Integer]: TsdDataRecord read GetRecords; default;
  end;

  TsdMasterItem = class(TObject)
  private
    FMap: TsdMasterDetailMap;
    FList: TsdDetailList;
    FRec: TsdDataRecord;
    function GetRecords(Index: Integer): TsdDataRecord;
    function GetCount: Integer;
    procedure AddDetailRec(ARecord: TsdDataRecord);
  public
    constructor Create(AMap: TsdMasterDetailMap); virtual;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Rec: TsdDataRecord read FRec;
    property DetailRecords[Index: Integer]: TsdDataRecord read GetRecords; default;
  end;

  // 比较记录值事件，AResult：-1：主表值小，0：相等，1:从表值小
  TsdCompareValuesEvent = procedure (MasterRecord, DetailRecord: TsdDataRecord;
    var AResult: Integer) of object;

  EsdMasterDetailMap = class(Exception);

  TsdMasterDetailMap = class(TObject)
  private
    FList: TList;
    FDetailField: string;
    FMasterField: string;
    FOnCompareValues: TsdCompareValuesEvent;
    function GetCount: Integer;
    function GetItems(Index: Integer): TsdMasterItem;
    procedure SetDetailField(const Value: string);
    procedure SetMasterField(const Value: string);
    procedure SetOnCompareValues(const Value: TsdCompareValuesEvent);
    procedure CompareValues(MasterRecord, DetailRecord: TsdDataRecord; var AResult: Integer);
  protected
    FMasterIndex: TsdIndex;
    FDetailIndex: TsdIndex;
    function GetMasterRecordCount: Integer; virtual; abstract;
    function GetMasterRecords(AIndex: Integer): TsdDataRecord; virtual; abstract;
    function GetDetailRecords(AIndex: Integer): TsdDataRecord; virtual; abstract;
    function GetDetailRecordCount: Integer; virtual; abstract;
    function CheckMasterIndex: Boolean; virtual;
    function CheckDetailIndex: Boolean; virtual;
    property MasterField: string read FMasterField write SetMasterField;
    property DetailField: string read FDetailField write SetDetailField;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure CreateMap;
    function ItemByRecord(ARecord: TsdDataRecord): TsdMasterItem;
    function ItemByDetailRecord(ARecord: TsdDataRecord): TsdMasterItem;
    function RecordByDetailRecord(ARecord: TsdDataRecord): TsdDataRecord;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TsdMasterItem read GetItems; default;
    property OnCompareValues: TsdCompareValuesEvent read FOnCompareValues write SetOnCompareValues;
  end;

  TsdDataSetMasterDetailMap = class(TsdMasterDetailMap)
  private
    FMasterDataSet: TsdDataSet;
    FDetailDataSet: TsdDataSet;
    procedure SetDetailDataSet(const Value: TsdDataSet);
    procedure SetMasterDataSet(const Value: TsdDataSet);

  protected
    function GetMasterRecordCount: Integer; override;
    function GetMasterRecords(AIndex: Integer): TsdDataRecord; override;
    function GetDetailRecordCount: Integer; override;
    function GetDetailRecords(AIndex: Integer): TsdDataRecord; override;
    function CheckMasterIndex: Boolean; override;
    function CheckDetailIndex: Boolean; override;
  public

  published
    property MasterField;
    property DetailField;
    property MasterDataSet: TsdDataSet read FMasterDataSet write SetMasterDataSet;
    property DetailDataSet: TsdDataSet read FDetailDataSet write SetDetailDataSet;
    property OnCompareValues;
  end;

  TsdDataViewMasterDetailMap = class(TsdMasterDetailMap)
  private
    FMasterDataView: TsdDataView;
    FDetailDataView: TsdDataView;
    procedure SetDetailDataView(const Value: TsdDataView);
    procedure SetMasterDataView(const Value: TsdDataView);

  protected
    function GetMasterRecordCount: Integer; override;
    function GetMasterRecords(AIndex: Integer): TsdDataRecord; override;
    function GetDetailRecordCount: Integer; override;
    function GetDetailRecords(AIndex: Integer): TsdDataRecord; override;
    function CheckMasterIndex: Boolean; override;
    function CheckDetailIndex: Boolean; override;
  public

  published
    property MasterField;
    property DetailField;
    property MasterDataView: TsdDataView read FMasterDataView write SetMasterDataView;
    property DetailDataView: TsdDataView read FDetailDataView write SetDetailDataView;
    property OnCompareValues;
  end;

  TsdListMasterDetailMap = class(TsdMasterDetailMap)
  private
    FMasterList: TList;
    FDetailList: TList;
    procedure SetDetailList(const Value: TList);
    procedure SetMasterList(const Value: TList);
  protected
    function GetMasterRecordCount: Integer; override;
    function GetMasterRecords(AIndex: Integer): TsdDataRecord; override;
    function GetDetailRecordCount: Integer; override;
    function GetDetailRecords(AIndex: Integer): TsdDataRecord; override;
    function CheckMasterIndex: Boolean; override;
    function CheckDetailIndex: Boolean; override;
  public

  published
    property MasterField;
    property DetailField;
    property MasterList: TList read FMasterList write SetMasterList;
    property DetailList: TList read FDetailList write SetDetailList;
    property OnCompareValues;
  end;
  //function FieldTypeToVar(AFieldType: TFieldType): Integer;

  TsdOperationItem = class;

  TsdOperationBeforeEvent = procedure (AItem: TsdOperationItem; var CanDo: Boolean) of object;
  TsdOperationAfterEvent = procedure (AItem: TsdOperationItem) of object;
  TsdOperationDataSetBeforeEvent = procedure (ADataSet: TsdDataSet; ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord; AFields: TStrings; AData: Pointer; var CanDo: Boolean) of object;
  TsdOperationDataSetAfterEvent = procedure (ADataSet: TsdDataSet; ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord; AFields: TStrings; AData: Pointer) of object;

  TsdOperationManager = class(TObject)
  private
    FItems: TList;
    FDataSets: TList;
    FLimitedCount: Integer;
    FSnapShooting: Boolean;
    FNeedConfirmSnapShoot: Boolean;
    FDataSetBeforeUndo: TsdOperationDataSetBeforeEvent;
    FDataSetAfterUndo: TsdOperationDataSetAfterEvent;
    FSavePoint: Integer;
    FDataSetBeforeRedo: TsdOperationDataSetBeforeEvent;
    FDataSetAfterRedo: TsdOperationDataSetAfterEvent;
    FActive: Boolean;
    FAfterRedo: TsdOperationAfterEvent;
    FAfterUndo: TsdOperationAfterEvent;
    FBeforeUndo: TsdOperationBeforeEvent;
    FBeforeRedo: TsdOperationBeforeEvent;
    procedure DoBeforeUndo(AItem: TsdOperationItem; var CanDo: Boolean);
    procedure DoAfterUndo(AItem: TsdOperationItem);
    procedure DoBeforeRedo(AItem: TsdOperationItem; var CanDo: Boolean);
    procedure DoAfterRedo(AItem: TsdOperationItem);
    procedure DoDataSetBeforeUndo(ADataSet: TsdDataSet; ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord; AFields: TStrings; AData: Pointer; var CanDo: Boolean);
    procedure DoDataSetAfterUndo(ADataSet: TsdDataSet; ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord; AFields: TStrings; AData: Pointer);
    procedure DoDataSetBeforeRedo(ADataSet: TsdDataSet; ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord; AFields: TStrings; AData: Pointer; var CanDo: Boolean);
    procedure DoDataSetAfterRedo(ADataSet: TsdDataSet; ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord; AFields: TStrings; AData: Pointer);
    function GetCount: Integer;
    function GetItems(I: Integer): TsdOperationItem;
    function GetDataSet(I: Integer): TsdDataSet;
    function GetDataSetCount: Integer;
    procedure SetLimitedCount(const Value: Integer);
    function NewID: Integer;
    procedure SetDataSetAfterUndo(const Value: TsdOperationDataSetAfterEvent);
    procedure SetDataSetBeforeUndo(const Value: TsdOperationDataSetBeforeEvent);
    function FindPrev(AID: Integer): TsdOperationItem;
    function FindNext(AID: Integer): TsdOperationItem;
    procedure SetDataSetAfterRedo(const Value: TsdOperationDataSetAfterEvent);
    procedure SetDataSetBeforeRedo(const Value: TsdOperationDataSetBeforeEvent);
    procedure ClearNewerItems;
    procedure SetActive(const Value: Boolean);
    procedure SetAfterRedo(const Value: TsdOperationAfterEvent);
    procedure SetAfterUndo(const Value: TsdOperationAfterEvent);
    procedure SetBeforeRedo(const Value: TsdOperationBeforeEvent);
    procedure SetBeforeUndo(const Value: TsdOperationBeforeEvent);
    function GetModified: Boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure RegisterDataSet(ADataSet: TsdDataSet);
    procedure UnRegisterDataSet(ADataSet: TsdDataSet);
    // 生成快照, 返回ID
    // (BeginSnapShoot: 强制开始快照，调用EndSnapShoot之前的SnapShoot都被略过)
    // (NeedConfirm: 需确认。某些情况要在后面才确认当前是否进行了操作，所以在后面通过Confirm和Cancel确认/取消SnapShoot)
    function SnapShoot(AName: string; BeginSnapShoot: Boolean = False; NeedConfirm: Boolean = False): Integer;
    // 某些情况需要单独BeginSnapShoot
    procedure BeginSnapShoot;
    procedure EndSnapShoot;
    procedure Confirm;
    procedure Cancel;
    // 挂起，暂停所有操作记录
    procedure Suspend;
    // 继续记录
    procedure Resume;
    // 重命名当前操作(因为很多时候生产快照时不知道当前操作如何命名，所以需要提供一个方法在后面命名当前操作)
    // 注意如果BeginSnapShoot=True则要在EndSnapShoot后才能Rename
    procedure RenameCurrentItem(AName: string);
    // 撤销到指定ID的快照
    procedure Undo(AID: Integer = -1);
    // 重做到指定ID的快照
    procedure Redo(AID: Integer = -1);
    // 重置到当前SavePoint(因为保存的时候还会进行很多计算，所以undo之后再保存，就跟后面的redo对不上了。所以必须在保存前清理掉SavePoint后面的操作记录)
    procedure Reset;
    // 若SavePoint不是最新则Reset，用于添加新操作记录时检查用
    procedure ResetWhenNecessary;
    function FindItem(AID: Integer): TsdOperationItem;
    function IndexByID(AID: Integer): Integer;
    procedure OperationList(AList: TStrings; Undo: Boolean);
    function UndoCount: Integer;
    function RedoCount: Integer;
    function CurrentUndoName: string;
    function CurrentRedoName: string;
    // 调试用，输出当前数据集
    procedure SaveHistory(AFileName: string);
    property Active: Boolean read FActive write SetActive;
    property Count: Integer read GetCount;
    property Items[I: Integer]: TsdOperationItem read GetItems;
    property DataSetCount: Integer read GetDataSetCount;
    property DataSet[I: Integer]: TsdDataSet read GetDataSet;
    property LimitedCount: Integer read FLimitedCount write SetLimitedCount;
    // SavePoint指当前操作ID，最新操作是最大ID+1，是一个虚拟ID
    property SavePoint: Integer read FSavePoint;
    property Modified: Boolean read GetModified;
    property BeforeUndo: TsdOperationBeforeEvent read FBeforeUndo write SetBeforeUndo;
    property AfterUndo: TsdOperationAfterEvent read FAfterUndo write SetAfterUndo;
    property BeforeRedo: TsdOperationBeforeEvent read FBeforeRedo write SetBeforeRedo;
    property AfterRedo: TsdOperationAfterEvent read FAfterRedo write SetAfterRedo;
    property DataSetBeforeUndo: TsdOperationDataSetBeforeEvent read FDataSetBeforeUndo write SetDataSetBeforeUndo;
    property DataSetAfterUndo: TsdOperationDataSetAfterEvent read FDataSetAfterUndo write SetDataSetAfterUndo;
    property DataSetBeforeRedo: TsdOperationDataSetBeforeEvent read FDataSetBeforeRedo write SetDataSetBeforeRedo;
    property DataSetAfterRedo: TsdOperationDataSetAfterEvent read FDataSetAfterRedo write SetDataSetAfterRedo;
  end;

  PsdHistoryInfo = ^TsdHistoryInfo;

  TsdHistoryInfo = record
    DataSet: TsdDataSet;
    StartPoint: Integer;
    EndPoint: Integer;
  end;

  TsdOperationItem = class(TObject)
  private
    FOwner: TsdOperationManager;
    FInfos: TList;
    FID: Integer;
    FName: string;
    procedure EndSnap;
  public
    constructor Create(AOwner: TsdOperationManager; AID: Integer; AName: string); virtual;
    destructor Destroy; override;
    procedure SnapShoot;
    procedure Undo;
    procedure Redo;
    procedure Clear;
    // 清除新的记录，包括自己
    procedure ClearNewerHistoryRecord;
    // 清除旧的记录，不包括自己
    procedure ClearOlderHistoryRecord;
    property ID: Integer read FID;
    property Name: string read FName;
  end;

  EsdHistory = class(Exception);

  TsdHistoryValue = class;

  TsdHistoryList = class(TObject)
  private
    FDataSet: TsdDataSet;
    FSavePoint: Integer;
    FUpdateRecordLock: Integer;
    FAdding: Boolean;
    FStopping: Integer;
    function LastID: Integer;
    procedure SetSavePoint(const Value: Integer);
    function GetSavePoint: Integer;
    function IndexByID(AID: Integer): Integer;
    // 新增/删除操作中缓存的DataRecord要视条件清理，所以不能在TsdHistoryRecord的Free中释放DataRecord，而在释放本对象时单独写一个全部清理方法
    procedure ClearAllDataRecords;
    function FindLastValue(AValue: TsdValue): TsdHistoryValue;
    function FindLastRecord(ARecord: TsdDataRecord): TsdHistoryRecord;
    function GetStopping: Boolean;
  protected
    FRecList: TList;
    FLastHistoryRecords: TList;
    function IsUpdatingRecord: Boolean;
    // 清除新的记录，包括自己
    procedure ClearNewerRecord(AID: Integer);
    // 清除旧的记录，不包括自己
    procedure ClearOlderRecord(AID: Integer);
    // Undo前将最新值Cache到LastRecord
    procedure CacheLastRecord(AValue: TsdValue);
    // Redo时获取新值
    procedure CopyLastValue(AID: Integer; AValue: TsdValue);
    // 最新一次undo前要清空全部LastRecord
    procedure ClearLastRecords;
  public
    constructor Create(ADataSet: TsdDataSet); virtual;
    destructor Destroy; override;
    // 原DataSet增加记录的操作，在增加记录时写入的数据无需单独记录操作
    procedure BeginAdd;
    procedure EndAdd;
    // 注意批量操作只能对一条记录进行，存在多条记录的修改会出错
    procedure BeginRecordUpdate(ARecord: TsdDataRecord);
    procedure EndRecordUpdate;
    procedure Add(ARecord: TsdDataRecord);
    procedure Delete(ARecord: TsdDataRecord);
    procedure Modify(AValue: TsdValue);
    // 供外部对象（IsdHistoryObject）记录额外信息
    procedure WriteHistoryData(AOperation: TsdOperation; AObject: IsdHistoryObject; AData: Pointer);
    procedure Undo(AID: Integer);
    procedure Redo(AID: Integer);
    // 挂起，暂停所有操作记录
    procedure Suspend;
    // 继续记录
    procedure Resume;
    function FindByRecord(ARecord: TsdDataRecord): TsdHistoryRecord;
    procedure Clear;
    property DataSet: TsdDataSet read FDataSet;
    property SavePoint: Integer read GetSavePoint write SetSavePoint;
    // 1,OperationManager.Active=False;2,在Undo/Redo操作中写入DataSet的操作无需记录，以此属性标记
    property Stopping: Boolean read GetStopping;
  end;

  TsdHistoryRecord = class(TObject)
  private
    FOwner: TsdHistoryList;
    FValueList: TList;
    FOperation: TsdOperation;
    FID: Integer;
    FModified: Boolean;
    FNeedFreeCheck: Boolean;
    function GetValues(I: Integer): TsdHistoryValue;
    function GetCount: Integer;
  protected
    FRec: TsdDataRecord;
    // 外部对象
    FHistoryObject: IsdHistoryObject;
    // 外部对象的Data
    FData: Pointer;
    function FindValue(AValue: TsdValue): TsdHistoryValue;
    procedure RemoveValue(AValue: TsdValue);
  public
    constructor Create(AOwner: TsdHistoryList); virtual;
    destructor Destroy; override;
    procedure Add(ARecord: TsdDataRecord);
    procedure Delete(ARecord: TsdDataRecord);
    procedure Modify(AValue: TsdValue);
    procedure Undo(ADataRecord: TsdDataRecord);
    procedure Redo(ADataRecord: TsdDataRecord);
    property ID: Integer read FID;
    property Values[I: Integer]: TsdHistoryValue read GetValues;
    property Count: Integer read GetCount;
    property Operation: TsdOperation read FOperation write FOperation;
    // 记录操作前是否修改过
    property Modified: Boolean read FModified;
    // 用于记录额外的信息（例如树节点）
    property Data: Pointer read FData;
  end;

  TsdHistoryValue = class(TObject)
  private
    FFieldName: string;
    FOriginalCache: Pointer;
    FOriginalCacheLength: Integer;
    FData: Pointer;
    FLength: Integer;
    FIsNull: Boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure CopyFrom(AValue: TsdValue);
    procedure CopyTo(AValue: TsdValue);
    property FieldName: string read FFieldName;
  end;

  procedure OutputDataSetFields(ADataSet: TsdDataSet; AList: TStringList);
  procedure OutputDataViewFields(ADataView: TsdDataView; AList: TStringList);

var
  ReadValueCount: Integer = 0;

const
  BooleanStrArray: array [Boolean] of string =(STextFalse, STextTrue);
  SavePointMin = -999;

implementation

uses
  TypInfo, XMLDoc, XMLIntf, Math, DateUtils, Forms;

procedure OutputDataSetFields(ADataSet: TsdDataSet; AList: TStringList);
var
  I: Integer;
  Field: TsdField;
begin
  AList.Clear;
  AList.Add(Format('DataSet: %s', [ADataSet.Name]));
  for I := 0 to ADataSet.FieldCount - 1 do
  begin
    Field := ADataSet.Fields.Fields[I];
    AList.Add(Format('Fields: %s', [Field.FieldName]));
  end;
end;

procedure OutputDataViewFields(ADataView: TsdDataView; AList: TStringList);
var
  I: Integer;
  Col: TsdViewColumn;
begin
  AList.Clear;
  AList.Add(Format('DataView: %s', [ADataView.Name]));
  for I := 0 to ADataView.Columns.Count - 1 do
  begin
    Col := ADataView.Column[I];
    AList.Add(Format('Fields: %s', [Col.FieldName]));
  end;
end;

var
  Logs: TStringList;
  LogOn: Boolean = False;
  LogFile: string;

procedure BeginLog(AFileName: string);
var
  Dir: string;
begin
  Logs := TStringList.Create;
  LogFile := AFileName;
  Dir := ExtractFileDir(AFileName);
  LogOn := DirectoryExists(Dir);
end;

procedure EndLog;
begin
  if LogOn then
    Logs.SaveToFile(LogFile);
  FreeAndNil(Logs);
  LogOn := False;
end;

procedure AddLog(ALog: string);
begin
  if LogOn and Assigned(Logs) then
    Logs.Add(ALog);
end;


{function FieldTypeToVar(AFieldType: TFieldType): Integer;
begin
  case AFieldType of
    ftBoolean:
      Result := vtBoolean;
    ftString:
      Result := vtString;
    ftWideString:
      Result := vtWideString;
    ftMemo:
      Result := vtWideString;
    ftSmallint, ftInteger, ftWord:
      Result := vtInteger;
    ftFloat, ftDateTime:
      Result := vtExtended;
    ftCurrency, ftBCD:
      Result := vtCurrency;
  else
    Result := vtVariant;
  end;
end; }

function sdVarToInteger(Value: Variant): Integer;
begin
  if VarIsNull(Value) then
    Result := 0
  else
    Result := Value;
end;

function sdVarToFloat(Value: Variant): Double;
begin
  if VarIsNull(Value) then
    Result := 0
  else
    Result := Value;
end;

function sdVarToCurrency(Value: Variant): Currency;
begin
  if VarIsNull(Value) then
    Result := 0
  else
    Result := Value;
end;

function sdVarToBoolean(Value: Variant): Boolean;
begin
  if VarIsNull(Value) then
    Result := False
  else
    Result := Value;
end;

{function StrToTypedVar(Value: string; AFieldType: TFieldType): Variant;
begin
  if Value = '' then
    Result := Null
  else
  begin
    case AFieldType of
      ftBoolean:
        Result := StrToBool(Value);
      ftString:
        Result := Value;
      ftWideString:
        Result := Value;
      ftMemo:
        Result := Value;
      ftSmallint, ftInteger, ftWord:
        Result := StrToInt(Value);
      ftFloat:
        Result := StrToFloat(Value);
      ftDateTime:
        Result := StrToDateTime(Value);
      ftCurrency, ftBCD:
        Result := StrToCurr(Value);
    else
      Result := Value;
    end;
  end;
end;
}
{ TsdValue }

function TsdValue.ActualLength: Integer;
begin
  Result := InnerCacheLength(FData);
end;

procedure TsdValue.Clear;
begin
  SetAsVariant(Null);
end;

constructor TsdValue.Create(AOwner: TsdDataRecord);
begin
  FOwner := AOwner;
  FData := nil;
  FIsNull := True;
  FOriginalValue := nil;
  FTag := 0;
  FForceWriteData := False;
  FOriginalCached := False;
end;

destructor TsdValue.Destroy;
begin
  if Assigned(FData) then
    FreeMem(FData);
  if Assigned(FOriginalValue) then
    FreeMem(FOriginalValue);
  inherited;
end;

function TsdValue.GetAsBoolean: Boolean;
var
  P: Pointer;
begin
  Result := False;
  case DataType of
    ftBoolean:
    begin
      ReadData(P);
      Result := PBoolean(P)^;
    end;
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftFloat, ftDateTime,
    ftCurrency, ftBCD, ftFMTBCD:
      TypeErrorOnWriting(Result);
  end;
end;

function TsdValue.GetAsCurrency: Currency;
var
  P: Pointer;
begin
  Result := 0;
  case DataType of
    ftCurrency, ftBCD:
    begin
      ReadData(P);
      Result := PCurrency(P)^;
    end;
    ftFMTBCD:
    begin
      ReadData(P);
      BCDToCurr(PBCD(P)^, Result);
    end;
    ftFloat:
    begin
      ReadData(P);
      Result := PDouble(P)^;
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftDateTime:
      TypeErrorOnWriting(Result);
  end;
end;

function TsdValue.GetAsDateTime: TDateTime;
var
  P: Pointer;
begin
  Result := 0;
  case DataType of
    ftDateTime:
    begin
      ReadData(P);
      Result := PDouble(P)^;
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftFloat, ftCurrency, ftBCD, ftFMTBCD:
      TypeErrorOnWriting(Result);
  end;
end;

function TsdValue.GetAsFloat: Double;
var
  P: Pointer;
  strValue: string;
begin
  Result := 0;
  case DataType of
    ftFloat:
    begin
      ReadData(P);
      Result := PDouble(P)^;
    end;
    ftCurrency, ftBCD:
    begin
      ReadData(P);
      Result := PCurrency(P)^;
    end;
    ftFMTBCD:
    begin
      ReadData(P);
      Result := BcdToDouble(PBCD(P)^);
    end;
    ftSmallint:
    begin
      ReadData(P);
      Result := PSmallInt(P)^;
    end;
    ftInteger:
    begin
      ReadData(P);
      Result := PInteger(P)^;
    end;
    ftWord:
    begin
      ReadData(P);
      Result := PWord(P)^;
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo:
    begin
      strValue := GetAsString;
      if strValue <> '' then
        Result := StrToFloat(GetAsString)
      else
        Result := 0;
    end;
    ftDateTime:
      TypeErrorOnWriting(Result);
  end;
end;

function TsdValue.GetAsExtended: Extended;
var
  P: Pointer;
  strValue: string;
begin
  Result := 0;
  case DataType of
    ftFloat:
    begin
      ReadData(P);
      Result := PDouble(P)^;
    end;
    ftCurrency, ftBCD:
    begin
      ReadData(P);
      Result := PCurrency(P)^;
    end;
    ftFMTBCD:
    begin
      ReadData(P);
      Result := BcdToDouble(PBCD(P)^);
    end;
    ftSmallint:
    begin
      ReadData(P);
      Result := PSmallInt(P)^;
    end;
    ftInteger:
    begin
      ReadData(P);
      Result := PInteger(P)^;
    end;
    ftWord:
    begin
      ReadData(P);
      Result := PWord(P)^;
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo:
    begin
      strValue := GetAsString;
      if strValue <> '' then
        Result := StrToFloat(GetAsString)
      else
        Result := 0;
    end;
    ftDateTime:
      TypeErrorOnWriting(Result);
  end;
end;

function TsdValue.GetAsInteger: Longint;
var
  P: Pointer;
begin
  Result := 0;
  case DataType of
    ftSmallint:
    begin
      ReadData(P);
      Result := PSmallInt(P)^;
    end;
    ftWord:
    begin
      ReadData(P);
      Result := PWord(P)^;
    end;
    ftInteger:
    begin
      ReadData(P);
      Result := PInteger(P)^;
    end;
    ftFloat, ftCurrency, ftBCD:
    begin
      ReadData(P);
      Result := Longint(Round(PDouble(P)^));
    end;
    ftFMTBCD:
    begin
      ReadData(P);
      Result := BcdToInteger(PBCD(P)^);
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo,
    ftDateTime:
      TypeErrorOnWriting(Result);
  end;
end;

function TsdValue.GetAsString: string;
var
  P: Pointer;
  iLength: Integer;
  wsValue: WideString;
begin
  Result := '';
  if FIsNull then Exit;
//  if not FField.IsVarField then
//    SetLength(Result, DataSize);
  case DataType of
    ftBoolean:
    begin
      ReadData(P);
      Result := BooleanStrArray[PBoolean(P)^];
    end;
    ftString, ftMemo:
    begin
      iLength := ActualLength;
      SetLength(Result, iLength);
      P := @Result[1];
      if iLength > 0 then
      begin
        ReadData(P, iLength);
      end
      else
        Result := '';
    end;
    ftWideString:
    begin
      iLength := ActualLength;
      SetLength(wsValue, iLength);
      P := @wsValue[1];
      if iLength > 0 then
      begin
        ReadData(P, iLength);
        Result := wsValue;
      end
      else
        Result := '';
    end;
    ftSmallint:
    begin
      ReadData(P);
      Result := IntToStr(PSmallInt(P)^);
    end;
    ftWord:
    begin
      ReadData(P);
      Result := IntToStr(PWord(P)^);
    end;
    ftInteger:
    begin
      ReadData(P);
      Result := IntToStr(PInteger(P)^);
    end;
    ftFloat:
    begin
      ReadData(P);
      Result := FloatToStr(PDouble(P)^);
    end;
    ftDateTime:
    begin
      ReadData(P);
      Result := DateTimeToStr(PDouble(P)^);
    end;
    ftCurrency, ftBCD:
    begin
      ReadData(P);
      Result := FloatToStr(PCurrency(P)^);
    end;
    ftFMTBCD:
    begin
      ReadData(P);
      Result := BcdToStr(PBCD(P)^);
    end;
  end;
end;

function TsdValue.GetAsVariant: Variant;
var
  fBCD: TBCD;
begin
  Result := Null;
  if FIsNull then Exit;
  case DataType of
    ftBoolean: Result := GetAsBoolean;
    ftString, ftWideString, ftMemo: Result := GetAsString;
    ftSmallint, ftWord, ftInteger: Result := GetAsInteger;
    ftFloat: Result := GetAsFloat;
    ftDateTime: Result := GetAsDateTime;
    ftCurrency, ftBCD: Result := GetAsCurrency;
    ftFMTBCD:
    begin
      fBCD := GetAsBCD;
      Result := VarFMTBcdCreate(fBCD);
    end;
  end;
end;

function TsdValue.GetDataSize: Integer;
begin
  Result := FField.DataSize;
end;

function TsdValue.GetDataType: TFieldType;
begin
  Result := FField.DataType;
end;

function TsdValue.GetDisplayText: string;
begin
  {to do: 要考虑格式化的问题，以后再完善}
  Result := GetAsString;
end;

function TsdValue.GetEditText: string;
begin
  {to do: 要考虑格式化的问题，以后再完善}
  Result := GetAsString;
end;

function TsdValue.GetFieldName: string;
begin
  Result := FField.FieldName;
end;

function TsdValue.GetFieldNo: Integer;
begin
  Result := FField.FieldNo;
end;

function TsdValue.GetIsNull: Boolean;
begin
  Result := FIsNull;
end;

procedure TsdValue.ReadData(var Data: Pointer; Length: Integer);
var
  iLength: Integer;
begin
  iLength := Length;
  if FData = nil then ZeroMemory(Data, iLength);
  if iLength = 0 then iLength := DataSize;
  if not FField.IsBlobField then
    if iLength > DataSize then iLength := DataSize
  else if FField.DataType = ftWideString then
    iLength := iLength * 2;
  if Field.IsVarField then
    CopyMemory(Data, FData, iLength)
  else
    Data := FData;
  //Inc(ReadValueCount);
end;

procedure TsdValue.SetAsBoolean(const Value: Boolean);
begin
  case DataType of
    ftBoolean:
      WriteData(@Value, Value);
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftFloat, ftDateTime,
    ftCurrency, ftBCD, ftFMTBCD:
      TypeErrorOnWriting(Value);
  end;
end;

procedure TsdValue.SetAsCurrency(const Value: Currency);
var
  fValue: Double;
  fBCD: TBCD;
begin
  case DataType of
    ftBoolean,
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftDateTime:
      TypeErrorOnWriting(Value);
    ftFloat:
    begin
      fValue := Value;
      WriteData(@fValue, fValue);
    end;
    ftCurrency, ftBCD:
      WriteData(@Value, Value);
    ftFMTBCD:
    begin
      CurrToBCD(Value, fBCD);
      WriteData(@fBCD, Value);
    end;
  end;
end;

procedure TsdValue.SetAsDateTime(const Value: TDateTime);
begin
  case DataType of
    ftDateTime:
      WriteData(@Value, Value);
    ftBoolean,
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftFloat, ftCurrency, ftBCD, ftFMTBCD:
      TypeErrorOnWriting(Value);
  end;
end;

procedure TsdValue.SetAsFloat(const Value: Double);
var
  iValue: SmallInt;
  iWord: Word;
  iInt: Longint;
  fValue: Currency;
  fBCD: TBCD;
begin
  case DataType of
    ftFloat:
      WriteData(@Value, Value);
    ftCurrency, ftBCD:
    begin
      fValue := Value;
      WriteData(@fValue, fValue);
    end;
    ftFMTBCD:
    begin
      fBCD := DoubleToBcd(Value);
      WriteData(@fBCD, Value);
    end;
    ftSmallint:
    begin
      iValue := SmallInt(Round(Value));
      WriteData(@iValue, iValue);
    end;
    ftWord:
    begin
      iWord := Word(Round(Value));
      WriteData(@iWord, iWord);
    end;
    ftInteger:
    begin
      iInt := Longint(Round(Value));
      WriteData(@iInt, iInt);
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo:
      SetAsString(FloatToStr(Value));
    ftDateTime:
      TypeErrorOnWriting(Value);
  end;
end;

procedure TsdValue.SetAsExtended(const Value: Extended);
var
  iValue: SmallInt;
  iWord: Word;
  iInt: Longint;
  fValue: Double;
  cValue: Currency;
  fBCD: TBCD;
begin
  case DataType of
    ftFloat:
    begin
    begin
      fValue := Value;
      WriteData(@fValue, fValue);
    end;
    end;
    ftCurrency, ftBCD:
    begin
      cValue := Value;
      WriteData(@cValue, cValue);
    end;
    ftFMTBCD:
    begin
      fBCD := DoubleToBcd(Value);
      WriteData(@fBCD, Value);
    end;
    ftSmallint:
    begin
      iValue := SmallInt(Round(Value));
      WriteData(@iValue, iValue);
    end;
    ftWord:
    begin
      iWord := Word(Round(Value));
      WriteData(@iWord, iWord);
    end;
    ftInteger:
    begin
      iInt := Longint(Round(Value));
      WriteData(@iInt, iInt);
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo:
      SetAsString(FloatToStr(Value));
    ftDateTime:
      TypeErrorOnWriting(Value);
  end;
end;

procedure TsdValue.SetAsInteger(const Value: Longint);
var
  iValue: SmallInt;
  iWord: Word;
  fValue: Double;
  cValue: Currency;
  fBCD: TBCD;
begin
  case DataType of
    ftSmallint:
    begin
      iValue := Value;
      WriteData(@iValue, iValue);
    end;
    ftWord:
    begin
      iWord := Value;
      WriteData(@iWord, iWord);
    end;
    ftInteger:
      WriteData(@Value, Value);
    ftFloat, ftDateTime:
    begin
      fValue := Value;
      WriteData(@fValue, fValue);
    end;
    ftCurrency, ftBCD:
    begin
      cValue := Value;
      WriteData(@cValue, cValue);
    end;
    ftFMTBCD:
    begin
      fBCD := IntegerToBcd(Value);
      WriteData(@fBCD, Value);
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo:
      TypeErrorOnWriting(Value);
  end;
end;

procedure TsdValue.SetAsString(const Value: string);
var
  {B: Boolean;
  isValue: SmallInt;
  iWord: Word;
  iE: Integer;
  ilValue: Longint;
  fDouble: Double;
  fE: Extended;
  fDataTime: TDateTime;
  fCurrency: Currency;    }
  pData: Pointer;
  vValue: Variant;
  iLength: Integer;
  bNoNull: Boolean;
begin
  try
    pData := nil;
    ConvertDataBeforeWriteData(Value, pData, vValue, iLength, bNoNull);
    WriteData(pData, vValue, iLength, bNoNull);
  finally
    if Assigned(pData) then
      FreeMem(pData);
  end;
  {if Value = '' then
    // 直接clear有问题，不会触发通知方法，还是需要调用WriteData
    WriteData(nil, Null, 0, False)
  else
    case DataType of
      ftBoolean:
      begin
        if SameText(BooleanStrArray[True], Value) then
          B := True
        else
          B := False;
        WriteData(@B, B);
      end;
      ftString, ftWideString, ftMemo:
        WriteData(@Value[1], Value, Length(Value));
      ftSmallint, ftInteger, ftWord:
      begin
        Val(Value, ilValue, iE);
        if iE <> 0 then TypeErrorOnWriting(Value);
        case DataType of
          ftSmallint:
          begin
            isValue := ilValue;
            WriteData(@isValue, isValue);
          end;
          ftWord:
          begin
            iWord := ilValue;
            WriteData(@ilValue, ilValue);
          end;
          ftInteger:
            WriteData(@ilValue, ilValue);
        end;
      end;
      ftFloat:
      begin
        if not TextToFloat(PChar(Value), fE, fvExtended) then
          TypeErrorOnWriting(Value);
        fDouble := fE;
        WriteData(@fDouble, fDouble);
      end;
      ftDateTime:
      begin
        fDataTime := StrToDateTime(Value);
        WriteData(@fDataTime, fDataTime);
      end;
      ftCurrency, ftBCD:
      begin
        fCurrency := StrToCurr(Value);
        WriteData(@fCurrency, fCurrency);
      end;
    end;   }
end;

procedure TsdValue.SetAsVariant(const Value: Variant);
begin
  if VarIsNull(Value) then
    // 直接clear有问题，不会触发通知方法，还是需要调用WriteData
    WriteData(nil, Null, 0, False)
  else
    case DataType of
      ftBoolean: SetAsBoolean(sdVarToBoolean(Value));
      ftCurrency, ftBCD: SetAsCurrency(sdVarToCurrency(Value));
      ftFMTBCD: SetAsBCD(VarToBcd(Value));
      ftDateTime: SetAsDateTime(sdVarToFloat(Value));
      ftFloat: SetAsFloat(sdVarToFloat(Value));
      ftSmallint, ftInteger, ftWord: SetAsInteger(sdVarToInteger(Value));
      ftString, ftWideString, ftMemo: SetAsString(Value);
    end;
end;

procedure TsdValue.SetEditText(const Value: string);
begin
  SetAsString(Value);
end;

procedure TsdValue.SetField(Field: TsdField);
begin
  FField := Field;
  if Assigned(FData) then FreeMem(FData);
  if not Field.IsVarField then
  begin
    FData := AllocMem(DataSize);
  end
  else
    FData := nil;
end;

procedure TsdValue.TypeErrorOnWriting(const Value: Variant);
begin
  raise EsdDataSet.Create(Format('Type mismached, can not assign value [%s] to field [%s.%s]', [VarToStr(Value), Owner.Owner.Name, FieldName]));
end;

function TsdValue.CanWriteData(Data, ACache: Pointer; Length: Integer; NoNull: Boolean): Boolean;

  function SameData: Boolean;
  var
    I: Integer;
    iLength, iCacheLength: Integer;
    Pt1, Pt2: PByte;
  begin
    Result := False;
    if ACache = nil then
      Exit;

    if FField.IsVarField then
    begin
      if FField.DataType = ftWideString then
      begin
        iLength := Length * 2;
        iCacheLength := InnerCacheLength(ACache) * 2;
      end
      else
      begin
        iLength := Length;
        iCacheLength := InnerCacheLength(ACache);
      end;
      if iCacheLength <> iLength then
        Exit;
    end
    else
      iLength := DataSize;

    Result := CompareMem(ACache, Data, iLength);
  end;

begin
  Result := False;
  if FForceWriteData then
  begin
    Result := True;
    Exit;
  end;

  // 新数据不为空
  if Data <> nil then
  begin
    // 判断是否相同
    if SameData then
    begin
      // 对于数字类型，0和空会被SameData判断成一样的。
      // 所以这里要对旧数据为空的情况，判断新数据是不是为空。
      if FIsNull then
      begin
        if not NoNull then Exit;
      end
      else
        Exit;
    end;
  end
  // 新旧数据都为空
  else if FIsNull then Exit;

  Result := True;
end;

procedure TsdValue.InnerWriteData(Data: Pointer; const NewValue: Variant;
  Length: Integer; NoNull: Boolean);
var
  iLength: Integer;
  Pt: PByte;
begin
  if FOwner.Owner.UseSavePoint and FOwner.Owner.FEnableValueEvents and (not FOwner.Owner.FIsLoading)
    and (not FOwner.Owner.FHistory.Stopping) then
    FOwner.Owner.FHistory.Modify(Self);
  InnerClear;
  iLength := Length;
  if FField.IsBlobField then
  begin
    if Length > 65535 then
      iLength := 65535;
  end
  else
    if (iLength <= 0) or (iLength > DataSize) then
      iLength := DataSize;
  if FField.IsVarField then
  begin
    if Assigned(FData) then FreeMem(FData);
    // 字符串必须以0结尾，所以特殊处理
    if FField.DataType = ftWideString then
      FData := AllocMem((iLength + 1) * 2)
    else
      FData := AllocMem(iLength + 1);
  end;
  if (Data <> nil) and (NewValue <> Null) then
  begin
    if FField.DataType = ftWideString then
      CopyMemory(FData, Data, iLength * 2)
    else
      CopyMemory(FData, Data, iLength);
    // 字符串必须以0结尾，所以特殊处理
    if FField.IsVarField then
    begin
      if FField.DataType = ftWideString then
      begin
        Pt := PByte(FData);
        Inc(Pt, iLength * 2);
        Pt^ := 0;
        Inc(Pt);
        Pt^ := 0;
      end
      else
      begin
        Pt := PByte(FData);
        Inc(Pt, iLength);
        Pt^ := 0;
      end;
    end;
    FIsNull := False;
  end
  else
    FIsNull := True;
  if FOwner.Owner.FEnableValueEvents and (not FOwner.Owner.FIsLoading) then
    FOwner.CacheModified(Self);
end;

procedure TsdValue.WriteData(Data: Pointer; const NewValue: Variant; Length: Integer; NoNull: Boolean);
var
  Allow: Boolean;
  iLength: Integer;
  PCache: Pointer;
begin
  if FOwner.Owner.FEnableValueEvents then
  begin
    if not FOwner.Owner.FIsLoading then
      PCache := CopyCache
    else
      PCache := nil;
    try
      if not CanWriteData(Data, PCache, Length, NoNull) then Exit;
      Allow := True;
      // 节约内存，有变化时才缓存原始值
      CacheOriginalValue;
      FOwner.Owner.DoBeforeValueChange(Self, NewValue, Allow);
      if not Allow then Exit;
      InnerWriteData(Data, NewValue, Length, NoNull);
      FOwner.Owner.DoAfterValueChanged(Self);
      FOwner.Changed(Self);
    finally
      if not FOwner.Owner.FIsLoading then
        ClearCache(PCache);
    end;
  end
  else
    InnerWriteData(Data, NewValue, Length, NoNull);
end;

procedure TsdValue.ConvertDataBeforeWriteData(const Value: string;
  var Data: Pointer; var NewValue: Variant; var Length: Integer;
  var NoNull: Boolean);
var
  B: Boolean;
  isValue: SmallInt;
  iWord: Word;
  iE: Integer;
  ilValue: Longint;
  fDouble: Double;
  fE: Extended;
  fDataTime: TDateTime;
  fCurrency: Currency;
  fBCD: TBCD;
  pData: Pointer;
  iLength: Integer;
  wsValue: WideString;
begin
  if Value = '' then
  begin
    // 直接clear有问题，不会触发通知方法，还是需要调用WriteData
    pData := nil;
    NewValue := Null;
    Length := 0;
    NoNull := False;
  end
  else
    case DataType of
      ftBoolean:
      begin
        if SameText(BooleanStrArray[True], Value) then
          B := True
        else
          B := False;
        pData := @B;
        NewValue := B;
        Length := 0;
        NoNull := True;
      end;
      ftString, ftMemo:
      begin
        pData := @Value[1];
        NewValue := Value;
        Length := System.Length(Value);
        NoNull := False;
      end;
      ftWideString:
      begin
        wsValue := Value;
        pData := @wsValue[1];
        NewValue := wsValue;
        Length := System.Length(wsValue);
        NoNull := False;
      end;
      ftSmallint, ftInteger, ftWord:
      begin
        Val(Value, ilValue, iE);
        if iE <> 0 then TypeErrorOnWriting(Value);
        case DataType of
          ftSmallint:
          begin
            isValue := ilValue;
            pData := @isValue;
            NewValue := isValue;
            Length := 0;
            NoNull := True;
          end;
          ftWord:
          begin
            iWord := ilValue;
            pData := @iWord;
            NewValue := iWord;
            Length := 0;
            NoNull := True;
          end;
          ftInteger:
          begin
            pData := @ilValue;
            NewValue := ilValue;
            Length := 0;
            NoNull := True;
          end;
        end;
      end;
      ftFloat:
      begin
        if not TextToFloat(PChar(Value), fE, fvExtended) then
          TypeErrorOnWriting(Value);
        fDouble := fE;
        pData := @fDouble;
        NewValue := fDouble;
        Length := 0;
        NoNull := True;
      end;
      ftDateTime:
      begin
        fDataTime := StrToDateTime(Value);
        pData := @fDataTime;
        NewValue := fDataTime;
        Length := 0;
        NoNull := True;
      end;
      ftCurrency, ftBCD:
      begin
        fCurrency := StrToCurr(Value);
        pData := @fCurrency;
        NewValue := fCurrency;
        Length := 0;
        NoNull := True;
      end;
      ftFMTBCD:
      begin
        if not TextToFloat(PChar(Value), fE, fvExtended) then
          TypeErrorOnWriting(Value);
        fBCD := StrToBcd(Value);
        pData := @fBCD;
        NewValue := fE;
        Length := 0;
        NoNull := True;
      end;
    end;

  if pData = nil then
    Data := nil
  else
  begin
    iLength := Length;
    if FField.IsBlobField then
    begin
      if Length > 65535 then
        iLength := 65535;
    end
    else
    begin
      if (iLength <= 0) or (iLength > DataSize) then
        iLength := DataSize;
      if FField.DataType = ftWideString then
        iLength := iLength * 2;
    end;
    Data := AllocMem(iLength);
    CopyMemory(Data, pData, iLength);
  end;
end;

procedure TsdValue.ClearCache(ACache: Pointer);
begin
  if Assigned(ACache) then
    FreeMem(ACache);
  ACache := nil;
end;

function TsdValue.CopyCache: Pointer;
var
  iLength: Integer;
begin
  Result := nil;
  if Assigned(FData) then
  begin
    // 字符串类型最后有一个#0字符
    if FField.IsVarField then
    begin
      if FField.DataType = ftWideString then
        iLength := (ActualLength + 1) * 2
      else
        iLength := ActualLength + 1;
    end
    else
      iLength := DataSize;
    Result := AllocMem(iLength);
    CopyMemory(Result, FData, iLength);
  end;
end;

procedure TsdValue.Assign(Source: TsdValue);
begin
  if Source.DataType <> DataType then
    raise EsdDataSet.Create('Can not assign value from different type sdValue');
  if FField.IsVarField then
    WriteData(Source.FData, Source.Value, Source.ActualLength)
  else
    WriteData(Source.FData, Source.Value);
end;

procedure TsdValue.InnerClear;
begin
  if Assigned(FData) then
  begin
    if FField.IsVarField then
    begin
      if FField.DataType = ftWideString then
        ZeroMemory(FData, ActualLength * 2)
      else
        ZeroMemory(FData, ActualLength);
    end
    else
      ZeroMemory(FData, DataSize);
  end;
  FIsNull := True;
end;

function TsdValue.GetAsBCD: TBCD;
var
  P: Pointer;
begin
  Result := NullBcd;
  case DataType of
    ftFMTBCD:
    begin
      ReadData(P);
      Result := PBCD(P)^;
    end;
    ftBoolean,
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftDateTime, ftCurrency, ftBCD, ftFloat:
      TypeErrorOnWriting(0);
  end;
end;

procedure TsdValue.SetAsBCD(const Value: TBCD);
begin
  case DataType of
    ftFMTBCD:
      WriteData(@Value, BcdToDouble(Value));
    ftBoolean,
    ftString, ftWideString, ftMemo,
    ftSmallint, ftInteger, ftWord,
    ftDateTime, ftCurrency, ftBCD, ftFloat:
      TypeErrorOnWriting(BcdToDouble(Value));
  end;
end;

function TsdValue.GetOriginalValue: Variant;
begin
  if not FOriginalCached then
    Result := Value
  else
    Result := InnerGetCache(FOriginalValue);
end;

function TsdValue.GetAsWideString: WideString;
begin
  Result := GetAsString;
end;

procedure TsdValue.SetAsWideString(const Value: WideString);
begin
  SetAsString(Value);
end;

// 暂只测试整数和浮点数类型
function TsdValue._CopyFrom(Source: Pointer): Integer;
begin
  raise EsdDataSet.Create('_CopyFrom暂未启用');
  CopyMemory(FData, Source, DataSize);
  FIsNull := False;
  Result := DataSize;
end;

function TsdValue._MemorySize: Integer;
begin
  if FField.IsVarField then
  begin
    if FField.DataType = ftWideString then
      Result := ActualLength * 2
    else
      Result := ActualLength;
  end
  else
    Result := DataSize;
end;

function TsdValue._CopyTo(Destination: Pointer): Integer;
begin
  raise EsdDataSet.Create('_CopyTo暂未启用');
  CopyMemory(Destination, FData, DataSize);
  Result := DataSize;
end;

procedure TsdValue.InnerCopy(AValue: Variant);
begin
  DisableEvents;
  try
    Value := AValue;
  finally
    EnableEvents;
  end;
end;

function TsdValue.InnerCacheLength(ACache: Pointer): Integer;
var
  I, iLength: Integer;
  B, B2: Byte;
  Pt: PByte;
begin
  Result := 0;
  if ACache = nil then Exit;
  if FField.IsBlobField then
    iLength := 65535
  else
    iLength := DataSize;
  Result := iLength;
  Pt := PByte(ACache);
  if FField.DataType = ftWideString then
    for I := 0 to iLength - 1 do
    begin
      B := Pt^;
      Inc(Pt);
      B2 := Pt^;
      Inc(Pt);
      if (B = 0) and (B2 = 0) then
      begin
        Result := I;
        Break;
      end;
    end
  else
    for I := 0 to iLength - 1 do
    begin
      B := Pt^;
      Inc(Pt);
      if B = 0 then
      begin
        Result := I;
        Break;
      end;
    end;
end;

function TsdValue.InnerGetCache(ACache: Pointer): Variant;
var
  iLength: Integer;
  strValue: string;
  wsValue: WideString;
begin
  Result := Null;
  if not Assigned(ACache) then Exit;
  case FField.DataType of
    ftBoolean:
      Result := PBoolean(ACache)^;
    ftString, ftMemo:
    begin
      iLength := InnerCacheLength(ACache);
      SetLength(strValue, iLength);
      if iLength > 0 then
      begin
        CopyMemory(@strValue[1], ACache, iLength);
        Result := strValue;
      end
      else
        Result := '';
    end;
    ftWideString:
    begin
      iLength := InnerCacheLength(ACache);
      SetLength(wsValue, iLength);
      if iLength > 0 then
      begin
        CopyMemory(@wsValue[1], ACache, iLength * 2);
        Result := wsValue;
      end
      else
        Result := '';
    end;
    ftSmallint:
      Result := PSmallInt(ACache)^;
    ftWord:
      Result := PWord(ACache)^;
    ftInteger:
      Result := PInteger(ACache)^;
    ftFloat:
      Result := PDouble(ACache)^;
    ftDateTime:
      Result := PDouble(ACache)^;
    ftCurrency, ftBCD:
      Result := PCurrency(ACache)^;
    ftFMTBCD:
      Result := VarFMTBcdCreate(PBCD(ACache)^);
  end;
end;

procedure TsdValue.InnerSetCache(var ACache: Pointer; AValue: Variant);
var
  iLength: Integer;
  pData: Pointer;
  B: Boolean;
  isValue: SmallInt;
  iWord: Word;
  iE: Integer;
  ilValue: Longint;
  fDouble: Double;
  fE: Extended;
  fDataTime: TDateTime;
  fCurrency: Currency;
  fBCD: TBCD;
  strValue: string;
  wsValue: WideString;
begin
  if VarIsNull(AValue) then
  begin
    if Assigned(ACache) then
      FreeMem(ACache);
    ACache := nil;
    Exit;
  end;
  if Assigned(ACache) then
  begin
    if FField.IsVarField then
    begin
      FreeMem(ACache);
      ACache := nil;
    end
    else
      ZeroMemory(ACache, FField.DataSize);
  end;

  case FField.DataType of
    ftBoolean:
    begin
      B := AValue;
      pData := @B;
    end;
    ftString, ftMemo:
    begin
      strValue := AValue;
      pData := @strValue[1];
      iLength := System.Length(strValue);
    end;
    ftWideString:
    begin
      wsValue := AValue;
      pData := @wsValue[1];
      iLength := System.Length(wsValue);
    end;
    ftSmallint:
    begin
      isValue := AValue;
      pData := @isValue;
    end;
    ftWord:
    begin
      iWord := AValue;
      pData := @iWord;
    end;
    ftInteger:
    begin
      ilValue := AValue;
      pData := @ilValue;
    end;
    ftFloat:
    begin
      fDouble := AValue;
      pData := @fDouble;
    end;
    ftDateTime:
    begin
      fDataTime := Value;
      pData := @fDataTime;
    end;
    ftCurrency, ftBCD:
    begin
      fCurrency := AValue;
      pData := @fCurrency;
    end;
    ftFMTBCD:
    begin
      fBCD := VarToBcd(AValue);
      pData := @fBCD;
    end;
  end;

  if FField.IsVarField then
  begin
    // 字符串必须以0结尾，所以特殊处理
    if FField.DataType = ftWideString then
    begin
      ACache := AllocMem((iLength + 1) * 2);
      CopyMemory(ACache, pData, iLength * 2);
    end
    else
    begin
      ACache := AllocMem(iLength + 1);
      CopyMemory(ACache, pData, iLength);
    end;
  end
  else
  begin
    iLength := FField.DataSize;
    if not Assigned(ACache) then
      ACache := AllocMem(iLength);
    CopyMemory(ACache, pData, iLength);
  end;
end;

procedure TsdValue.InnerCopyCache(var ACache: Pointer);
var
  iLength: Integer;
begin
  if IsNull then
  begin
    if Assigned(ACache) then
    begin
      FreeMem(ACache);
      ACache := nil;
    end;
    Exit;
  end;
  if FField.IsVarField then
  begin
    if Assigned(ACache) then
      FreeMem(ACache);
    iLength := ActualLength + 1;
    if FField.DataType = ftWideString then
      iLength := iLength * 2;
    ACache := AllocMem(iLength);
  end
  else
  begin
    iLength := FField.DataSize;
    if not Assigned(ACache) then
      ACache := AllocMem(iLength);
  end;
  CopyMemory(ACache, FData, iLength);
end;

procedure TsdValue.CacheOriginalValue;
begin
  if Owner.Owner.FIsLoading or Owner.FNew then Exit;
  if not FOriginalCached then
  begin
    InnerCopyCache(FOriginalValue);
    FOriginalCached := True;
  end;
end;

procedure TsdValue.ClearOriginalValue;
begin
  if Assigned(FOriginalValue) then
    FreeMem(FOriginalValue);
  FOriginalValue := nil;
  FOriginalCached := False;
end;

procedure TsdValue.DisableEvents;
begin
  FOwner.Owner.FEnableValueEvents := False;
end;

procedure TsdValue.EnableEvents;
begin
  FOwner.Owner.FEnableValueEvents := True;
end;

{ TsdValueList }

function TsdValueList.Add(Field: TsdField): TsdValue;
begin
  if FindValue(Field, Result) then Exit;
  Result := TsdValue.Create(FOwner);
  Result.SetField(Field);
  FList.Add(Result);
end;

procedure TsdValueList.Clear;
var
  I: Integer;
  s: string;
begin
  for I := 0 to FList.Count - 1 do
    try
    s := FOwner.FOwner.Name + ' ';
    s := s + TsdValue(FList[I]).FieldName;
    TsdValue(FList[I]).Free;
    except
      MessageBox(0, PChar(s), PChar(IntToStr(I)), IDOK);
    end;
  FList.Clear;
end;

constructor TsdValueList.Create(AOwner: TsdDataRecord);
begin
  FOwner := AOwner;
  FList := TList.Create;
end;

destructor TsdValueList.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;

function TsdValueList.FindValue(Field: TsdField; var Value: TsdValue): Boolean;
var
  I: Integer;
  V: TsdValue;
begin
  Result := False;
  for I := 0 to FList.Count - 1 do
  begin
    V := Values[I];
    if V.FField = Field then
    begin
      Value := V;
      Result := True;
      Break;
    end;
  end;
end;

function TsdValueList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TsdValueList.GetValues(Index: Integer): TsdValue;
begin
  Result := nil;
  if (Index >=0) and (Index <= FList.Count - 1) then
    Result := TsdValue(FList[Index]);
end;

{ TsdDataRecord }

function TsdDataRecord.AddValue(FieldNo: Integer; DBField: TField): TsdValue;
begin
  Result := FValueList.Values[FieldNo]; 
  if Result <> nil then
  begin
    if Result.FIsNull and (not DBField.IsNull) then
      Result.ForceWriteData := True;
    try
      if DBField.IsNull then
        Result.Clear
      else
        case Result.DataType of
          ftBoolean:
            Result.AsBoolean := DBField.AsBoolean;
          ftString, ftMemo:
            Result.AsString := DBField.AsString;
          ftWideString:
            Result.AsWideString := TWideStringField(DBField).Value;
          ftSmallint, ftInteger, ftWord:
            Result.AsInteger := DBField.AsInteger;
          ftDateTime:
            Result.AsDateTime := DBField.AsDateTime;
          ftFloat:
            Result.AsFloat := DBField.AsFloat;
          ftCurrency, ftBCD:
            Result.AsCurrency := DBField.AsCurrency;
          ftFMTBCD:
            Result.AsBCD := TFMTBCDField(DBField).AsBCD;
        end;
    finally
      Result.ForceWriteData := False;
    end;
  end
  else
    raise EsdDataSet.Create(Format('Can not find field %d', [FieldNo]));
end;

function TsdDataRecord.AddValue(Field: TsdField; Value: Variant; IsNull: Boolean): TsdValue;
begin
  Result := FValueList.Add(Field);
  if Result <> nil then
  begin
    if Result.FIsNull and (not IsNull) then
      Result.ForceWriteData := True;
    Result.FIsNull := IsNull;
    try
      Result.Value := Value;
    finally
      Result.ForceWriteData := False;
    end;
  end;
end;

procedure TsdDataRecord.AddFields;
var
  I: Integer;
  Field: TsdField;
begin
  for I := 0 to FOwner.FieldCount - 1 do
  begin
    Field := FOwner.Fields.Fields[I];
    FValueList.Add(Field);
  end;
  DoAfterAddFields;
end;

function TsdDataRecord.AddValue(FieldName: string;
  Value: Variant; IsNull: Boolean): TsdValue;
var
  Field: TsdField;
begin
  Result := nil;
  Field := FOwner.FFieldList.FieldByName(FieldName);
  if Field <> nil then
    Result := AddValue(Field, Value, IsNull);
end;

procedure TsdDataRecord.Changed(Value: TsdValue);
begin
  if FOwner.FIsLoading then Exit;
  NotifyIndex(Value);
  if not IsUpdating then
    FOwner.CheckIndex(Self);
  if not FModified then FModified := True;
  if FChangedValueList.IndexOf(Value) < 0 then
    FChangedValueList.Add(Value);
  if FModified and (not IsUpdating) then
  begin
    FOwner.Changed(Self, sroModify);
    FOwner.DoAfterRecordChanged(Self);
  end;
  NotifyLookup(Value.Field);
end;

procedure TsdDataRecord.Clear;
begin
  FValueList.Clear;
end;

constructor TsdDataRecord.Create(AOwner: TsdDataSet);
begin
  FIndex := -1;
  FRecNo := -1;
  FUpdateLock := 0;
  FNew := False;
  FNeedNotifyIndex := False;
  FModified := False;
  FInserting := 0;
  FOwner := AOwner;
  FValueList := TsdValueList.Create(Self);
  FChangedValueList := TList.Create;
  FCanceled := False;
  FCache := nil;
  FData := nil;
  FPData := nil;
end;

destructor TsdDataRecord.Destroy;
begin
  Clear;
  FChangedValueList.Free;
  FValueList.Free;
  if Assigned(FCache) then
    FreeAndNil(FCache);
  inherited;
end;

function TsdDataRecord.GetValues(FieldNo: Integer): TsdValue;
begin
  Result := FValueList[FieldNo];
end;

procedure TsdDataRecord.Loaded;
var
  I: Integer;
begin
  FNew := False;
  FModified := False;
  for I := 0 to FValueList.Count - 1 do
    FValueList[I].ClearOriginalValue;
end;

function TsdDataRecord.ValueByName(FieldName: string): TsdValue;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FValueList.Count - 1 do
    if SameText(FieldName, TsdValue(FValueList[I]).FieldName) then
    begin
      Result := TsdValue(FValueList[I]);
      Break;
    end;
end;

function TsdDataRecord.GetIsUpdating: Boolean;
begin
  Result := FUpdateLock > 0;
end;

procedure TsdDataRecord.BeginUpdate;
begin
  if not IsUpdating then
    BeginTrans;
  Inc(FUpdateLock);
  FOwner.DoBeforeRecordUpdate(Self);
end;

procedure TsdDataRecord.EndUpdate;
begin
  if FUpdateLock = 0 then
    Exit;
  if FUpdateLock > 0 then
    Dec(FUpdateLock);
  if not IsUpdating then
  begin
    // 事件中的Cancel才会运行到这里
    if Canceled then
    begin
      FOwner.CancelRecord(Self);
      if not Inserting then
        EndTrans;
      Exit;
    end
    else
      EndTrans;
  end;
  if FModified and (not IsUpdating) then
  begin
    Owner.CheckIndex(Self);
    Owner.Changed(Self, sroModify);
    Owner.DoAfterRecordChanged(Self);
    NotifyLookup(nil);
  end;
  if FInserting > FUpdateLock then
    SetInserting(False, True);
  FOwner.DoAfterRecordUpdated(Self);
  if (not IsUpdating) and (Owner.FEventRec = Self) then
  begin
    Owner.FCurrentView := nil;
    Owner.FEventRec := nil;
  end;
end;

procedure TsdDataRecord.DoAfterAddFields;
begin

end;

function TsdDataRecord.GetFieldValue(const FieldName: string): Variant;
var
  I, iPos: Integer;
  strFields, strField: string;
  V: TsdValue;
  ValueList: TList;
begin
  if Pos(';', FieldName) <> 0 then
  begin
    ValueList := TList.Create;
    try
      strFields := FieldName;
      while Length(strFields) > 0 do
      begin
        iPos := Pos(';', strFields);
        if iPos > 0 then
        begin
          strField := Copy(strFields, 1, iPos - 1);
          System.Delete(strFields, 1, iPos - 1);
        end
        else
        begin
          strField := strFields;
          strFields := '';
        end;
        V := ValueByName(strField);
        ValueList.Add(V);
      end;
      Result := VarArrayCreate([0, ValueList.Count - 1], varVariant);
      for I := 0 to ValueList.Count - 1 do
        Result[I] := TsdValue(ValueList[I]).Value;
    finally
      ValueList.Free;
    end;
  end
  else
    Result := ValueByName(FieldName).Value;
end;

procedure TsdDataRecord.NotifyLookup(Field: TsdField);
begin
  FOwner.CheckChangedLookupFields(Field, Self);
end;

procedure TsdDataRecord.DoAfterSaved;
var
  I: Integer;
begin
  //if FNew then FNew := False;
  //if FModified then FModified := False;
  Loaded;
  FChangedValueList.Clear;
end;

procedure TsdDataRecord.NotifyIndex(Value: TsdValue);
var
  I: Integer;
  Idx: TsdIndex;
begin
  for I := 0 to Owner.IndexList.Count - 1 do
  begin
    Idx := Owner.IndexList[I];
    if FNeedNotifyIndex or Idx.IsKeyField(Value.FieldName) then
      Idx.AddChangedRecord(Self);
  end;
  if FNeedNotifyIndex then FNeedNotifyIndex := False;
end;

procedure TsdDataRecord.EnterEvent;
begin
  FIsInEvent := True;
end;

procedure TsdDataRecord.ExitEvent;
begin
  FIsInEvent := False;
end;

function TsdDataRecord.GetCount: Integer;
begin
  Result := FValueList.Count;
end;

function TsdDataRecord.GetInserting: Boolean;
begin
  Result := FInserting > 0;
end;

procedure TsdDataRecord.SetInserting(Value, NeedBeginUpdate: Boolean);
begin
  if Value then
  begin
    if NeedBeginUpdate then
      FInserting := FUpdateLock + 1
    else
      FInserting := MaxInt;
  end
  else
    FInserting := 0;
end;

procedure TsdDataRecord.SetData(const Value: Pointer);
begin
  FData := Value;
end;

procedure TsdDataRecord.Cancel;
begin
  if not IsUpdating then
    raise EsdDataSet.Create('Please call BeginUpdate before Cancel');
  FCanceled := True;
  // 在事件中先不处理，在EndUpdate中处理
  if not IsInEvent then
  begin
    //FInserting := 0;
    FUpdateLock := 0;
    FOwner.CancelRecord(Self);
  end;
end;

procedure TsdDataRecord.BeginTrans;
begin
  FCache := TsdDataRecordCache.Create(Self);
end;

procedure TsdDataRecord.EndTrans;
begin
  if FCache <> nil then
    FreeAndNil(FCache);
end;

procedure TsdDataRecord.Rollback;
var
  I: Integer;
  VTarget: TsdValueCache;
  VSource: TsdValue;
begin
  if FCache = nil then Exit;
  for I := 0 to FValueList.Count - 1 do
  begin
    VTarget := FCache.Values[I];
    if VTarget.FModified then
    begin
      VSource := FValueList[I];
      VSource.InnerCopy(VTarget.Value);
    end;
  end;
  FreeAndNil(FCache);
end;

procedure TsdDataRecord.CacheModified(Source: TsdValue);
var
  VTarget: TsdValueCache;
begin
  if FCache = nil then Exit;
  VTarget := FCache.Values[Source.FieldNo];
  if VTarget <> nil then
    VTarget.FModified := True;
end;

procedure TsdDataRecord.Delete;
begin
  FOwner.Remove(Self);
end;

procedure TsdDataRecord.ForceNotifyIndex;
var
  I: Integer;
  Idx: TsdIndex;
begin
  for I := 0 to Owner.IndexList.Count - 1 do
  begin
    Idx := Owner.IndexList[I];
    Idx.AddChangedRecord(Self);
  end;
end;

procedure TsdDataRecord.SetPData(Value: Pointer);
begin
  FPData := Value;
end;

{ TsdIndexNode }

constructor TsdIndexNode.Create(AOwner: TsdIndex);
begin
  FOwner := AOwner;
end;

destructor TsdIndexNode.Destroy;
begin

  inherited;
end;

function TsdIndexNode.GetChildCount: Integer;
var
  Node: TsdIndexNode;
begin
  Result := 0;
  Node := FirstChild;
  while Node <> nil do
  begin
    Inc(Result);
    Node := Node.NextSibling;
  end;
end;

function TsdIndexNode.GetChildren(Index: Integer): TsdIndexNode;
var
  I: Integer;
begin
  Result := nil;
  if (Index >= 0) and (Index < ChildCount) then
  begin
    I := 0;
    Result := FirstChild;
    while I < Index do
    begin
      Result := Result.NextSibling;
      Inc(I);
    end;
  end;
end;

function TsdIndexNode.GetLastChild: TsdIndexNode;
begin
  if FirstChild = nil then
    Result := nil
  else
  begin
    Result := FirstChild;
    while Result.NextSibling <> nil do
      Result := Result.NextSibling;
  end;
end;

function TsdIndexNode.GetLastPosterity: TsdIndexNode;
begin
  Result := LastChild;
  if Result = nil then Exit;
  while Result.LastChild <> nil do
    Result := Result.LastChild;
end;

function TsdIndexNode.GetLevel: Integer;
var
  ParentNode: TsdIndexNode;
begin
  Result := -1;
  ParentNode := Parent;
  while ParentNode <> nil do
  begin
    ParentNode := ParentNode.Parent;
    Inc(Result);
  end;
end;

function TsdIndexNode.GetRecordCount: Integer;
var
  NextNode: TsdIndexNode;
begin
  // 找后一个兄弟，有后兄弟则是后兄弟，没有后兄弟则是最后一个子节点的下一个节点，
  // 没有子节点则是自己下一个节点
  NextNode := NextNodeByLevel;
  // 没有下一个节点则是最后所有记录
  if NextNode <> nil then
    Result := NextNode.RecIndex - RecIndex
  else
    Result := FOwner.FDataList.Count - RecIndex;
end;

function TsdIndexNode.HasRecord(ARecord: TsdDataRecord): Boolean;
var
  iIdx: Integer;
  Node: TsdIndexNode;
begin
  iIdx := FOwner.IndexOf(ARecord);
  Result := iIdx >= RecIndex;
  Node := NextNodeByLevel;
  if Result and (Node <> nil) then
    Result := iIdx < Node.RecIndex;
end;

// 找后一个兄弟，有后兄弟则是后兄弟，没有后兄弟则是最后一个子节点的下一个节点，
// 没有子节点则是自己下一个节点
function TsdIndexNode.NextNodeByLevel: TsdIndexNode;
var
  Node, NextNode: TsdIndexNode;
  iIdx: Integer;
begin
  NextNode := nil;
  if NextSibling <> nil then
    NextNode := NextSibling
  else
  begin
    if FirstChild <> nil then
      Node := LastPosterity
    else
      Node := Self;
    iIdx := FOwner.FIndexNodeList.IndexOf(Node);
    if iIdx < FOwner.FIndexNodeList.Count - 1 then
      NextNode := TsdIndexNode(FOwner.FIndexNodeList[iIdx + 1]);
  end;
  Result := NextNode;
end;

procedure TsdIndexNode.SetDataType(const Value: TFieldType);
begin
  FDataType := Value;
end;

procedure TsdIndexNode.SetFirstChild(const Value: TsdIndexNode);
begin
  FFirstChild := Value;
end;

procedure TsdIndexNode.SetNextSibling(const Value: TsdIndexNode);
begin
  FNextSibling := Value;
end;

procedure TsdIndexNode.SetParent(const Value: TsdIndexNode);
begin
  FParent := Value;
end;

procedure TsdIndexNode.SetPrevSibling(const Value: TsdIndexNode);
begin
  FPrevSibling := Value;
end;

procedure TsdIndexNode.SetRecIndex(const Value: Integer);
begin
  FRecIndex := Value;
end;

procedure TsdIndexNode.SetValue(const Value: Variant);
begin
  FValue := Value;
end;

{ TsdIndex }

procedure TsdIndex.Clear;
var
  I: Integer;
begin
  FDataList.Clear;
  for I := 0 to FIndexNodeList.Count - 1 do
    TsdIndexNode(FIndexNodeList[I]).Free;
  FIndexNodeList.Clear;
  FIndexRoot.FFirstChild := nil;
end;

// Result: 0:  ARec1 = ARec2    >0:  ARec1 > ARec2   <0:  ARec1 < ARec2
function TsdIndex.CompareData(ARec1, ARec2: TsdDataRecord): Integer;
var
  V1, V2: Variant;
  iLevel: Integer;
begin
  iLevel := 0;
  repeat
    V1 := GetValue(ARec1, iLevel);
    V2 := GetValue(ARec2, iLevel);
    Result := CompareValue(V1, V2);
    // 对于不唯一的字段，作为索引的时候，如果因为其它字段被修改引发了排序，相同索引值下的记录可能会混乱
    // 所以要根据一个唯一值再比较一下，这里选用Record.FIndex
    if (Result = 0) and (iLevel = LevelCount - 1) then
      Result := CompareIndex(ARec1, ARec2);
    Inc(iLevel);
  until (Result <> 0) or (iLevel > LevelCount - 1);
end;

constructor TsdIndex.Create(AOwner: TsdIndexList);
begin
  FDescend := False;
  FSortNullToLast := True;
  FOwner := AOwner;
  FDataList := TList.Create;
  FIndexNodeList := TList.Create;
  FFieldList := TList.Create;
  FIndexRoot := TsdIndexNode.Create(Self);
  FIndexRoot.FValue := 'Root';
  FChangedList := TList.Create;
end;

destructor TsdIndex.Destroy;
begin
  Clear;
  FIndexRoot.Free;
  FDataList.Free;
  FIndexNodeList.Free;
  FFieldList.Free;
  FChangedList.Free;
  FOwner.FOwner.IndexDeleted(Name);
  inherited;
end;

function TsdIndex.GetKeyCount(Level: Integer): Integer;
begin
  Result := FFieldList.Count;
end;

function TsdIndex.GetRecords(Index: Integer): TsdDataRecord;
begin
  Result := nil;
  if (Index >= 0) and (Index < FDataList.Count) then
    Result := TsdDataRecord(FDataList[Index]);
end;

function TsdIndex.GetValue(ARecord: TsdDataRecord;
  ALevel: Integer): Variant;
var
  Field: TsdField;
begin
  Result := Null;
  if (ALevel >= 0) and (ALevel <= LevelCount - 1) then
  begin
    Field := TsdField(FFieldList[ALevel]);
    Result := ARecord.Values[Field.FieldNo].Value;
  end;
end;

// 根据记录索引查找已存在的索引位置
// -1: 找不到索引(需要进行处理以防出错)
// 0-maxint: 索引位置
function TsdIndex.FindExistKeyIndex(ARecordIndex: Integer): Integer;
var
  I: Integer;
begin
  Result := -1;
  if FIndexNodeList.Count = 0 then Exit;
  // 只有一条索引记录
  if FIndexNodeList.Count = 1 then
  begin
    Result := 0;
    Exit;
  end;
  // 属于最后一条索引记录
  if TsdIndexNode(FIndexNodeList[FIndexNodeList.Count - 1]).RecIndex <= ARecordIndex then
  begin
    Result := FIndexNodeList.Count - 1;
    Exit;
  end;
  // 中间
  for I := 0 to FIndexNodeList.Count - 2 do
  begin
    if (TsdIndexNode(FIndexNodeList[I]).RecIndex <= ARecordIndex) and
      (ARecordIndex < TsdIndexNode(FIndexNodeList[I + 1]).RecIndex) then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TsdIndex.Check(ARecord: TsdDataRecord): Integer;

  // 获取插入位置的索引号列表
  // 相同的记录，后插入的放在后面
  // 二分法不好设计，暂用顺序遍历
  {function FindInsertPos(ARecord: TsdDataRecord): Integer;
  var
    I: Integer;
  begin
    Result := 0;
    // 没有记录
    if FDataList.Count = 0 then
      Exit;
    // 小于最小
    if CompareData(TsdDataRecord(FDataList[0]), ARecord) > 0 then
    begin
      Result := 0;
      Exit;
    end;
    // 大于等于最大
    if CompareData(ARecord, TsdDataRecord(FDataList[FDataList.Count - 1])) >= 0 then
    begin
      Result := FDataList.Count;
      Exit;
    end;
    // 只有一条记录
    if FDataList.Count = 1 then
    begin
      if CompareData(TsdDataRecord(FDataList[0]), ARecord) <= 0 then
        Result := 1
      else
        Result := 0;
      Exit;
    end;
    // 顺序查找
    for I := 0 to FDataList.Count - 1 do
    begin
      if (CompareData(TsdDataRecord(FDataList[I]), ARecord) <= 0) and
        (CompareData(ARecord, TsdDataRecord(FDataList[I + 1])) < 0) then
      begin
        Result := I + 1;
        Break;
      end;
    end;
  end;  }

  function FindInBrothers(ARecord: TsdDataRecord; AFirstChild: TsdIndexNode; AValue: Variant;
    var ANode: TsdIndexNode): Boolean;
  var
    Node: TsdIndexNode;
    iResult: Integer;
  begin
    Result := False;
    ANode := nil;
    Node := AFirstChild;
    while Node <> nil do
    begin
      iResult := CompareValue(Node.Value, AValue);
      if iResult >= 0 then
      begin
        Result := iResult = 0;
        ANode := Node;
        Break;
      end;
      Node := Node.NextSibling;
      ANode := Node;
    end;
  end;

  function AddIndexNode(ARecord: TsdDataRecord; var ARecordIndex: Integer): TsdIndexNode;
  var
    ParentNode, NextNode, Node, PrevSibling, ChildNode: TsdIndexNode;
    I, J, iKey: Integer;
    vData: Variant;
    bNeedInsert: Boolean;
  begin
    Result := nil;
    ParentNode := FIndexRoot;
    for I := 0 to FFieldList.Count - 1 do
    begin
      bNeedInsert := False;
      vData := GetValue(ARecord, I);
      NextNode := nil;
      // 还没有子节点
      if ParentNode.FirstChild = nil then
      begin
        bNeedInsert := True;
      end
      else
      begin
        // 找后兄弟
        bNeedInsert := not FindInBrothers(ARecord, ParentNode.FirstChild, vData, Node);
        // 找到符合要求的节点
        if not bNeedInsert then
        begin
          // 已经到最后一层节点
          if I = FFieldList.Count - 1 then
          begin
            Result := Node;
            // 插入位置是后兄弟最后一个后代节点之后
            if Node.LastChild <> nil then
              Node := Node.LastPosterity;
            // 加入FDataList, 加在当前节点最后一条记录之后
            ARecordIndex := Node.RecIndex + Node.RecordCount;
            FDataList.Insert(ARecordIndex, ARecord);
            // 添加完最底层节点需要维护主索引
            iKey := FIndexNodeList.IndexOf(Node);
            for J := iKey + 1 to FIndexNodeList.Count - 1 do
              Inc(TsdIndexNode(FIndexNodeList[J]).FRecIndex);
          end
          else
            ParentNode := Node;

          Continue;
        end
        else // 没有符合要求的节点
        begin
          NextNode := Node;
        end;
      end;
      // 开始添加节点
      Result := TsdIndexNode.Create(Self);
      Result.Parent := ParentNode;
      Result.Value := vData;
      //Result.RecIndex := ARecordIndex;
      // 有后兄弟
      if NextNode <> nil then
      begin
        // 插入到中间
        if NextNode.PrevSibling <> nil then
        begin
          Node := NextNode.PrevSibling;
          Node.NextSibling := Result;
          Result.PrevSibling := Node;
          Result.FRecIndex := NextNode.RecIndex;
        end
        // 插入到最前
        else
        begin
          ParentNode.FirstChild := Result;
          Result.FRecIndex := ParentNode.RecIndex;
        end;
        NextNode.PrevSibling := Result;
        Result.NextSibling := NextNode;
        iKey := FIndexNodeList.IndexOf(NextNode);
      end
      // 无后兄弟
      else
      begin
        // 找到最后一个兄弟
        if ParentNode.LastChild <> nil then
        begin
          Node := ParentNode.LastChild;
          Result.PrevSibling := Node;
          // 插入位置是后兄弟最后一个后代节点之后
          ChildNode := Node;
          if ChildNode.LastChild <> nil then
            ChildNode := ChildNode.LastPosterity;
          iKey := FIndexNodeList.IndexOf(ChildNode) + 1;
          Result.FRecIndex := ChildNode.RecIndex + ChildNode.RecordCount;
          // Node.RecordCount需要调用NextSibling，所以NextSibling赋值要放在后面
          Node.NextSibling := Result;
        end
        // 没有最后兄弟表示没有子节点
        else
        begin
          ParentNode.FirstChild := Result;
          iKey := FIndexNodeList.IndexOf(ParentNode) + 1;
          // 第一层第一个节点RecIndex为0，下层第一个字节的跟父节点一样
          if Result.Level = 0 then
            Result.FRecIndex := 0
          else
            Result.FRecIndex := ParentNode.RecIndex;
        end;
      end;
      ParentNode := Result;
      // 插入节点列表
      if iKey = -1 then iKey := 0;
      FIndexNodeList.Insert(iKey, Result);
      // 添加完最底层节点
      if I = FFieldList.Count - 1 then
      begin
        // 插入FDataList
        ARecordIndex := Result.RecIndex;
        FDataList.Insert(ARecordIndex, ARecord);
        // 维护主索引
        for J := iKey + 1 to FIndexNodeList.Count - 1 do
          Inc(TsdIndexNode(FIndexNodeList[J]).FRecIndex);
      end;
    end;
  end;

var
  I, iIdx, iKey: Integer;
  Node: TsdIndexNode;
begin
  Result := -1;
  // 此记录修改不影响本索引，则退出
  if FChangedList.IndexOf(ARecord) < 0 then Exit;
  // 如果是修改值，先将记录取出
  if FDataList.IndexOf(ARecord) >= 0 then
    InnerDelete(ARecord);
  // 插入数据记录
  //iIdx := FindInsertPos(ARecord);
  //FDataList.Insert(iIdx, ARecord);
  // 生成索引数据
  Node := AddIndexNode(ARecord, iIdx);
  // 容错处理：若插入失败则重新生成索引，只在调试状态提示
  if Node = nil then
    try
      raise EsdIndex.Create('Failed to add record to index');
    except
      Sort;
    end;
  Result := iIdx;
  FChangedList.Remove(ARecord);
  //GetDebugData;
end;

procedure TsdIndex.InnerDelete(ARecord: TsdDataRecord);

  procedure DeleteNode(Node: TsdIndexNode);
  begin
    // 因为此处不会有子节点，所以不处理子节点
    // 本节点是父节点第一个子节点
    if Node.Parent.FirstChild = Node then
      Node.Parent.FirstChild := Node.NextSibling;
    // 处理兄弟节点
    if Node.PrevSibling <> nil then
    begin
      Node.PrevSibling.NextSibling := Node.NextSibling;
      if Node.NextSibling <> nil then
        Node.NextSibling.PrevSibling := Node.PrevSibling;
    end
    else
      if Node.NextSibling <> nil then
        Node.NextSibling.PrevSibling := nil;
    FIndexNodeList.Remove(Node);
    Node.Free;
  end;

var
  I, iIdx, iKey: Integer;
  Node, Parent: TsdIndexNode;
begin
  iIdx := FDataList.IndexOf(ARecord);
  if iIdx < 0 then Exit;
  // 获得记录所属索引节点（最底层节点）
  iKey := FindExistKeyIndex(iIdx);
  if iKey < 0 then
    raise EsdIndex.Create(Format('Index error: Can not find key, index(%d)', [iIdx]));
  if iKey >= 0 then
  begin
    Node := TsdIndexNode(FIndexNodeList[iKey]);
    // 只有一条数据记录，则直接删除索引记录
    if FDataList.Count = 1 then
      Clear
    // 不止一条数据记录
    else
    begin
      // 且只有一条索引记录，则不需处理; 处理有多条索引记录
      if FIndexNodeList.Count > 1 then
      begin
        // 当前索引记录只包含一条数据记录
        if Node.RecordCount = 1 then
        begin
          Parent := Node.Parent;
          // 移除索引记录
          DeleteNode(Node);
          // 父项如果没有子节点，也要移除
          while (Parent <> FIndexRoot) and (Parent.ChildCount = 0) do
          begin
            Node := Parent;
            Parent := Parent.Parent;
            DeleteNode(Node);
            // 2016-09-15 删除了父节点也要将iKey减1
            Dec(iKey);
          end;
          // 维护受影响的索引记录
          for I := iKey to FIndexNodeList.Count - 1 do
            Dec(TsdIndexNode(FIndexNodeList[I]).FRecIndex);
        end
        // 指定数据记录不是当前索引记录的唯一记录
        else
        begin
          // 维护受影响的索引记录
          if iKey < FIndexNodeList.Count - 1 then
            for I := iKey + 1 to FIndexNodeList.Count - 1 do
              Dec(TsdIndexNode(FIndexNodeList[I]).FRecIndex);
        end;
      end;
    end;
  end;
  FDataList.Remove(ARecord);
end;

procedure TsdIndex.Sort;

  procedure QuickSort(iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    MidRec: TsdDataRecord;
  begin
    Lo := iLo;
    Hi := iHi;
    MidRec := TsdDataRecord(FDataList[(iLo + iHi) div 2]);
    repeat
      while CompareData(TsdDataRecord(FDataList[Lo]), MidRec) < 0 do
        Inc(Lo);
      while CompareData(TsdDataRecord(FDataList[Hi]), MidRec) > 0 do
        Dec(Hi);
      if Lo <= Hi then
      begin
        if Lo < Hi then  begin
          FDataList.Exchange(Lo, Hi);
        end;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(iLo, Hi);
    if Lo < iHi then QuickSort(Lo, iHi);
  end;

var
  I, J: Integer;
  vData: Variant;
  DataType: TFieldType;
  PeriodNode, PrevNode, Node: TsdIndexNode;
begin
  Clear;
  FDataList.Assign(DataSet.FDataList);
  // 排序
  if FDataList.Count > 0 then QuickSort(0, FDataList.Count - 1);
  //GetDebugData;
  // 生成索引树
  PeriodNode := FIndexRoot;
  for I := 0 to FDataList.Count - 1 do
  begin
    for J := 0 to LevelCount - 1 do
    begin
      vData := GetValue(TsdDataRecord(FDataList[I]), J);
      DataType := TsdField(FFieldList[J]).DataType;
      // 获取当前节点的前兄弟节点
      // 当前节点与前一节点同层
      if J = PeriodNode.Level then
        PrevNode := PeriodNode
      // 当前节点比前一节点层次高
      else if J < PeriodNode.Level then
      begin
        PrevNode := PeriodNode;
        repeat
          PrevNode := PrevNode.Parent;
        until J = PrevNode.Level;
      end
      // 当前节点比前一节点层次低
      else
        PrevNode := nil;
      // 前一节点是父节点 或 前兄弟节点值有变化 则建立新节点
      if (PrevNode = nil) or (CompareValue(PrevNode.Value, vData) <> 0) then
      begin
        Node := TsdIndexNode.Create(Self);
        // 前一节点是前面分支的子节点(<) 或 是兄弟节点(=)
        if J <= PeriodNode.Level then
        begin
          Node.Parent := PrevNode.Parent;
          Node.PrevSibling := PrevNode;
          PrevNode.NextSibling := Node;
        end
        // 前一节点是父节点
        else if J = PeriodNode.Level + 1 then
        begin
          Node.Parent := PeriodNode;
          PeriodNode.FirstChild := Node;
        end
        else
        begin
          Node.Free;
          raise EsdIndex.Create('Sort index error');
        end;
        Node.RecIndex := I;
        Node.Value := vData;
        Node.DataType := DataType;
        FIndexNodeList.Add(Node);
        PeriodNode := Node;
      end;
    end;
  end;
  FChangedList.Clear;
  GetDebugData;
end;

(*function TsdIndex.FindKeyIndex(AValue: Variant; ALevel: Integer): Integer;
var
  KeyList: TList;
  iLow, iHigh, iIndex: Integer;
begin
  Result := -1;
  KeyList := TList(FIndexNodeList[ALevel]);
  iLow := 0;
  iHigh := KeyList.Count - 1;

  if KeyList.Count = 0 then
  begin
    //Result:= 0;
    Exit;
  end;
  // 二分法查找给定KeyID节点的序号
  while iLow <= iHigh do
  begin
    iIndex := (iLow + iHigh) div 2;
    if PsdIndexData(KeyList[iIndex])^.Value = AValue then
    begin
      Result := iIndex;
      Break;
    end
    else if PsdIndexData(KeyList[iIndex])^.Value < AValue then
      iLow := iIndex + 1
    else
      iHigh := iIndex - 1;
  end;
end; *)

procedure TsdIndex.GetDebugData;
var
  I: Integer;
  sdRec: TsdDataRecord;
  Node: TsdIndexNode;
  Log: TStringList;
begin
(*  if LevelCount < 1 then Exit;
  Log := TStringList.Create;
  Log.Add(Format('Sort Data: %d', [FDataList.Count]));
  Log.Add('I, ParentID, ID');
  for I := 0 to FDataList.Count - 1 do
  begin
    sdRec := TsdDataRecord(FDataList[I]);
    Log.Add(Format('%d, %s, %s', [I, sdRec.ValueByName('ParentNodeID').AsString, sdRec.ValueByName('NodeID').AsString]));
  end;
  Log.Add(Format('Node Data: %d', [FIndexNodeList.Count]));
  Log.Add('I, Value, Level, ChildCount, RecIndex');
  for I := 0 to FIndexNodeList.Count - 1 do
  begin
    Node := TsdIndexNode(FIndexNodeList[I]);
    sdRec := TsdDataRecord(FDataList[Node.RecIndex]);
    Log.Add(Format('%d, %d, %d, %d, %d, %d', [I, sdVarToInteger(Node.Value),
      Node.Level, Node.ChildCount, Node.RecIndex, sdRec.ValueByName('NodeID').AsInteger]));
  end;
  Log.SaveToFile('E:\Temp\1.log');
  Log.Free;   *)
end;

procedure TsdIndex.SetFieldNames(const Value: string);
begin
  FFieldNames := Value;
  ParseFields;
  if DataSet.Active then
    Sort;
end;

procedure TsdIndex.ParseFields;
var
  NameList: TStringList;
  I: Integer;
  Field: TsdField;
begin
  FFieldList.Clear;
  NameList := TStringList.Create;
  try
    NameList.Delimiter := ';';
    NameList.DelimitedText := FFieldNames;
    for I := 0 to NameList.Count - 1 do
    begin
      Field := DataSet.FFieldList.FieldByName(Trim(NameList[I]));
      if Field = nil then
      begin
        FFieldList.Clear;
        raise EsdIndex.Create(Format('Can not find field ''%s''', [NameList[I]]));
      end;
      FFieldList.Add(Field);
    end;
  finally
    NameList.Free;
  end;
end;

function TsdIndex.GetLevelCount: Integer;
begin
  Result := FFieldList.Count;
end;

function TsdIndex.FindKeyIndex(KeyValues: Variant): Integer;
var
  Node: TsdIndexNode;
begin
  Result := -1;
  Node := FindIndexNode(KeyValues);
  if Node <> nil then
    Result := Node.RecIndex;
end;

function TsdIndex.FindKeyLastIndex(KeyValues: Variant): Integer;
var
  Node: TsdIndexNode;
begin
  Result := -1;
  Node := FindIndexNode(KeyValues);
  if Node <> nil then
    Result := Node.RecIndex + Node.RecordCount - 1;
end;

{  function FindIndexNode(Value: Variant; Parent: TsdIndexNode): TsdIndexNode;
  var
    Node: TsdIndexNode;
  begin
    Result := nil;
    Node := Parent.FirstChild;
    while Node <> nil do
    begin
      // 若索引节点值大于目标值，则直接退出
      if CompareValue(Node.Value, Value) > 0 then Break;
      if CompareValue(Node.Value, Value) = 0 then
      begin
        Result := Node;
        Break;
      end;
      Node := Node.NextSibling;
    end;
  end;

var
  KeyCount, I: Integer;
  V: Variant;
  KeyNode: TsdIndexNode;
begin
  Result := -1;
  if VarIsArray(KeyValues) then
    KeyCount := VarArrayHighBound(KeyValues, 1) - VarArrayLowBound(KeyValues, 1)
  else
    KeyCount := 1;
  if KeyCount > LevelCount then KeyCount := LevelCount;
  KeyNode := FIndexRoot;
  for I := 0 to KeyCount - 1 do
  begin
    if VarIsArray(KeyValues) then
      V := KeyValues[I]
    else
      V := KeyValues;

    KeyNode := FindIndexNode(V, KeyNode);
    if KeyNode = nil then
      Exit;
  end;
  Result := KeyNode.RecIndex;
end;}

function TsdIndex.FindKey(KeyValues: Variant): TsdDataRecord;
begin
  Result := Records[FindKeyIndex(KeyValues)];
end;

procedure TsdIndex.SetName(const Value: string);
begin
  if FOwner.FindByName(Value) <> nil then
    raise EsdIndex.Create(Format('Index "%s" exists', [Value]));
  FName := Value;
end;

function TsdIndex.SameKeyFields(AFieldNames: string): Boolean;
var
  NameList: TStringList;
  I: Integer;
  Field: TsdField;
begin
  Result := True;
  NameList := TStringList.Create;
  try
    NameList.Delimiter := ';';
    NameList.DelimitedText := AFieldNames;
    if NameList.Count > LevelCount  then
    begin
      Result := False;
      Exit;
    end;
    for I := 0 to NameList.Count - 1 do
    begin
      Field := TsdField(FFieldList[I]);
      if not SameText(Field.FieldName, Trim(NameList[I])) then
      begin
        Result := False;
        Break;
      end;
    end;
  finally
    NameList.Free;
  end;
end;

function TsdIndex.GetDataSet: TsdDataSet;
begin
  Result := FOwner.FOwner;
end;

function TsdIndex.HasKeyFields(AFieldNames: string): Boolean;
var
  NameList: TStringList;
  I, KeyCount: Integer;
  Field: TsdField;
begin
  Result := True;
  NameList := TStringList.Create;
  try
    NameList.Delimiter := ';';
    NameList.DelimitedText := AFieldNames;
    if NameList.Count > LevelCount  then
    begin
      Result := False;
      Exit;
    end;
    if NameList.Count < LevelCount then
      KeyCount := NameList.Count
    else
      KeyCount := LevelCount;
    for I := 0 to KeyCount - 1 do
    begin
      Field := TsdField(FFieldList[I]);
      if not SameText(Field.FieldName, Trim(NameList[I])) then
      begin
        Result := False;
        Break;
      end;
    end;
  finally
    NameList.Free;
  end;
end;

function TsdIndex.CompareValue(const AValue1, AValue2: Variant): Integer;
var
  V1, V2: Variant;
  VType1, VType2: TVarType;
begin
  // 为空的值可选择是否排到最后，方便表格显示
  if FSortNullToLast and (VarIsNull(AValue1) or VarIsNull(AValue2)) or (VarToStr(AValue1) = '') or (VarToStr(AValue2) = '') then
  begin
    if (VarIsNull(AValue1) or (VarToStr(AValue1) = '')) and (not (VarIsNull(AValue2) or (VarToStr(AValue2) = ''))) then
      Result := 1
    else if (not (VarIsNull(AValue1) or (VarToStr(AValue1) = ''))) and (VarIsNull(AValue2) or (VarToStr(AValue2) = '')) then
      Result := -1
    else
      Result := 0;
  end
  else
  begin
    // 处理两个值类型不一样的情况。暂时只遇到一个为字符串的情况，只处理这个 
    V1 := AValue1;
    V2 := AValue2;
    VType1 := VarType(V1);
    VType2 := VarType(V2);
    if (VType1 <> VType2) and ((VType1 = varString) or (VType2 = varString)) then
    begin
      V1 := VarToStr(V1);
      V2 := VarToStr(V2);
    end;

    if not FDescend then
    begin
      // Result: 0:  1 = 2    >0:  1 > 2   <0:  1 < 2
      if V1 > V2 then
        Result := 1
      else if V1 < V2 then
        Result := -1
      else
        Result := 0;
    end
    else
    begin
      // Result: 0:  1 = 2    >0:  1 < 2   <0:  1 > 2
      if V1 > V2 then
        Result := -1
      else if V1 < V2 then
        Result := 1
      else
        Result := 0;
    end;
  end;
end;

procedure TsdIndex.SetDescend(const Value: Boolean);
begin
  FDescend := Value;
end;

procedure TsdIndex.AssignRecords(AList: TList);
begin
  AList.Assign(FDataList);
end;

function TsdIndex.FindNearestKeyIndex(KeyValues: Variant; var RecIndex: Integer;
  AIsEnd: Boolean): TsdIndexFlag;

  function FindIndexNode(Value: Variant; Parent: TsdIndexNode; var AFlag: TsdIndexFlag): TsdIndexNode;
  var
    Node: TsdIndexNode;
  begin
    Result := nil;
    AFlag := sifFoundIndex;
    Node := Parent.FirstChild;
    if Node = nil then
    begin
      AFlag := sifNull;
      Exit;
    end;
    // 若目标值小于第一个索引子节点值，则说明目标值小于所有索引值，返回空
    if CompareValue(Value, Node.Value) < 0 then
    begin
      AFlag := sifLessThanMin;
      Exit;
    end;
    Node := Parent.LastChild;
    // 若目标值大于最后一个索引子节点值，则说明目标值大于所有索引值，返回最后节点
    if CompareValue(Value, Node.Value) > 0 then
    begin
      Result := Node;
      AFlag := sifMoreThanMax;
      Exit;
    end;
    Node := Parent.FirstChild;
    while Node <> nil do
    begin
      if CompareValue(Node.Value, Value) = 0 then
      begin
        Result := Node;
        Break;
      end
      // 若索引节点值大于目标值，则说明前面无相同值，返回最接近节点（前一个节点）
      else if CompareValue(Node.Value, Value) > 0 then
      begin
        Result := Node.PrevSibling;
        AFlag := sifInTheMid;
        Break;
      end;
      Node := Node.NextSibling;
    end;
  end;

var
  KeyCount, I: Integer;
  V: Variant;
  KeyNode, ParentNode: TsdIndexNode;
  Flag: TsdIndexFlag;
begin
  Result := sifInTheMid;
  RecIndex := -1;
  if VarIsArray(KeyValues) then
    KeyCount := VarArrayHighBound(KeyValues, 1) - VarArrayLowBound(KeyValues, 1) + 1
  else
    KeyCount := 1;
  if KeyCount > LevelCount then KeyCount := LevelCount;
  KeyNode := FIndexRoot;
  Flag := sifFoundIndex;
  for I := 0 to KeyCount - 1 do
  begin
    if VarIsArray(KeyValues) then
      V := KeyValues[I]
    else
      V := KeyValues;

    ParentNode := KeyNode;
    KeyNode := FindIndexNode(V, KeyNode, Flag);
    case Flag of
      sifLessThanMin:
      begin
        // 如果是第二层及以下比最小值小，则返回父节点，并设置Flag为已找到
        if I > 0 then
        begin
          Flag := sifFoundIndex;
          KeyNode := ParentNode;
        end;
        Break;
      end;
      sifFoundIndex:
      begin
        // do nothing
      end;
      sifInTheMid:
      begin
        // 在中间，则KeyNode是前一个节点，返回前一个节点的最后后代节点
        if KeyNode.FirstChild <> nil then
          KeyNode := KeyNode.LastPosterity;
        Break;
      end;
      sifMoreThanMax:
      begin
        // 比最大更大，返回父节点的最后后代节点
        KeyNode := ParentNode.LastPosterity;
        Break;
      end;
      sifNull:
      begin
        // 如果是空且是第二层及以下，则返回父节点，并设置Flag为已找到
        if I > 0 then
        begin
          Flag := sifFoundIndex;
          KeyNode := ParentNode;
        end;
        Break;
      end;
    end;
    // 如果找不到指定节点
    if KeyNode = nil then
    begin
      // 且不是第一层
      if I > 0 then
        Result := sifFoundIndex
      else
        Result := Flag;
      Exit;
    end;
    // 只找到接近节点，且有子节点，则最接近的子节点是其最后一个子节点
    if Flag <> sifFoundIndex then
    begin
      if KeyNode.FirstChild <> nil then
        KeyNode := KeyNode.LastPosterity;
      Break;
    end;
    RecIndex := KeyNode.RecIndex;
  end;
  Result := Flag;
  case Result of
    sifLessThanMin:
    begin
      if AIsEnd then
        RecIndex := -1
      else
        RecIndex := 0;
    end;
    sifFoundIndex:
    begin
      // 如AIsEnd=True，返回包含本节点记录数的最后一个索引值
      if AIsEnd then
        RecIndex := KeyNode.RecIndex + KeyNode.RecordCount - 1
      else
        RecIndex := KeyNode.RecIndex;
    end;
    sifInTheMid:
    begin
      if AIsEnd then
        RecIndex := KeyNode.RecIndex + KeyNode.RecordCount - 1
      else
        RecIndex := KeyNode.RecIndex + KeyNode.RecordCount;
    end;
    sifMoreThanMax:
    begin
      if AIsEnd then
        RecIndex := KeyNode.RecIndex + KeyNode.RecordCount - 1
      else
        RecIndex := KeyNode.RecIndex + KeyNode.RecordCount;
    end;
    sifNull:
    begin
      RecIndex := -1;
    end;
  end;
end;

function TsdIndex.GetFields(Index: Integer): TsdField;
begin
  Result := TsdField(FFieldList[Index]);
end;

function TsdIndex.IndexOf(ARecord: TsdDataRecord): Integer;
begin
  Result := FDataList.IndexOf(ARecord);
end;

function TsdIndex.Exchange(const Index1, Index2: Integer): Integer;
var
  Rec1, Rec2: TsdDataRecord;
begin
  Rec1 := Records[Index1];
  Rec2 := Records[Index2];
  Result := Exchange(Rec1, Rec2);
end;

function TsdIndex.Exchange(ARecord1, ARecord2: TsdDataRecord): Integer;
var
  I: Integer;
  vKey1, vKey2: array of Variant;
begin
  SetLength(vKey1, LevelCount);
  SetLength(vKey2, LevelCount);
  for I := 0 to LevelCount - 1 do
  begin
    vKey1[I] := GetValue(ARecord1, I);
    vKey2[I] := GetValue(ARecord2, I);
  end;
  ARecord1.BeginUpdate;
  for I := 0 to LevelCount - 1 do
    ARecord1.ValueByName(Fields[I].FieldName).AsVariant := vKey2[I];
  ARecord1.EndUpdate;
  ARecord2.BeginUpdate;
  for I := 0 to LevelCount - 1 do
    ARecord2.ValueByName(Fields[I].FieldName).AsVariant := vKey1[I];
  ARecord2.EndUpdate;
  Result := IndexOf(ARecord1);
end;

function TsdIndex.Insert(ARecord: TsdDataRecord; Index: Integer): Integer;
begin
  FDataList.Insert(Index, ARecord);
  Result := IndexOf(ARecord);
end;

procedure TsdIndex.LoadProperty(Reader: TReader);
var
  PropName: string;
  v: Variant;
begin
  Reader.ReadListBegin;
  while not Reader.EndOfList do
  begin
    PropName := Reader.ReadStr;
    v := Reader.ReadVariant;
    if GetPropInfo(Self, PropName) <> nil then
      SetPropValue(Self, PropName, v);
  end;
  Reader.ReadListEnd;
end;

procedure TsdIndex.SaveProperty(Writer: TWriter);

  procedure WriteProp(const AName: string; AValue: Variant);
  begin
    Writer.WriteStr(AName);
    Writer.WriteVariant(AValue);
  end;

begin
  Writer.WriteListBegin;
  WriteProp('Name', Name);
  WriteProp('FieldNames', FieldNames);
  Writer.WriteListEnd;
end;

function TsdIndex.RecordsByKey(KeyValues: Variant; List: TList): Integer;
var
  iPos, I: Integer;
  IndexNode: TsdIndexNode;
  Rec: TsdDataRecord;
begin
  Result := 0;
  List.Clear;
  if not VarIsNull(KeyValues) then
  begin
    Rec := FindKey(KeyValues);
    if Rec = nil then Exit;
    iPos := IndexOf(Rec);
    IndexNode := FindIndexNode(KeyValues);
    repeat
      List.Add(Rec);
      Inc(iPos);
      Rec := Records[iPos];
      if (Rec <> nil) and (not IndexNode.HasRecord(Rec)) then
        Break;
    until Rec = nil;
  end
  else
    List.Assign(FDataList);
  Result := List.Count;
end;

function TsdIndex.RecordCountByKey(KeyValues: Variant): Integer;
var
  IndexNode: TsdIndexNode;
begin
  Result := 0;
  if not VarIsNull(KeyValues) then
  begin
    IndexNode := FindIndexNode(KeyValues);
    // 如果DataSet.IsUpdating，索引不刷新，这里可能为nil
    if IndexNode <> nil then
      Result := IndexNode.RecordCount;
  end;
end;

function TsdIndex.FindIndexNode(KeyValues: Variant): TsdIndexNode;

  // 来自TStringList.Find的二分查找代码，精妙简洁，略带炫技
  function QuickFind(Value: Variant; Parent: TsdIndexNode; const iLo, iHi: Integer): TsdIndexNode;
  var
    Lo, Hi, Mid, iResult: Integer;
    Node, MidNode: TsdIndexNode;
  begin
    Result := nil;
    Lo := iLo;
    Hi := iHi;
    while Lo <= Hi do
    begin
      Mid := (Lo + Hi) shr 1;
      MidNode := Parent.Children[Mid];
      iResult := CompareValue(MidNode.Value, Value);
      if iResult < 0 then
        Lo := Mid + 1
      else
      begin
        Hi := Mid - 1;
        if iResult = 0 then
          Result := MidNode;
      end;
    end;
  end;

  function FindNode(Value: Variant; Parent: TsdIndexNode): TsdIndexNode;
  begin
    // 二分查找
    Result := QuickFind(Value, Parent, 0, Parent.ChildCount - 1);
  end;

var
  iKeyCount, I: Integer;
  V: Variant;
  KeyNode: TsdIndexNode;
begin
  Result := nil;
  iKeyCount := KeyCount(KeyValues);
  KeyNode := FIndexRoot;
  for I := 0 to iKeyCount - 1 do
  begin
    if VarIsArray(KeyValues) then
      V := KeyValues[I]
    else
      V := KeyValues;

    KeyNode := FindNode(V, KeyNode);
    if KeyNode = nil then
      Exit;
  end;
  Result := KeyNode;
end;

function TsdIndex.KeyCount(KeyValues: Variant): Integer;
begin
  Result := 0;
  if VarIsArray(KeyValues) then
    Result := VarArrayHighBound(KeyValues, 1) - VarArrayLowBound(KeyValues, 1) + 1
  else
    Result := 1;
  if Result > LevelCount then Result := LevelCount;
end;

function TsdIndex.IsKeyField(AFieldName: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to LevelCount - 1 do
    if SameText(AFieldName, Fields[I].FieldName) then
    begin
      Result := True;
      Break;
    end;
end;

function TsdIndex.GetRecordCount: Integer;
begin
  Result := FDataList.Count;
end;

procedure TsdIndex.Delete(ARecord: TsdDataRecord);
begin
  InnerDelete(ARecord);
  FChangedList.Remove(ARecord);
end;

procedure TsdIndex.AddChangedRecord(ARecord: TsdDataRecord);
begin
  if FChangedList.IndexOf(ARecord) < 0 then
    FChangedList.Add(ARecord);
end;

function TsdIndex.CompareIndex(ARec1, ARec2: TsdDataRecord): Integer;
begin
  if ARec1.FIndex > ARec2.FIndex then Result := 1
  else if ARec1.FIndex < ARec2.FIndex then Result := -1
  else Result := 0;
end;

{ TsdIndexList }

function TsdIndexList.Add: TsdIndex;
begin
  Result := TsdIndex.Create(Self);
  FList.Add(Result);
  //Result.GetDebugData;
end;

procedure TsdIndexList.Check(ARecord: TsdDataRecord);
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    Items[I].Check(ARecord);
end;

procedure TsdIndexList.Clear;
var
  I: Integer;
begin
  while FList.Count > 0 do
  begin
    Items[0].Free;
    FList.Delete(0);
  end;
end;

procedure TsdIndexList.ClearData;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    Items[I].Clear;
end;

constructor TsdIndexList.Create(AOwner: TsdDataSet);
begin
  FOwner := AOwner;
  FList := TList.Create;
end;

procedure TsdIndexList.Delete(Name: string);
var
  Index: TsdIndex;
begin
  Index := FindByName(Name);
  FList.Remove(Index);
  FreeAndNil(Index);
end;

procedure TsdIndexList.Delete(Index: TsdIndex);
begin
  if FList.Remove(Index) >= 0 then
    FreeAndNil(Index);
end;

procedure TsdIndexList.DeleteRecord(ARecord: TsdDataRecord);
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    Items[I].Delete(ARecord);
end;

destructor TsdIndexList.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;

procedure TsdIndexList.Exchange(Index1, Index2: TsdIndex);
var
  idx1, idx2: Integer;
begin
  idx1 := FList.IndexOf(Index1);
  idx2 := FList.IndexOf(Index2);
  if idx1 < 0 then
    raise EsdDataSet.Create(Format('DataSet do not own field "%s"', [Index1.Name]));
  if idx2 < 0 then
    raise EsdDataSet.Create(Format('DataSet do not own field "%s"', [Index2.Name]));

  FList.Exchange(idx1, idx2);
end;

function TsdIndexList.FindByKeyFields(KeyFields: string;
  Partial: Boolean): TsdIndex;
var
  I: Integer;
  Index: TsdIndex;
begin
  Result := nil;
  for I := 0 to FList.Count - 1 do
  begin
    Index := Items[I];
    if Partial then
    begin
      if Index.HasKeyFields(KeyFields) then
      begin
        Result := Index;
        Break;
      end;
    end
    else
      if Index.SameKeyFields(KeyFields) then
      begin
        Result := Index;
        Break;
      end;
  end;
end;

function TsdIndexList.FindByName(Name: string): TsdIndex;
var
  I: Integer;
  Index: TsdIndex;
begin
  Result := nil;
  if Name = '' then Exit; 
  for I := 0 to FList.Count - 1 do
  begin
    Index := Items[I];
    if SameText(Name, Index.Name) then
    begin
      Result := Index;
      Break;
    end;
  end;
end;

function TsdIndexList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TsdIndexList.GetItems(I: Integer): TsdIndex;
begin
  Result := TsdIndex(FList[I]);
end;

function TsdIndexList.IsKeyField(AFieldName: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to FList.Count - 1 do
    if Items[I].IsKeyField(AFieldName) then
    begin
      Result := True;
      Break;
    end;
end;

procedure TsdIndexList.Sort;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    Items[I].Sort;
end;

{ TsdField }

procedure TsdField.AddLookupCol(AViewCol: TsdViewColumn);
begin
  if FLookupList.IndexOf(AViewCol) < 0 then
    FLookupList.Add(AViewCol);
end;

procedure TsdField.ClearLookupDataSet;
var
  I: Integer;
begin
  for I := 0 to FLookupList.Count - 1 do
    TsdViewColumn(FLookupList[I]).FLookupDataSet := nil;
end;

procedure TsdField.ClearLookupField;
var
  I: Integer;
begin
  for I := 0 to FLookupList.Count - 1 do
    TsdViewColumn(FLookupList[I]).FLookupField := nil;
end;

constructor TsdField.Create(AOwner: TsdFieldList);
begin
  FOwner := AOwner;
  FDataType := ftUnknown;
  FIsKey := False;
  FNeedProcessName := False;
  FInnerValidChars := [#0..#255];
  FValidChars := [];
  FLookupList := TList.Create;
end;

destructor TsdField.Destroy;
begin
  ClearLookupField;
  FLookupList.Free;
  inherited;
end;

function TsdField.GetDataSet: TsdDataSet;
begin
  Result := FOwner.FDataSet;
end;

function TsdField.GetDataSize: Integer;
begin
  case FDataType of
    ftUnknown, ftString, ftWideString, ftMemo: Result := FDataSize;
    ftSmallint: Result := SizeOf(SmallInt);
    ftInteger: Result := SizeOf(Integer);
    ftWord: Result := SizeOf(Word);
    ftBoolean: Result := SizeOf(Boolean);
    ftFloat: Result := SizeOf(Double);
    ftCurrency, ftBCD: Result := SizeOf(Currency);
    ftFMTBCD: Result := SizeOf(TBCD);
    ftDateTime: Result := SizeOf(TDateTime);
  else
    Result := FDataSize;
  end;
end;

function TsdField.GetFieldNo: Integer;
begin
  Result := FOwner.FList.IndexOf(Self);
end;

function TsdField.HasLookup: Boolean;
begin
  Result := FLookupList.Count > 0;
end;

function TsdField.IsBlobField: Boolean;
begin
  Result := FDataType in [ftMemo];
end;

function TsdField.IsValidChar(InputChar: Char): Boolean;
begin
  if ValidChars = [] then
    Result := InputChar in FInnerValidChars
  else
    Result := InputChar in ValidChars;
end;

function TsdField.IsVarField: Boolean;
begin
  Result := FDataType in [ftString, ftWideString, ftMemo];
end;

procedure TsdField.LoadProperty(Reader: TReader);
var
  PropName: string;
  v: Variant;
begin
  Reader.ReadListBegin;
  while not Reader.EndOfList do
  begin
    PropName := Reader.ReadStr;
    v := Reader.ReadVariant;
    if SameText(PropName, 'NeedProcessName') then
      NeedProcessName := v
    else if SameText(PropName, 'IsKey') then
      IsKey := v
    else if GetPropInfo(Self, PropName) <> nil then
      SetPropValue(Self, PropName, v);
  end;
  Reader.ReadListEnd;
end;

procedure TsdField.ProcessFieldName(FieldName: string);
begin
  if (DataSet.Provider = nil) or (not NeedProcessName) then Exit;
  NeedProcessName := False;
  DataSet.Provider.AssignField(FieldName);
end;

procedure TsdField.RefreshLookup;
var
  I: Integer;
begin
  for I := 0 to FLookupList.Count - 1 do
  begin
    TsdViewColumn(FLookupList[I]).LookupChanged;
  end;
end;

procedure TsdField.RemoveLookupCol(AViewCol: TsdViewColumn);
begin
  FLookupList.Remove(AViewCol);
end;

procedure TsdField.SaveProperty(Writer: TWriter);

  procedure WriteProp(const AName: string; AValue: Variant);
  begin
    Writer.WriteStr(AName);
    Writer.WriteVariant(AValue);
  end;

begin
  Writer.WriteListBegin;
  WriteProp('Name', Name);
  WriteProp('FieldName', FieldName);
  WriteProp('DataType', DataType);
  WriteProp('DataSize', DataSize);
  WriteProp('IsKey', IsKey);
  WriteProp('NeedProcessName', NeedProcessName);
  WriteProp('Precision', Precision);
  WriteProp('Size', Size);
  Writer.WriteListEnd;
end;

procedure TsdField.SetDataSize(const Value: Integer);
begin
  FDataSize := Value;
end;

procedure TsdField.SetDataType(const Value: TFieldType);
begin
  if not (Value in [ftString, ftWideString, ftSmallint, ftInteger, ftWord,
      ftBoolean, ftFloat,
      ftCurrency, ftBCD, ftFMTBCD, ftDateTime, ftMemo]) then
    raise EsdDataSet.Create(Format('Do not support data type ''%d''', [Ord(Value)]));
  if FDataType <> Value then
    FDataType := Value;
  if Value in [ftString, ftWideString] then
    FDataSize := 255
  else if Value in [ftMemo] then
    FDataSize := 4000;
  case DataType of
    ftBoolean, ftString, ftWideString, ftMemo, ftDateTime:
      ;
    ftSmallint, ftInteger, ftWord:
      ValidChars := ['+', '-', '0'..'9'];
    ftFloat:
      ValidChars := [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
    ftCurrency, ftBCD, ftFMTBCD:
      ValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
  end;
end;

procedure TsdField.SetFieldName(const Value: string);
begin
  if NeedProcessName then
    ProcessFieldName(Value)
  else
  begin
    FFieldName := Value;
    Name := Value;
  end;
end;

procedure TsdField.SetPrecision(const Value: Integer);
begin
  FPrecision := Value;
end;

procedure TsdField.SetSize(const Value: Integer);
begin
  FSize := Value;
end;

{ TsdFieldList }

function TsdFieldList.Add: TsdField;

  function NewName: string;
  var
    I, No, iTemp, iPos, iCode: Integer;
    strName, strNo: string;
  begin
    Result := '';
    if Count = 0 then
    begin
      Result := 'Field1';
      Exit;
    end;
    No := 0;
    for I := 0 to Count - 1 do
    begin
      strName := Fields[I].Name;
      iPos := Length('Field');
      strNo := Copy(strName, iPos + 1, Length(strName) - iPos);
      Val(strNo, iTemp, iCode);
      if (iCode = 0) and (iTemp > No) then
        No := iTemp;
    end;
    Inc(No);
    Result := Format('Field%d', [No]);
  end;

var
  NeedActive: Boolean;
begin
  NeedActive := False;
  if FDataSet.IsDesigning and FDataSet.Active then
  begin
    FDataSet.Close;
    NeedActive := True;
  end
  else if FDataSet.Active then
    raise EsdDataSet.Create('Can not add a field on a active dataset');

  Result := TsdField.Create(Self);
  Result.Name := NewName;
  FList.Add(Result);

  if NeedActive then FDataSet.Open;
end;

function TsdFieldList.Add(const FieldName: String; DataType: TFieldType;
  Size: Integer): TsdField;
var
  NeedActive: Boolean;
begin
  NeedActive := False;
  if FDataSet.IsDesigning and FDataSet.Active then
  begin
    FDataSet.Close;
    NeedActive := True;
  end
  else if FDataSet.Active then
    raise EsdDataSet.Create('Can not add a field on a active dataset');

  Result := TsdField.Create(Self);
  Result.FieldName := FieldName;
  Result.DataType := DataType;
  Result.DataSize := Size;
  FList.Add(Result);

  if NeedActive then FDataSet.Open;
end;

procedure TsdFieldList.Clear;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TsdField(Fields[I]).Free;
  FList.Clear;
end;

procedure TsdFieldList.ClearLookup;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Fields[I].ClearLookupDataSet;
end;

constructor TsdFieldList.Create(AOwner: TsdDataSet);
begin
  FDataSet := AOwner;
  FList := TList.Create;
end;

function TsdFieldList.Delete(Index: Integer): Boolean;
var
  Field: TsdField;
  NeedActive: Boolean;
begin
  Result := False;
  NeedActive := False;
  if FDataSet.IsDesigning and FDataSet.Active then
  begin
    FDataSet.Close;
    NeedActive := True;
  end
  else if FDataSet.Active then
    raise EsdDataSet.Create('Can not delete a field on a active dataset');


  if (Index >= 0) and (Index <= FList.Count - 1) then
  begin
    Field := Fields[Index];
    if Field = nil then
      raise EsdDataSet.Create(Format('Can not find field No.%d', [Index]));
    FList.Remove(Field);
    FreeAndNil(Field);
    Result := True;
  end;
  if NeedActive then
  begin
    FDataSet.FLoadDefaultFields := False;
    try
      FDataSet.Open;
    finally
      FDataSet.FLoadDefaultFields := True;
    end;
  end;
end;
// debug
(*var
  Field: TsdField;
  n: string;
  debugstrs: TStringList;
  debugFile: string;
begin
  Result := False;
  if FDataSet.IsDesigning then
    FDataSet.Close
  else if FDataSet.Active then
    raise EsdDataSet.Create('Can not delete a field on a active dataset');

  debugFile := 'E:\SmartCost\Components\SmartDataSet\Sample\deletedebug.log';
  debugstrs := TStringList.Create;
  if FileExists(debugFile) then
    debugstrs.LoadFromFile(debugFile);
  if (Index >= 0) and (Index <= FList.Count - 1) then
  begin
    Field := Fields[Index];
    if Field = nil then
      raise EsdDataSet.Create(Format('Can not find field No.%d', [Index]));
    n := Field.FieldName;
    debugstrs.Add(Format('1: Count(%d) - Index(%d) - %s', [FieldCount, Index, n]));
    debugstrs.SaveToFile(debugFile);
    FList.Remove(Field);
    debugstrs.Add(Format('2: Count(%d) - Index(%d) - %s', [FieldCount, Index, n]));
    debugstrs.SaveToFile(debugFile);
    FreeAndNil(Field);
    debugstrs.Add(Format('3: Count(%d) - Index(%d) - %s', [FieldCount, Index, n]));
    debugstrs.SaveToFile(debugFile);
    debugstrs.Free;
    Result := True;
  end;
end; *)

destructor TsdFieldList.Destroy;
begin
  ClearLookup;
  Clear;
  FList.Free;
  inherited;
end;

procedure TsdFieldList.Exchange(Field1, Field2: TsdField);
var
  idx1, idx2: Integer;
  NeedActive: Boolean;
begin
  NeedActive := False;
  if FDataSet.IsDesigning and FDataSet.Active then
  begin
    FDataSet.Close;
    NeedActive := True;
  end
  else if FDataSet.Active then
    raise EsdDataSet.Create('Can not exchange fields on a active dataset');

  idx1 := FList.IndexOf(Field1);
  idx2 := FList.IndexOf(Field2);
  if idx1 < 0 then
    raise EsdDataSet.Create(Format('DataSet do not own field "%s"', [Field1.FieldName]));
  if idx2 < 0 then
    raise EsdDataSet.Create(Format('DataSet do not own field "%s"', [Field2.FieldName]));

  FList.Exchange(idx1, idx2);
  if NeedActive then FDataSet.Open;
end;

function TsdFieldList.FieldByName(FieldName: string): TsdField;
var
  I: Integer;
  Field: TsdField;
begin
  Result := nil;
  if FieldName = '' then Exit;
  for I := 0 to Count - 1 do
  begin
    Field := TsdField(Fields[I]);
    if SameText(Field.FieldName, FieldName) then
    begin
      Result := Field;
      Break;
    end;
  end;
end;

function TsdFieldList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TsdFieldList.GetFields(Index: Integer): TsdField;
begin
  Result := nil;
  if (Index >= 0) and (Index <= FList.Count - 1) then
    Result := TsdField(FList[Index]);
end;

{ TsdDataSet }

function TsdDataSet.Add(NeedBeginUpdate: Boolean): TsdDataRecord;
begin
  CheckActive;
  Result := CreateRecord;
  Result.SetInserting(True, NeedBeginUpdate);
  try
    InitRecord(Result);
    AddRecord(Result, NeedBeginUpdate);
  finally
    if not NeedBeginUpdate then
      Result.SetInserting(False, NeedBeginUpdate);
  end;
end;

procedure TsdDataSet.InitRecord(ARecord: TsdDataRecord);
begin
  ARecord.FRecNo := -1;
  ARecord.FNew := True and (not FIsLoading);
  ARecord.FNeedNotifyIndex := True and (not FIsLoading);
  ARecord.FModified := False;
  ARecord.FIndex := -1;
  ARecord.AddFields;
end;

function TsdDataSet.AddRecord(ARecord: TsdDataRecord; NeedBeginUpdate: Boolean): Integer;
var
  Allow: Boolean;
begin
  Result := -1;
  if NeedBeginUpdate then
    ARecord.BeginUpdate;
  if not FIsLoading then
  begin
    FHistory.BeginAdd;
    ARecord.BeginUpdate;
    try
      Allow := True;
      DoBeforeAddRecord(ARecord, Allow);
      if (not Allow) or ARecord.Canceled then
      begin
        ARecord.Free;
        ARecord := nil;
        Exit;
      end;
      ARecord.FIndex := FDataList.Add(ARecord);
      DoAfterAddRecord(ARecord);
      if ARecord.Canceled then
      begin
        FDataList.Remove(ARecord);
        ARecord.Free;
        ARecord := nil;
        Exit;
      end;
    finally
      if Assigned(ARecord) then
        ARecord.EndUpdate;
      FHistory.EndAdd;
    end;
    if not ARecord.IsUpdating then
    begin
      CheckIndex(ARecord);
      Changed(ARecord, sroAdd);
    end;
  end
  // 从数据库加载数据时不排序，全部加载完在外部排序索引
  else
  begin
    ARecord.FIndex := FDataList.Add(ARecord);
    //if not ARecord.IsUpdating then
    //  CheckIndex(ARecord, nil);
  end;
  Result := ARecord.FIndex;
  // 缓存历史
  if FUseSavePoint and (not FIsLoading) and (not FHistory.Stopping) then
    FHistory.Add(ARecord);
end;

procedure TsdDataSet.ClearRecords(AClearAutoFields: Boolean);
var
  I: Integer;
  sdRec: TsdDataRecord;
begin
  for I := 0 to FDataList.Count - 1 do
  begin
    sdRec := TsdDataRecord(FDataList[I]);
    sdRec.Free;
  end;
  FDataList.Clear;
  for I := 0 to FDeletedList.Count - 1 do
  begin
    sdRec := TsdDataRecord(FDeletedList[I]);
    sdRec.Free;
  end;
  FDeletedList.Clear;
  FChangedList.Clear;
  ClearIndexData;
  if AClearAutoFields and FAutoGetFields then
    FFieldList.Clear;
end;

procedure TsdDataSet.Close;
begin
  Active := False;
end;

constructor TsdDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFieldList := TsdFieldList.Create(Self);
  FDataList := TList.Create;
  FDeletedList := TList.Create;
  FChangedList := TList.Create;
  FChangedLookupFields := TList.Create;
  FIndexList := TsdIndexList.Create(Self);
  FHistory := TsdHistoryList.Create(Self);
  FAutoGetFields := False;
  FRecordClass := TsdDataRecord;
  FHasKey := False;
  FIsLoading := False;
  FUpdateLock := 0;
  FViewList := TList.Create;
  FLoadDefaultFields := True;
  FKeepPosition := False;
  FCurrentView := nil;
  FEventRec := nil;
  FFiltered := False;
  Filter := '';
  FUseSavePoint := False;
  FTableName := '';
  FOperationManager := nil;
  FEnableValueEvents := True;
  FSavedPoint := 0;
end;

function TsdDataSet.CreateRecord: TsdDataRecord;
begin
  if Assigned(FOnGetRecordClass) then
    FOnGetRecordClass(FRecordClass);
  Result := FRecordClass.Create(Self);
end;

function TsdDataSet.Delete(AIndex: Integer): Boolean;
var
  sdRec: TsdDataRecord;
begin
  CheckActive;
  sdRec := GetRecords(AIndex);
  Result := RemoveRecord(sdRec);
end;

destructor TsdDataSet.Destroy;
begin
  if Assigned(FDesigner) then
    FreeAndNil(FDesigner);
  if Assigned(FIndexDesigner) then
    FreeAndNil(FIndexDesigner);
  if Assigned(FProvider) then
    FProvider.FreeNotify;
  Close;
  ClearViews;
  FreeAndNil(FViewList);
  FFieldList.Free;
  FDataList.Free;
  FDeletedList.Free;
  FChangedList.Free;
  FChangedLookupFields.Free;
  FIndexList.Free;
  FHistory.Free;
  inherited;
end;

function TsdDataSet.GetRecordCount: Integer;
begin
  Result := FDataList.Count;
end;

function TsdDataSet.GetRecords(Index: Integer): TsdDataRecord;
begin
  Result := nil;
  if (Index >= 0) and (Index <= FDataList.Count - 1) then
    Result := TsdDataRecord(FDataList[Index]);
end;

function TsdDataSet.IndexOf(ARecord: TsdDataRecord): Integer;
begin
  Result := FDataList.IndexOf(ARecord);
end;

procedure TsdDataSet.LoadRecords;
begin
  FAutoGetFields := FieldCount = 0;
  BeginLoad;
  try
    try
      if Filtered and (Filter <> '') then
        FProvider.SetFilter(Filter)
      else
        FProvider.SetFilter('');
      if not FProvider.LoadRecords then
        raise EsdDataSet.Create('Can not load data');
    except
      ClearRecords(True);
      raise;
    end;
  finally
    EndLoad;
  end;
  SortIndex;
end;

procedure TsdDataSet.Open;
begin
  Active := True;
end;

function TsdDataSet.Remove(ARec: TsdDataRecord): Boolean;
begin
  Result := RemoveRecord(ARec);
end;

function TsdDataSet.RemoveRecord(ARec: TsdDataRecord; FreeRecord: Boolean): Boolean;
var
  iIndex: Integer;
  Allow: Boolean;
begin
  Result := False;
  CheckActive;
  if ARec = nil then Exit;
  Allow := True;
  DoBeforeDeleteRecord(ARec, Allow);
  if not Allow then Exit;
  iIndex := FDataList.IndexOf(ARec);
  if iIndex < 0 then
    raise EsdDataSet.Create(Format('Delete record error: Error index is %d', [ARec.FIndex]));

  Result := FDataList.Remove(ARec) >= 0;
  // 删除记录相关的索引信息
  DeleteRecordIndex(ARec);
  if not IsUpdating then
    RenumberIndex(iIndex);
  Changed(ARec, sroDelete);
  DoAfterDeleteRecord(ARec);
  // 是新记录，直接删除
  // 是从数据库中来的记录，需要缓存起来，保存时再与数据库记录同步删除
  if not ARec.New then
    AddToDeletedList(ARec)
  else if (FreeRecord and (not FUseSavePoint)) then
    FreeAndNil(ARec);
  if FUseSavePoint and (not FIsLoading) and (not FHistory.Stopping) then
    FHistory.Delete(ARec);
end;

procedure TsdDataSet.RenumberIndex(AFromIndex: Integer);
var
  I: Integer;
  sdRec: TsdDataRecord;
begin
  for I := AFromIndex to FDataList.Count - 1 do
  begin
    sdRec := TsdDataRecord(FDataList[I]);
    sdRec.FIndex := I;
  end;
end;

procedure TsdDataSet.DeleteRecNo(ARecNo: Integer);
var
  I: Integer;
  sdRec: TsdDataRecord;
begin
  for I := 0 to FDataList.Count - 1 do
  begin
    sdRec := TsdDataRecord(FDataList[I]);
    if sdRec.FRecNo > ARecNo then
      Dec(sdRec.FRecNo);
  end;
end;

procedure TsdDataSet.InsertRecNo(ARecNo: Integer);
var
  I, iRecNo: Integer;
  sdRec: TsdDataRecord;
begin
  for I := 0 to FDataList.Count - 1 do
  begin
    sdRec := TsdDataRecord(FDataList[I]);
    if sdRec.FRecNo >= ARecNo then
      Inc(sdRec.FRecNo);
  end;
  for I := 0 to FDeletedList.Count - 1 do
  begin
    iRecNo := Integer(FDataList[I]);
    if iRecNo >= ARecNo then
    begin
      Inc(iRecNo);
      FDataList[I] := Pointer(iRecNo);
    end;
  end;
end;

procedure TsdDataSet.Save;
begin
  SaveRecords;
end;

procedure TsdDataSet.SaveRecords;
var
  strLogFile: string;
begin
  if not Modified then Exit;
  CheckActive;
  CheckForSave;
  //SortDeletedRecords;
  try
    FProvider.ApplyUpdates;
    FSavedPoint := SavePoint;
  except
    strLogFile := ExtractFilePath(Application.ExeName) + 'Log';
    if not DirectoryExists(strLogFile) then
      CreateDir(strLogFile);
    strLogFile := strLogFile + '\sdLog[' + Name + '](' + FormatDateTime('yyyy-mm-dd hh.nn.ss.zzz', Now) + ').log';
    SaveToXML(strLogFile);
    raise;
  end;
end;

procedure TsdDataSet.SetActive(const Value: Boolean);
begin
  if (csReading in ComponentState) then
  begin
    FStreamedActive := Value;
    Exit;
  end;
  if Value = FActive then
    Exit;
  if Value then
  begin
    if FProvider = nil then
      if not IsDesigning then
        raise EsdDataSet.Create('No provider')
      else
        Exit;
    ProcessFieldNames;
    LoadRecords;
    FSavedPoint := 0;
    FActive := Value;
    if Assigned(FAfterOpen) then
      FAfterOpen(Self);
  end
  else
  begin
    FActive := Value;
    FHistory.Clear;
    ClearRecords(True);
    if Assigned(FAfterClose) then
      FAfterClose(Self);
  end;
  NotifyChanged(nil, sdoActive);
end;

procedure TsdDataSet.SetOnProgress(const Value: TsdOnProgressEvent);
begin
  FOnProgress := Value;
end;

procedure TsdDataSet.SetRecordClass(const Value: TsdRecordClass);
begin
  if Active then
    raise EsdDataSet.Create('Can not set RecordClass while dataset is opened');
  FRecordClass := Value;
end;

procedure TsdDataSet.SortDeletedRecords;

  procedure QuickSort(iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    iMid: Integer;
  begin
    Lo := iLo;
    Hi := iHi;
    iMid := Integer(TsdDataRecord(FDeletedList[(iLo + iHi) div 2]).FRecNo);
    repeat
      while Integer(TsdDataRecord(FDeletedList[Lo]).FRecNo) < iMid do
        Inc(Lo);
      while Integer(TsdDataRecord(FDeletedList[Hi]).FRecNo) > iMid do
        Dec(Hi);
      if Lo <= Hi then
      begin
        if Lo < Hi then
        begin
          FDeletedList.Exchange(Lo, Hi);
        end;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(iLo, Hi);
    if Lo < iHi then QuickSort(Lo, iHi);
  end;

begin
  if FDeletedList.Count > 0 then
    QuickSort(0, FDeletedList.Count - 1);
end;

function TsdDataSet.AddIndex(const Name, Fields: string): TsdIndex;
begin
  // 检查索引是否存在
  Result := nil;
  if FIndexList.FindByName(Name) <> nil then
    raise EsdIndex.Create(Format('Index ''%s'' exists', [Name]));
  Result := FIndexList.Add;
  Result.Name := Name;
  Result.FieldNames := Fields;
end;

procedure TsdDataSet.SortIndex;
begin
  FIndexList.Sort;
end;

procedure TsdDataSet.CheckIndex(ARec: TsdDataRecord);
begin
  if not IsUpdating then
    FIndexList.Check(ARec);
end;

procedure TsdDataSet.DeleteRecordIndex(ARec: TsdDataRecord);
begin
  if not IsUpdating then
    FIndexList.DeleteRecord(ARec);
end;

procedure TsdDataSet.ClearIndexData;
begin
  FIndexList.ClearData;
end;

function TsdDataSet.FindKey(AIndexName: string;
  KeyValues: Variant): TsdDataRecord;
var
  Index: TsdIndex;
begin
  CheckActive;
  Result := nil;
  Index := FIndexList.FindByName(AIndexName);
  if Index = nil then
    raise EsdDataSet.Create(Format('Can not find index ''%s''', [AIndexName]));
  Result := Index.FindKey(KeyValues);
end;

function TsdDataSet.Locate(const KeyFields: string;
  const KeyValues: Variant): TsdDataRecord;
var
  Index: TsdIndex;
begin
  CheckActive;
  Index := FIndexList.FindByKeyFields(KeyFields, True);
  if Index <> nil then
    Result := Index.FindKey(KeyValues)
  else
    Result := InnerLocate(KeyFields, KeyValues);
end;

function TsdDataSet.InnerLocate(const KeyFields: string;
  const KeyValues: Variant): TsdDataRecord;
var
  KeyCount, I, J: Integer;
  V: Variant;
  bFound: Boolean;
  NameList: TStringList;
  FieldNoList: TList;
  Field: TsdField;
  Rec: TsdDataRecord;
  Value: TsdValue;
begin
  Result := nil;
  if VarIsArray(KeyValues) then
    KeyCount := VarArrayHighBound(KeyValues, 1) - VarArrayLowBound(KeyValues, 1) + 1
  else
    KeyCount := 1;
  FieldNoList := TList.Create;
  try
    NameList := TStringList.Create;
    try
      NameList.Delimiter := ';';
      NameList.DelimitedText := KeyFields;
      if NameList.Count <> KeyCount then
        raise EsdDataSet.Create('Fields do not match values');
      for I := 0 to NameList.Count - 1 do
      begin
        Field := FFieldList.FieldByName(NameList[I]);
        if Field = nil then
          raise EsdDataSet.Create(Format('Can not find field ''%s''', [NameList[I]]));
        FieldNoList.Add(Pointer(Field.FieldNo));
      end;
    finally
      NameList.Free;
    end;
    for I := 0 to FDataList.Count - 1 do
    begin
      bFound := True;
      Rec := Records[I];
      for J := 0 to KeyCount - 1 do
      begin
        if VarIsArray(KeyValues) then
          V := KeyValues[J]
        else
          V := KeyValues;
        Value := Rec.Values[Integer(FieldNoList[J])];
        // 字符串类型有''和Null的区别
        if Value.Field.IsVarField then
        begin
          if VarToStr(V) <> Value.AsString then
          begin
            bFound := False;
            Break;
          end;
        end
        else if V <> Value.Value then
        begin
          bFound := False;
          Break;
        end;
      end;
      if bFound then
      begin
        Result := Rec;
        Break;
      end;
    end;
  finally
    FieldNoList.Free;
  end;
end;

function TsdDataSet.IsDesigning: Boolean;
begin
  Result := csDesigning in ComponentState;
end;

function TsdDataSet.GetProvider: IsdProvider;
begin
  Result := FProvider;
end;

procedure TsdDataSet.SetProvider(const Value: IsdProvider);
begin
  if FProvider <> Value then
  begin
    FProvider := Value;
    if FProvider <> nil then
      FProvider.SetDataSet(Self);
  end;
end;

procedure TsdDataSet.Changed(const Sender: TObject; AOperation: TsdOperation);
var
  V: TsdValue;
  Rec: TsdDataRecord;
  Obj: TObject;
begin
  V := nil;
  Rec := nil;
  if Sender is TsdValue then
  begin
    V := TsdValue(Sender);
    Rec := V.FOwner;
  end
  else if Sender is TsdDataRecord then
    Rec := TsdDataRecord(Sender);

  if Sender <> nil then
  begin
    Obj := Sender;

    if (AOperation <> sroDelete) and (not FIsLoading) and (FChangedList.IndexOf(Rec) < 0) then
      FChangedList.Add(Rec)
    else if AOperation = sroDelete then
      FChangedList.Remove(Rec);
  end
  else
    Obj := Self;

  if not IsUpdating then
    NotifyChanged(Sender, AOperation);
end;

procedure TsdDataSet.ClearChangedList;
begin
  FChangedList.Clear;
end;

procedure TsdDataSet.ClearDeletedList;
var
  I: Integer;
  Rec: TsdDataRecord;
begin
  for I := 0 to FDeletedList.Count - 1 do
  begin
    Rec := TsdDataRecord(FDeletedList[I]);
    // 如果UseSavePoint，则要检查FHistory中没有记录该Rec才能Free
    if (not UseSavePoint) or (FHistory.FindByRecord(Rec) = nil) then
      Rec.Free;
  end;
  FDeletedList.Clear;
end;

function TsdDataSet.GetHasKey: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to FieldCount - 1 do
    if FFieldList.Fields[I].IsKey then
    begin
      Result := True;
      Break;
    end;
end;

procedure TsdDataSet.BeginLoad;
begin
  FIsLoading := True;
end;

procedure TsdDataSet.EndLoad;
begin
  FIsLoading := False;
end;

procedure TsdDataSet.SetAfterAddRecord(const Value: TsdRecordEvent);
begin
  FAfterAddRecord := Value;
end;

procedure TsdDataSet.SetAfterDeleteRecord(const Value: TsdRecordEvent);
begin
  FAfterDeleteRecord := Value;
end;

procedure TsdDataSet.SetAfterRecordChange(const Value: TsdRecordEvent);
begin
  FAfterRecordChanged := Value;
end;

procedure TsdDataSet.SetBeforeAddRecord(const Value: TsdAllowRecordEvent);
begin
  FBeforeAddRecord := Value;
end;

procedure TsdDataSet.SetBeforeDeleteRecord(
  const Value: TsdAllowRecordEvent);
begin
  FBeforeDeleteRecord := Value;
end;

procedure TsdDataSet.DoAfterRecordChanged(ARecord: TsdDataRecord);
var
  I: Integer;
begin
  if (not FIsLoading) and (not ARecord.IsInEvent) then
  begin
    ARecord.EnterEvent;
    try
      if (FCurrentView <> nil) and (FEventRec = ARecord) then
        FCurrentView.DoAfterRecordChanged(ARecord);
      if Assigned(FAfterRecordChanged) then
        FAfterRecordChanged(ARecord);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

procedure TsdDataSet.ClearViews;
var
  I: Integer;
  lstTemp: TList;
begin
  lstTemp := TList.Create;
  try
    lstTemp.Assign(FViewList);
    for I := 0 to lstTemp.Count - 1 do
      TsdDataView(lstTemp[I]).FreeNotify;
    FViewList.Clear;
  finally
    lstTemp.Free;
  end;
end;

procedure TsdDataSet.RegisterView(AView: TObject);
begin
  if not (AView is TsdDataView) then
    raise EsdDataSet.Create('The parameter is not a DataView');
  if FViewList.IndexOf(AView) < 0 then
    FViewList.Add(AView);
end;

procedure TsdDataSet.UnregisterView(AView: TObject);
begin
  if FViewList.IndexOf(AView) >= 0 then
    FViewList.Remove(AView);
end;

procedure TsdDataSet.NotifyChanged(const Sender: TObject;
  AOperation: TsdOperation);
var
  I: Integer;
begin
  for I := 0 to FViewList.Count - 1 do
    TsdDataView(FViewList[I]).Changed(Sender, AOperation);
end;

function TsdDataSet.FindIndex(AIndexName: string): TsdIndex;
begin
  Result := FIndexList.FindByName(AIndexName);
end;

procedure TsdDataSet.AssignRecords(AList: TList);
begin
  AList.Assign(FDataList);
end;

procedure TsdDataSet.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('FieldListData', ReadFields, WriteFields, FieldCount > 0);
  Filer.DefineBinaryProperty('IndexListData', ReadIndexes, WriteIndexes, FIndexList.Count > 0);
end;

procedure TsdDataSet.ReadFields(Stream: TStream);
var
  Field: TsdField;
  Reader: TReader;
begin
  Reader := TReader.Create(Stream, 1024);
  try
    Reader.ReadListBegin;
    while not Reader.EndOfList do
    begin
      Field := FFieldList.Add;
      Field.LoadProperty(Reader);
    end;
    Reader.ReadListEnd;
  finally
    Reader.Free;
  end;
end;

procedure TsdDataSet.ReadIndexes(Stream: TStream);
var
  Index: TsdIndex;
  Reader: TReader;
begin
  Reader := TReader.Create(Stream, 1024);
  try
    while not Reader.EndOfList do
    begin
      Index := FIndexList.Add;
      Index.LoadProperty(Reader);
    end;
    Reader.ReadListEnd;
  finally
    Reader.Free;
  end;
end;

procedure TsdDataSet.WriteFields(Stream: TStream);
var
  I: Integer;
  Field: TsdField;
  Writer: TWriter;
begin
  Writer := TWriter.Create(Stream, 1024);
  try
    Writer.WriteListBegin;
    for I := 0 to FieldCount - 1 do
    begin
      Field := FFieldList[I];
      Field.SaveProperty(Writer);
    end;
    Writer.WriteListEnd;
  finally
    Writer.Free;
  end;
end;

procedure TsdDataSet.WriteIndexes(Stream: TStream);
var
  I: Integer;
  Index: TsdIndex;
  Writer: TWriter;
begin
  Writer := TWriter.Create(Stream, 1024);
  try
    for I := 0 to FIndexList.Count - 1 do
    begin
      Index := FIndexList[I];
      Index.SaveProperty(Writer);
    end;
    Writer.WriteListEnd;
  finally
    Writer.Free;
  end;
end;

function TsdDataSet.AddField(const FieldName: string): TsdField;
var
  Field: TField;
begin
  Result := nil;
  if FProvider = nil then Exit;
  Result := FFieldList.FieldByName(FieldName);
  if Result <> nil then Exit;
  Result := FFieldList.Add;
  Result.FieldName := FieldName;
  FProvider.AssignField(FieldName);
end;

function TsdDataSet.GetFieldCount: Integer;
begin
  Result := FFieldList.Count;
end;

procedure TsdDataSet.Loaded;
begin
  inherited Loaded;
  try
    if FStreamedActive then
      Active := True;
  except
    if csDesigning in ComponentState then
      raise;
  end;
end;

procedure TsdDataSet.GetFieldNames(AFieldNames: TStringList);
var
  I: Integer;
begin
  AFieldNames.Clear;
  for I := 0 to FieldCount - 1 do
    AFieldNames.Add(FFieldList[I].FieldName);
end;

procedure TsdDataSet.ProcessFieldNames;
var
  I: Integer;
begin
  for I := 0 to FieldCount - 1 do
    Fields[I].ProcessFieldName(Fields[I].FieldName);
end;

procedure TsdDataSet.SetOnGetRecordClass(const Value: TsdGetRecordClass);
begin
  FOnGetRecordClass := Value;
end;

function TsdDataSet.ControlsDisabled: Boolean;
begin
  Result := FDisableCount <> 0;
end;

procedure TsdDataSet.DisableControls;
begin
  Inc(FDisableCount);
end;

procedure TsdDataSet.EnableControls;
var
  I: Integer;
begin
  if FDisableCount <> 0 then
  begin
    Dec(FDisableCount);
    if FDisableCount = 0 then
      for I := 0 to FViewList.Count - 1 do
        TsdDataView(FViewList[I]).NotifyDataChanged;
  end;
end;

procedure TsdDataSet.SetAfterClose(const Value: TNotifyEvent);
begin
  FAfterClose := Value;
end;

procedure TsdDataSet.SetAfterOpen(const Value: TNotifyEvent);
begin
  FAfterOpen := Value;
end;

procedure TsdDataSet.BeginUpdate;
begin
  Inc(FUpdateLock);
end;

procedure TsdDataSet.EndUpdate;
begin
  if FUpdateLock > 0 then
    Dec(FUpdateLock);
  if not IsUpdating then
  begin
    RenumberIndex;
    FIndexList.Sort;
    try
      FKeepPosition := True;
      NotifyChanged(nil, sdoRefresh);
    finally
      FKeepPosition := False;
    end;
    CheckChangedLookupFields(nil);
  end;
end;

function TsdDataSet.IsUpdating: Boolean;
begin
  Result := FUpdateLock > 0;
end;

procedure TsdDataSet.DoAfterValueChanged(AValue: TsdValue);
begin
  if (not FIsLoading) and (not AValue.Owner.IsInEvent) then
  begin
    AValue.Owner.EnterEvent;
    try
      if (FCurrentView <> nil) and (FEventRec = AValue.Owner) then
        FCurrentView.DoAfterValueChanged(AValue);
      if Assigned(FAfterValueChanged) then
        FAfterValueChanged(AValue);
    finally
      AValue.Owner.ExitEvent;
    end;
  end;
end;

procedure TsdDataSet.DoBeforeValueChange(AValue: TsdValue; const NewValue: Variant;
  var Allow: Boolean);
begin
  if (not FIsLoading) and (not AValue.Owner.IsInEvent) then
  begin
    AValue.Owner.EnterEvent;
    try
      if (FCurrentView <> nil) and (FEventRec = AValue.Owner) then
        FCurrentView.DoBeforeValueChange(AValue, NewValue, Allow);
      if Allow and Assigned(FBeforeValueChange) then
        FBeforeValueChange(AValue, NewValue, Allow);
    finally
      AValue.Owner.ExitEvent;
    end;
  end;
end;

procedure TsdDataSet.SetAfterRecordChanged(const Value: TsdRecordEvent);
begin
  FAfterRecordChanged := Value;
end;

procedure TsdDataSet.SetAfterValueChanged(const Value: TsdValueEvent);
begin
  FAfterValueChanged := Value;
end;

procedure TsdDataSet.SetBeforeValueChange(const Value: TsdAllowValueEvent);
begin
  FBeforeValueChange := Value;
end;

procedure TsdDataSet.SetAfterRecordUpdated(const Value: TsdRecordEvent);
begin
  FAfterRecordUpdated := Value;
end;

procedure TsdDataSet.SetBeforeRecordUpdate(const Value: TsdRecordEvent);
begin
  FBeforeRecordUpdate := Value;
end;

procedure TsdDataSet.DoAfterRecordUpdated(ARecord: TsdDataRecord);
begin
  if (not FIsLoading) and (not ARecord.IsUpdating) and Assigned(FAfterRecordUpdated) then
    FAfterRecordUpdated(ARecord);
end;

procedure TsdDataSet.DoBeforeRecordUpdate(ARecord: TsdDataRecord);
begin
  if (not FIsLoading) and (not ARecord.IsUpdating) and Assigned(FBeforeRecordUpdate) then
    FBeforeRecordUpdate(ARecord);
end;

function TsdDataSet.CurrentView: TsdDataView;
begin
  Result := FCurrentView;
end;

function TsdDataSet.GetModified: Boolean;
begin
  Result := (FChangedList.Count > 0) or (FDeletedList.Count > 0);
end;

procedure TsdDataSet.CheckChangedLookupFields(AField: TsdField;
  ARecord: TsdDataRecord);
var
  I: Integer;
begin
  if (AField <> nil) and (FChangedLookupFields.IndexOf(AField) < 0) then
    FChangedLookupFields.Add(AField);
  if ((ARecord <> nil) and (not IsUpdating) and (not ARecord.IsUpdating)) or
     ((ARecord = nil) and (not IsUpdating)) then
  begin
    for I := 0 to FChangedLookupFields.Count - 1 do
      TsdField(FChangedLookupFields[I]).RefreshLookup;
    FChangedLookupFields.Clear;
  end;
end;

// 注意，此方法不触发事件
procedure TsdDataSet.DeleteAll;
var
  I: Integer;
  Rec: TsdDataRecord;
begin
  ClearIndexData;
  for I := 0 to FDataList.Count - 1 do
  begin
    Rec := TsdDataRecord(FDataList[I]);
    if not Rec.New then
      AddToDeletedList(Rec)
    else
      FreeAndNil(Rec);
  end;
  ClearChangedList;
  FDataList.Clear;
  NotifyChanged(nil, sdoRefresh);
end;

procedure TsdDataSet.AddToDeletedList(ARecord: TsdDataRecord);
begin
  if FDeletedList.IndexOf(ARecord) < 0 then
    FDeletedList.Add(ARecord);
end;

function TsdDataSet.FieldByName(AFieldName: string): TsdField;
begin
  Result := FFieldList.FieldByName(AFieldName);
end;

function TsdDataSet.Lookup(const KeyFields: string;
  const KeyValues: Variant; const ResultFields: string): Variant;
var
  Rec: TsdDataRecord;
begin
  CheckActive;
  Result := Null;
  Rec := Locate(KeyFields, KeyValues);
  if Rec <> nil then
    Result := Rec.FieldValues[ResultFields];
end;

procedure TsdDataSet.IndexDeleted(AIndexName: string);
var
  I: Integer;
begin
  if FViewList = nil then Exit;
  for I := 0 to FViewList.Count - 1 do
    if SameText(TsdDataView(FViewList[I]).IndexName, AIndexName) then
      TsdDataView(FViewList[I]).IndexName := '';
end;

procedure TsdDataSet.CheckActive;
begin
  if not (Active or FIsLoading) then
    raise EsdDataSet.Create('Cannot perform this operation on a closed dataset');
end;

procedure TsdDataSet.LoadFromXML(AFileName: string);
var
  xmlDoc: IXMLDocument;
  vRoot, vFieldDef, vRecord, vField: IXMLNode;
  I, J: Integer;
  Rec: TsdDataRecord;
begin
  ClearRecords(True);
  ClearIndex;
  Close;
  FAutoGetFields := True;
  xmlDoc := TXMLDocument.Create(nil) as IXMLDocument;
  try
    xmlDoc.Active := True;
    xmlDoc.Encoding := 'gb2312';
    xmlDoc.Options := xmlDoc.Options + [doAttrNull, doNodeAutoIndent];
    xmlDoc.LoadFromFile(AFileName);
    // 根据FieldDef新增字段
    vFieldDef := xmlDoc.ChildNodes.FindNode('FieldDef');
    if vFieldDef <> nil then
    begin
      // to do
    end;
    vRoot := xmlDoc.ChildNodes.FindNode('SmartDataSet_data_list');
    if vRoot.ChildNodes.Count = 0 then Exit;
    // 没有FieldDef则全部按字符串新增字段
    if vFieldDef = nil then
    begin
      vRecord := vRoot.ChildNodes[0];
      for I := 0 to vRecord.AttributeNodes.Count - 1 do
      begin
        vField := vRecord.AttributeNodes.Nodes[I];
        FFieldList.Add(vField.NodeName, ftWideString, 255);
      end;
    end;
    Open;
    FAutoGetFields := True;
    BeginLoad;
    try
      // 添加数据
      for I := 0 to vRoot.ChildNodes.Count - 1 do
      begin
        vRecord := vRoot.ChildNodes[I];
        Rec := Add;
        for J := 0 to vRecord.AttributeNodes.Count - 1 do
        begin
          vField := vRecord.AttributeNodes.Nodes[J];
          Rec.AddValue(vField.NodeName, vField.Text);
        end;
      end;
    finally
      EndLoad;
    end;
  finally
    xmlDoc := nil;
  end;
end;

procedure TsdDataSet.SaveToXML(AFileName: string);
var
  xmlDoc: IXMLDocument;
  vRoot, vItem: IXMLNode;
  I, J: Integer;
  Rec: TsdDataRecord;
begin
  xmlDoc := TXMLDocument.Create(nil) as IXMLDocument;
  try
    xmlDoc.Active := True;
    xmlDoc.Encoding := 'gb2312';
    xmlDoc.Options := xmlDoc.Options + [doAttrNull, doNodeAutoIndent];
    vRoot := xmlDoc.AddChild('SmartDataSet_data_list');
    vRoot.Attributes['DataSet'] := Name;
    for I := 0 to RecordCount - 1 do
    begin
      Rec := Records[I];
      vItem := vRoot.AddChild('Record');
      for J := 0 to FieldCount - 1 do
        vItem.Attributes[FFieldList[J].FieldName] := Rec.Values[J].Value;
    end;
    xmlDoc.SaveToFile(AFileName);
  finally
    xmlDoc := nil;
  end;
end;

procedure TsdDataSet.DoBeforeAddRecord(ARecord: TsdDataRecord;
  var Allow: Boolean);
begin
  if (not FIsLoading) and (not ARecord.IsInEvent) then
  begin
    ARecord.EnterEvent;
    try
      if (FCurrentView <> nil) and (FEventRec = ARecord) then
        FCurrentView.DoBeforeAddRecord(ARecord, Allow);
      if Allow and Assigned(FBeforeAddRecord) then
        FBeforeAddRecord(ARecord, Allow);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

procedure TsdDataSet.DoAfterAddRecord(ARecord: TsdDataRecord);
begin
  if (not FIsLoading) and (not ARecord.IsInEvent) then
  begin
    ARecord.EnterEvent;
    try
      if (FCurrentView <> nil) and (FEventRec = ARecord) then
        FCurrentView.DoAfterAddRecord(ARecord);
      if Assigned(FAfterAddRecord) then
        FAfterAddRecord(ARecord);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

procedure TsdDataSet.CheckForSave;
var
  I: Integer;
  Rec: TsdDataRecord;
begin
  for I := 0 to RecordCount - 1 do
  begin
    Rec := Records[I];
    // 如果有意外没有EndUpdate的记录，则在这里统一EndUpdate;
    if Rec.IsUpdating then
    begin
      if Rec.FUpdateLock > 1 then
        Rec.FUpdateLock := 1;
      Rec.EndUpdate;
    end;
  end;
end;

procedure TsdDataSet.FreeProviderNotify;
begin
  Close;
  FProvider := nil;
end;

function TsdDataSet.RecordsByKey(const AIndexName: string;
  const KeyValues: Variant; List: TList): Integer;
var
  Idx: TsdIndex;
begin
  CheckActive;
  Idx := FindIndex(AIndexName);
  if Idx = nil then
    raise EsdDataSet.Create(Format('Can not find index "%s"', [AIndexName]));
  Result := Idx.RecordsByKey(KeyValues, List);
end;

procedure TsdDataSet.DoAfterDeleteRecord(ARecord: TsdDataRecord);
begin
  if (not FIsLoading) and (not ARecord.IsInEvent) then
  begin
    ARecord.EnterEvent;
    try
      if (FCurrentView <> nil) and (FEventRec = ARecord) then
        FCurrentView.DoAfterDeleteRecord(ARecord);
      if Assigned(FAfterDeleteRecord) then
        FAfterDeleteRecord(ARecord);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

procedure TsdDataSet.DoBeforeDeleteRecord(ARecord: TsdDataRecord;
  var Allow: Boolean);
begin
  if (not FIsLoading) and (not ARecord.IsInEvent) then
  begin
    ARecord.EnterEvent;
    try
      if (FCurrentView <> nil) and (FEventRec = ARecord) then
        FCurrentView.DoBeforeDeleteRecord(ARecord, Allow);
      if Allow and Assigned(FBeforeDeleteRecord) then
        FBeforeDeleteRecord(ARecord, Allow);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

procedure TsdDataSet.CancelRecord(ARecord: TsdDataRecord);
var
  iIndex: Integer;
begin
  // 正在插入的记录直接删除
  if ARecord.Inserting then
  begin
    iIndex := FDataList.IndexOf(ARecord);
    if iIndex >= 0 then
    begin
      FDataList.Remove(ARecord);
      // 删除记录相关的索引信息
      DeleteRecordIndex(ARecord);
      RenumberIndex(iIndex);
    end;
    if FCurrentView <> nil then
      FCurrentView.FDataList.Remove(ARecord);
    FreeAndNil(ARecord);
  end
  // 修改中回滚
  else
  begin
    ARecord.Rollback;
    ARecord.FCanceled := False;
  end;
end;

procedure TsdDataSet.Reload;
begin
  if not Active then Exit;
  if FProvider = nil then
    if not IsDesigning then
      raise EsdDataSet.Create('No provider')
    else
      Exit;

  ClearRecords(False);
  LoadRecords;
  NotifyChanged(nil, sdoRefresh);
end;

procedure TsdDataSet.SetFilter(const Value: string);
begin
  FFilter := Value;
end;

procedure TsdDataSet.SetFiltered(const Value: Boolean);
begin
  FFiltered := Value;
  Reload;
end;

procedure TsdDataSet.ClearIndex;
begin
  FIndexList.Clear;
end;

procedure TsdDataSet.SortByFields(const KeyFields: string; AList: TList);
var
  NameList: TStringList;

  function CompareIndex(ARec1, ARec2: TsdDataRecord): Integer;
  begin
    if ARec1.FIndex > ARec2.FIndex then Result := 1
    else if ARec1.FIndex < ARec2.FIndex then Result := -1
    else Result := 0;
  end;

  function CompareValue(AValue1, AValue2: Variant): Integer;
  begin
    // Result: 0:  1 = 2    >0:  1 > 2   <0:  1 < 2
    if AValue1 > AValue2 then
      Result := 1
    else if AValue1 < AValue2 then
      Result := -1
    else
      Result := 0;
  end;

  function CompareData(ARec1, ARec2: TsdDataRecord): Integer;
  var
    V1, V2: Variant;
    iLevel: Integer;
  begin
    iLevel := 0;
    repeat
      V1 := ARec1.ValueByName(NameList[iLevel]).Value;
      V2 := ARec2.ValueByName(NameList[iLevel]).Value;
      Result := CompareValue(V1, V2);
      // 对于不唯一的字段，作为索引的时候，如果因为其它字段被修改引发了排序，相同索引值下的记录可能会混乱
      // 所以要根据一个唯一值再比较一下，这里选用Record.FIndex
      if (Result = 0) and (iLevel = NameList.Count - 1) then
        Result := CompareIndex(ARec1, ARec2);
      Inc(iLevel);
    until (Result <> 0) or (iLevel > NameList.Count - 1);
  end;

  procedure QuickSort(iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    MidRec: TsdDataRecord;
  begin
    Lo := iLo;
    Hi := iHi;
    MidRec := TsdDataRecord(AList[(iLo + iHi) div 2]);
    repeat
      while CompareData(TsdDataRecord(AList[Lo]), MidRec) < 0 do
        Inc(Lo);
      while CompareData(TsdDataRecord(AList[Hi]), MidRec) > 0 do
        Dec(Hi);
      if Lo <= Hi then
      begin
        if Lo < Hi then  begin
          AList.Exchange(Lo, Hi);
        end;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(iLo, Hi);
    if Lo < iHi then QuickSort(Lo, iHi);
  end;

begin
  if (AList = nil) or (RecordCount = 0) then Exit;
  AList.Clear;
  AList.Assign(FDataList);
  NameList := TStringList.Create;
  try
    NameList.Delimiter := ';';
    NameList.DelimitedText := KeyFields;
    QuickSort(0, AList.Count - 1);
  finally
    NameList.Free;
  end;
end;

procedure TsdDataSet.FilterBy(const AFilter: string; AList: TList;
  AKeyFields: string = '');
var
  FilterHelper: TsdLogicalExprs;
  I: Integer;
  Rec: TsdDataRecord;
begin
  AList.Clear;
  FilterHelper := TsdLogicalExprs.Create(Self);
  try
    FilterHelper.ParseExpression(AFilter);
    for I := 0 to GetRecordCount - 1 do
    begin
      Rec := Records[I];
      if FilterHelper.Calc(Rec) then
        AList.Add(Rec);
    end;
  finally
    FilterHelper.Free;
  end;
  if AKeyFields <> '' then
    SortList(AList, AKeyFields);
end;

function TsdDataSet.GetSavePoint: Integer;
begin
  Result := FHistory.SavePoint;
end;

procedure TsdDataSet.SetSavePoint(const Value: Integer);
begin
  if not FUseSavePoint then
    raise EsdDataSet.Create('Can not use SavePoint when UseSavePoint is False');
  if not Active then
    raise EsdDataSet.Create('Can not use SavePoint on a closed dataset');
  FHistory.SavePoint := Value;
end;

procedure TsdDataSet.SetUseSavePoint(const Value: Boolean);
begin
  FUseSavePoint := Value;
  if not FUseSavePoint then
    FHistory.Clear;
end;

function TsdDataSet.CompareRec(ARec1, ARec2: TsdDataRecord;
  AKeyFields: string): Integer;
var
  slstFields: TStringList;
  I: Integer;
  strField: string;
  V1, V2: TsdValue;
begin
  Result := 0;
  slstFields := TStringList.Create;
  try
    slstFields.Delimiter := ';';
    slstFields.DelimitedText := AKeyFields;
    for I := 0 to slstFields.Count - 1 do
    begin
      strField := slstFields[I];
      // 在外部检查字段名是否存在，这里不检查
      V1 := ARec1.ValueByName(strField);
      V2 := ARec2.ValueByName(strField);
      if V1.Value < V2.Value then
      begin
        Result := -1;
        Break;
      end
      else if V1.Value > V2.Value then
      begin
        Result := 1;
        Break;
      end;
    end;
    if Result = 0 then
    begin
      if ARec1.MainIndex < ARec2.MainIndex then
        Result := -1
      else if ARec1.MainIndex > ARec2.MainIndex then
        Result := 1;
    end;
  finally
    slstFields.Free;
  end;
end;

procedure TsdDataSet.SortList(AList: TList; AKeyFields: string);

  procedure QuickSort(iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    MidRec: TsdDataRecord;
  begin
    Lo := iLo;
    Hi := iHi;
    MidRec := TsdDataRecord(AList[(iLo + iHi) div 2]);
    repeat
      while CompareRec(TsdDataRecord(AList[Lo]), MidRec, AKeyFields) < 0 do
        Inc(Lo);
      while CompareRec(TsdDataRecord(AList[Hi]), MidRec, AKeyFields) > 0 do
        Dec(Hi);
      if Lo <= Hi then
      begin
        if Lo < Hi then  begin
          AList.Exchange(Lo, Hi);
        end;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(iLo, Hi);
    if Lo < iHi then QuickSort(Lo, iHi);
  end;

begin
  if (AList = nil) or (AList.Count = 0) then Exit;
  QuickSort(0, AList.Count - 1);
end;

procedure TsdDataSet.ClearCurrentView;
begin
  FCurrentView := nil;
  FEventRec := nil;
end;

procedure TsdDataSet.BeginUpdateHistoryRecord(ARecord: TsdDataRecord);
begin
  if UseSavePoint and (FOperationManager <> nil) then
    FHistory.BeginRecordUpdate(ARecord);
end;

procedure TsdDataSet.EndUpdateHistoryRecord;
begin
  if UseSavePoint and (FOperationManager <> nil) then
    FHistory.EndRecordUpdate;
end;

procedure TsdDataSet.Redo(AID: Integer);
begin
  if not FUseSavePoint then
    raise EsdDataSet.Create('Can not use SavePoint when UseSavePoint is False');
  if not Active then
    raise EsdDataSet.Create('Can not use SavePoint on a closed dataset');
  FHistory.Redo(AID);
end;

procedure TsdDataSet.Undo(AID: Integer);
begin
  if not FUseSavePoint then
    raise EsdDataSet.Create('Can not use SavePoint when UseSavePoint is False');
  if not Active then
    raise EsdDataSet.Create('Can not use SavePoint on a closed dataset');
  FHistory.Undo(AID);
end;

procedure TsdDataSet.WriteHistoryData(AOperation: TsdOperation; AObject: IsdHistoryObject;
  AData: Pointer);
begin
  if Active and FUseSavePoint then
    FHistory.WriteHistoryData(AOperation, AObject, AData);
end;

procedure TsdDataSet.ResumeHistory;
begin
  FHistory.Resume;
end;

procedure TsdDataSet.SuspendHistory;
begin
  FHistory.Suspend;
end;

{ TsdViewColumn }

procedure TsdViewColumn.Assign(Source: TPersistent);
begin
  if Source is TsdViewColumn then
  begin
    if Assigned(Collection) then Collection.BeginUpdate;
    try
      FieldName := TsdViewColumn(Source).FFieldName;
      DisplayFormat := TsdViewColumn(Source).FDisplayFormat;
      EditFormat := TsdViewColumn(Source).FEditFormat;
    finally
      if Assigned(Collection) then Collection.EndUpdate;
    end;  
  end
  else
    inherited;
end;

procedure TsdViewColumn.CheckLookupField;
begin
  if FLookupField <> nil then
  begin
    FLookupField.RemoveLookupCol(Self);
    FLookupField := nil;
  end;
  if (FLookupDataSet <> nil) and (FKeyFields <> '') and (FLookupKeyFields <> '')
      and (FLookupResultField <> '') then
  begin
    FLookupField := FLookupDataSet.Fields.FieldByName(FLookupResultField);
    if FLookupField <> nil then
      FLookupField.AddLookupCol(Self);
  end;
end;

constructor TsdViewColumn.Create(Collection: TCollection);
begin
  inherited;
  FField := nil;
  FLookupField := nil;
  FDisplayFormat := '';
  FEditFormat := '';
end;

destructor TsdViewColumn.Destroy;
begin
  if FLookupField <> nil then
  begin
    FLookupField.RemoveLookupCol(Self);
    FLookupDataSet := nil;
  end;
  inherited;
end;

function TsdViewColumn.FormatText(Value: TsdValue;
  DisplayText: Boolean): string;
var
  strFMT: string;
begin
  // 如果为空，即使有格式字符串也输出空
  if (not Assigned(Value)) or Value.IsNull then
  begin
    Result := '';
    Exit;
  end;
  if DisplayText then
    strFMT := FDisplayFormat
  else
    strFMT := FEditFormat;
  case Value.Field.DataType of
    ftSmallint, ftInteger, ftWord:
    begin
      if strFMT = '' then
        Result := Value.Text
      else
        Result := FormatFloat(strFMT, Value.AsInteger);
    end;
    ftFloat:
    begin
      if strFMT = '' then
        Result := Value.Text
      else
        Result := FormatFloat(strFMT, Value.AsFloat);
    end;
    ftCurrency, ftBCD:
    begin
      if strFMT = '' then
        Result := Value.Text
      else
        Result := FormatCurr(strFMT, Value.AsCurrency);
    end;
    ftFMTBCD:
    begin
      if strFMT = '' then
        Result := Value.Text
      else
        Result := FormatBcd(strFMT, Value.AsBCD);
    end;
    ftDateTime:
    begin
      if strFMT = '' then
        Result := Value.Text
      else
        Result := FormatDateTime(strFMT, Value.AsDateTime);
    end
    else
      Result := Value.Text;
  end;
end;

function TsdViewColumn.GetDataView: TsdDataView;
begin
  Result := TsdViewColumnList(Collection).DataView;
end;

function TsdViewColumn.GetDisplayName: string;
begin
  Result := FFieldName;
  if Result = '' then Result := inherited GetDisplayName;
end;

function TsdViewColumn.GetIsLookup: Boolean;
begin
  Result := LookupResultField <> '';
end;

procedure TsdViewColumn.LookupChanged;
begin
  DataView.RefreshField(Self);
end;

procedure TsdViewColumn.SetDisplayFormat(const Value: string);
begin
  FDisplayFormat := Value;
end;

procedure TsdViewColumn.SetEditFormat(const Value: string);
begin
  FEditFormat := Value;
end;

procedure TsdViewColumn.SetFieldName(const Value: string);
begin
  FFieldName := Value;
  if TsdViewColumnList(Collection).DataView.DataSet <> nil then
    FField := TsdViewColumnList(Collection).DataView.DataSet.Fields.FieldByName(FFieldName)
  else
    FField := nil;
end;

procedure TsdViewColumn.SetKeyFields(const Value: string);
begin
  if not SameText(FKeyFields, Value) then
  begin
    FKeyFields := Value;
    CheckLookupField;
  end;
end;

procedure TsdViewColumn.SetLookupDataSet(const Value: TsdDataSet);
begin
  if FLookupDataSet <> Value then
  begin
    FLookupDataSet := Value;
    CheckLookupField;
  end;
end;

procedure TsdViewColumn.SetLookupKeyFields(const Value: string);
begin
  if not SameText(FLookupKeyFields, Value) then
  begin
    FLookupKeyFields := Value;
    CheckLookupField;
  end;
end;

procedure TsdViewColumn.SetLookupResultField(const Value: string);
begin
  if not SameText(FLookupResultField, Value) then
  begin
    FLookupResultField := Value;
    CheckLookupField;
  end;
end;

{ TsdViewColumnList }

function TsdViewColumnList.Add: TsdViewColumn;
begin
  Result := TsdViewColumn(inherited Add);
end;

procedure TsdViewColumnList.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
end;

constructor TsdViewColumnList.Create(ADataView: TsdDataView; ItemClass: TsdViewColumnClass);
begin
  inherited Create(ItemClass);
  FDataView := ADataView;
end;

function TsdViewColumnList.FindColumn(
  const AFieldName: string): TsdViewColumn;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Self.Count - 1 do
    if SameText(AFieldName, Items[I].FieldName) then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TsdViewColumnList.GetItem(Index: Integer): TsdViewColumn;
begin
  Result := TsdViewColumn(inherited Items[Index]);
end;

function TsdViewColumnList.GetOwner: TPersistent;
begin
  Result := FDataView;
end;

function TsdViewColumnList.IndexByName(const AFieldName: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Self.Count - 1 do
    if SameText(AFieldName, Items[I].FieldName) then
    begin
      Result := I;
      Break;
    end;
end;

procedure TsdViewColumnList.SetItem(Index: Integer;
  const Value: TsdViewColumn);
begin
  inherited SetItem(Index, Value);
end;

procedure TsdViewColumnList.Update(Item: TCollectionItem);
begin
  {if not (csDestroying in FDataView.ComponentState) then
  begin
    FDataView.Changed(nil, sroModify);
  end;}
end;

{ TsdDataView }

procedure TsdDataView.InitRecords;
begin
  if FDataSet = nil then Exit;
  FDataList.Clear;
  if FIndex = nil then
    FDataSet.AssignRecords(FDataList)
  else
    FIndex.AssignRecords(FDataList);
end;

procedure TsdDataView.CancelRange;
begin
  FRangeFrom := Null;
  FRangeTo := Null;
  FilterRecords;
  NotifyControlDataViewChanged;
end;

procedure TsdDataView.Changed(const Sender: TObject; AOperation: TsdOperation);
var
  iOldCurrentIndex: Integer;
  OldCurrent: TsdDataRecord;

  procedure InnerCheckCurrent;
  begin
    // 先检查FOldCurrentIndex相同时FOldCurrent是否发生变化，这是由TsdDataView.Insert触发的
    // 再检查iOldCurrentIndex相同时OldCurrent是否发生变化，这是由DataSet触发的
    // 再检查是否表格第一条记录
    if ((FOldCurrentIndex = CurrentIndex) and (FOldCurrent <> Current))
      or ((iOldCurrentIndex = CurrentIndex) and (OldCurrent <> Current)) then
      CheckCurrent(True);
    FOldCurrentIndex := -1;
    FOldCurrent := nil;
  end;

var
  V: TsdValue;
  Rec: TsdDataRecord;
  RecIndex: Integer;
begin
  RecIndex := -1;
  V := nil;
  Rec := nil;
  if Sender <> nil then
  begin
    if Sender is TsdValue then
    begin
      V := TsdValue(Sender);
      Rec := V.FOwner;
    end
    else if Sender is TsdDataRecord then
      Rec := TsdDataRecord(Sender);
  end
  else if AOperation in [sroAdd, sroModify, sroDelete] then
    raise EsdDataView.Create('RecordChanged needs a sender');

  iOldCurrentIndex := CurrentIndex;
  OldCurrent := Current;
  case AOperation of
    sroAdd:
    begin
      CheckRange(Rec);
      RecIndex := FDataList.IndexOf(Rec);
      InnerCheckCurrent;
    end;
    sroModify:
    begin
      CheckRange(Rec, V);
      RecIndex := FDataList.IndexOf(Rec);
      InnerCheckCurrent;
    end;
    sroDelete:
    begin
      DoBeforeCurrentChange(nil);
      FDataList.Remove(Rec);
      CheckCurrent(True);
    end;
    sdoActive:
      if not DataSet.Active then
        Active := False;
    sdoRefresh:
    begin
      DoBeforeCurrentChange(Current);
      RefreshRange;
      CheckCurrent;
    end;
    sdoReset:
    begin
      // 特殊情况，有时有记录但当前记录在undo/redo中清空成-1了，处理一下
      if (RecordCount > 0) and (CurrentIndex = -1) then
        FCurrentIndex := 0;
      DoBeforeCurrentChange(Current);
      RefreshRange;
      // 特殊情况，有时有记录但当前记录在undo/redo中清空成-1了，处理一下
      if (RecordCount > 0) and (CurrentIndex = -1) then
        FCurrentIndex := 0;
      CheckCurrent(True);
    end;
  end;
  NotifyDataChanged(RecIndex);
end;

constructor TsdDataView.Create(AOwner: TComponent);
begin
  inherited;
  FControlList := TInterfaceList.Create;
  FActive := False;
  FFilterHelper := TsdLogicalExprs.Create(Self);
  FFilter := '';
  FFiltered := False;
  FColumns := TsdViewColumnList.Create(Self, TsdViewColumn);
  FDataList := TList.Create;
  FRangeFrom := Null;
  FRangeTo := Null;
  FRangeLock := 0;
  FCurrentIndex := -1;
  FCurrent := nil;
  FDetailList := TList.Create;
  FNewCurrent := nil;
  FCurrentChanging := False;
  FOldCurrentIndex := -1;
  FOldCurrent := nil;
  FAutoGetFields := False;
end;

function TsdDataView.Delete(Index: Integer): Boolean;
var
  Rec: TsdDataRecord;
begin
  Rec := Records[Index];
  Result := Remove(Rec);
end;

destructor TsdDataView.Destroy;
var
  I: Integer;
begin
  // 从通知主
  if FMasterDataView <> nil then
    FMasterDataView.UnRegisterDetail(Self);
  // 主通知从
  for I := 0 to FDetailList.Count - 1 do
    TsdDataView(FDetailList[I]).ClearMasterDataView;
  FDetailList.Free;
  
  FDataList.Free;
  for I := 0 to FControlList.Count - 1 do
    IsdViewControl(FControlList[I]).FreeNotify;
  FControlList.Free;
  if FDataSet <> nil then
    FDataSet.UnregisterView(Self);
  FColumns.Free;

  FFilterHelper.Free;
  inherited;
end;

procedure TsdDataView.FilterRecords;
var
  I: Integer;
  Rec: TsdDataRecord;
  List: TList;
begin
  if not Active then Exit;
  if RangeLocked then Exit;
  InitRecords;
  if not FFiltered then
  begin
    DoCustomSort(FDataList);
    if not DataSet.FKeepPosition then
    begin
      ResetCurrent;
      CurrentIndex := 0;
    end;
    Exit;
  end;
  ParseFilter;
  List := TList.Create;
  try
    List.Assign(FDataList);
    FDataList.Clear;
    for I := 0 to List.Count - 1 do
    begin
      Rec := TsdDataRecord(List[I]);
      if FilterRecord(Rec) then
        FDataList.Add(Rec);
    end;
  finally
    List.Free;
  end;
  DoCustomSort(FDataList);
  if not DataSet.FKeepPosition then
  begin
    ResetCurrent;
    CurrentIndex := 0;
  end;
  NotifyControlDataViewChanged;
  NotifyDataChanged;
end;

function TsdDataView.GetDisplayText(RecIndex, Col: Integer): string;
var
  V: TsdValue;
  Column: TsdViewColumn;
begin
  Result := '';
  Column := FColumns.Items[Col];
  if Column = nil then Exit;
  V := GetValue(RecIndex, Col);
  if (V <> nil) and (Column <> nil) then
    Result := Column.FormatText(V, True);
  DoOnGetText(Result, GetRecord(RecIndex), V, Column, True);
end;

function TsdDataView.GetFieldCount: Integer;
begin
  Result := FColumns.Count;
end;

function TsdDataView.GetIndex: TsdIndex;
begin
  Result := FIndex;
end;

function TsdDataView.GetRecord(Index: Integer): TsdDataRecord;
begin
  Result := nil;
  if (Index >= 0) and (Index <= RecordCount - 1) then
    Result := TsdDataRecord(FDataList[Index]);
end;

function TsdDataView.GetRecordCount: Integer;
begin
  Result := 0;
  if Active then
    Result := FDataList.Count;
end;

function TsdDataView.GetText(RecIndex, Col: Integer): string;
var
  V: TsdValue;
  Column: TsdViewColumn;
begin
  Result := '';
  V := GetValue(RecIndex, Col);
  Column := FColumns.Items[Col];
  if (V <> nil) and (Column <> nil) then
  begin
    Result := Column.FormatText(V, False);
  end;
  DoOnGetText(Result, GetRecord(RecIndex), V, Column, False);
end;

function TsdDataView.GetValue(RecIndex, Col: Integer): TsdValue;
var
  bNeedLookupRecord: Boolean;
begin
  Result := GetValue(RecIndex, Col, bNeedLookupRecord);
end;

function TsdDataView.GetValue(RecIndex, Col: Integer; var NeedLookupRecord: Boolean): TsdValue;
var
  Rec, LookupRec: TsdDataRecord;
  Column: TsdViewColumn;
begin
  Result := nil;
  Rec := Records[RecIndex];
  NeedLookupRecord := False;
  if Rec <> nil then
  begin
    Column := FColumns.Items[Col];
    if not Column.IsLookup then
    begin
    {to do: 为什么会有为nil的情况? 为什么打开没有东西}
      if Column.Field <> nil then
        Result := Rec.Values[Column.Field.FieldNo];
    end
    else
    begin
      if (Column.LookupDataSet = nil) or (not Column.LookupDataSet.Active) then Exit;
      LookupRec := Column.LookupDataSet.Locate(Column.LookupKeyFields, Rec.FieldValues[Column.KeyFields]);
      if LookupRec <> nil then
        Result := LookupRec.ValueByName(Column.LookupResultField)
      else
        NeedLookupRecord := True;
    end;
  end;
end;

function TsdDataView.Append(NeedBeginUpdate: Boolean): TsdDataRecord;
begin
  Result := Insert(RecordCount, NeedBeginUpdate);
end;

procedure TsdDataView.LoadDefaultColumns;
var
  I: Integer;
  Column: TsdViewColumn;
begin
  if FDataSet = nil then Exit;
  FColumns.Clear;
  for I := 0 to FDataSet.FieldCount - 1 do
  begin
    Column := FColumns.Add;
    Column.FieldName := FDataSet.Fields[I].FieldName;
  end;
end;

procedure TsdDataView.SetActive(const Value: Boolean);
begin
  if (csReading in ComponentState) then
  begin
    FStreamedActive := Value;
    Exit;
  end;
  if DataSet = nil then Exit;
  if FActive = Value then Exit;
  FActive := Value;
  if Active then
  begin
    if not DataSet.Active then DataSet.Open;
    FAutoGetFields := FColumns.Count = 0;
    if FAutoGetFields then
      LoadDefaultColumns;
    ResetIndex;
    FilterRecords;
    //CurrentIndex := 0;
    if IsDetail then
      MasterChanged(FMasterDataView.Current);
    if Assigned(FAfterOpen) then
      FAfterOpen(Self);
  end
  else
  begin
    FCurrentIndex := 0;
    FDataList.Clear;
    FIndex := nil;
    if FAutoGetFields then
      FColumns.Clear;
    if Assigned(FAfterClose) then
      FAfterClose(Self);
  end;
  //LocateInControl(Records[0]);
  NotifyControlActiveChanged;
end;

procedure TsdDataView.SetDataSet(const Value: TsdDataSet);
begin
  if FDataSet = Value then Exit;
  if Active then Active := False;
  if FDataSet <> nil then FDataSet.UnregisterView(Self);
  FDataSet := Value;
  if FDataSet <> nil then
  begin
    if not (csReading in ComponentState) then
      ReloadFields;
    FDataSet.RegisterView(Self);
  end;
  NotifyControlDataViewChanged;
end;

procedure TsdDataView.SetFiltered(const Value: Boolean);
begin
  FFiltered := Value;
  FilterRecords;
  NotifyControlDataViewChanged;
end;

procedure TsdDataView.SetIndexName(const Value: string);
begin
  if SameText(Value, FIndexName) and (not ((Value <> '') and (FIndex = nil))) then Exit;
  FIndexName := Value;
  if (csReading in ComponentState) and (FDataSet = nil) then
    Exit;
  FIndex := FDataSet.FindIndex(FIndexName);
  if Active then
    FilterRecords;
  NotifyControlDataViewChanged;
end;

procedure TsdDataView.SetOnFilterRecord(const Value: TsdAllowRecordEvent);
begin
  FOnFilterRecord := Value;
end;

procedure TsdDataView.SetOnGetText(const Value: TsdColumnGetTextEvent);
begin
  FOnGetText := Value;
end;

procedure TsdDataView.SetOnSetText(const Value: TsdColumnSetTextEvent);
begin
  FOnSetText := Value;
end;

procedure TsdDataView.SetRange(const StartValues,
  EndValues: array of const);

  function VarRecByType(VarRec: TVarRec; FieldType: TFieldType): Variant;
  begin
    Result := Null;
    case VarRec.VType of
      vtBoolean:
        Result := VarRec.VBoolean;
      vtString:
        Result := VarRec.VString^;
      vtAnsiString:
        Result := AnsiString(VarRec.VAnsiString);
      vtWideString:
        Result := WideString(VarRec.VWideString);
      vtInteger:
        Result := VarRec.VInteger;
      vtExtended:
        Result := VarRec.VExtended^;
      vtCurrency:
        Result := VarRec.VCurrency^;
      vtVariant:
        Result := VarRec.VVariant^;
    end;
  end;

var
  I, iHigh: Integer;
  List: TList;
begin
  if not Active then Exit;
  if FIndex = nil then
    raise EsdDataView.Create('Can not set range without an index');
  iHigh := High(StartValues);
  if iHigh <> High(EndValues) then
    raise EsdDataView.Create('Parameter number not matched');
{  if iHigh = 1 then
  begin
    FRangeFrom := VarRecByType(StartValues[0], FIndex.Fields[0].DataType);
    FRangeTo := VarRecByType(EndValues[0], FIndex.Fields[0].DataType);
  end
  else
  begin  }
    if iHigh > FIndex.LevelCount - 1 then
      iHigh := FIndex.LevelCount - 1;
    FRangeFrom := VarArrayCreate([0, iHigh], varVariant);
    for I := 0 to iHigh do
      VarArrayPut(FRangeFrom, VarRecByType(StartValues[I], FIndex.Fields[I].DataType), [I]);
    FRangeTo := VarArrayCreate([0, iHigh], varVariant);
    for I := 0 to iHigh do
      VarArrayPut(FRangeTo, VarRecByType(EndValues[I], FIndex.Fields[I].DataType), [I]);
//  end;
  if DataSet.RecordCount = 0 then
  begin
    ResetCurrent;
    CurrentIndex := 0;
    Exit;
  end;

  RefreshRange;
end;

procedure TsdDataView.SetText(RecIndex, Col: Integer; const Value: string);
var
  V: TsdValue;
  strValue: string;
  bAllow, bNeedLookupRecord: Boolean;
begin
  strValue := Value;
  FDataSet.FCurrentView := Self;
  V := GetValue(RecIndex, Col, bNeedLookupRecord);
  try
    if Assigned(V) then
    begin
      if Assigned(FDataSet.FEventRec) and (FDataSet.FEventRec <> V.Owner) then
        raise EsdDataView.Create('DataSet.FEventRec is assigned');
      FDataSet.FEventRec := V.Owner;
    end;
    SetValueText(V, Records[RecIndex], strValue, Columns[Col]);
    if (not Assigned(V)) and bNeedLookupRecord then
      AddLookupRecord(RecIndex, Col, strValue);
  finally
    if (V = nil) or (not V.Owner.IsUpdating) then
    begin
      FDataSet.FCurrentView := nil;
      FDataSet.FEventRec := nil;
    end;
  end;
end;

procedure TsdDataView.FreeNotify;
begin
  DataSet := nil;
end;

// zhangyin 2014-10-21 SetRange时，全部范围用前一个0，后一个MaxInt
procedure TsdDataView.RefreshRange;
var
  I, iFrom, iTo: Integer;
  List: TList;
  Rec: TsdDataRecord;
  Flag: TsdIndexFlag;
begin
  if RangeLocked then Exit;
  Flag := sifNull;
  InitRecords;
  if FIndex = nil then
  begin
    iFrom := 0;
    iTo := RecordCount - 1;
  end
  else
  begin
    if VarIsNull(FRangeFrom) then
      iFrom := 0
    else
    begin
      // sifLessThanMin: 比最前一个节点更靠前，则从-1开始
      // sifMoreThanMax：开始点到比最后节点更靠后，则将iTo设为-1
      Flag := FIndex.FindNearestKeyIndex(FRangeFrom, iFrom);
      case Flag of
        sifLessThanMin:
          iFrom := 0;
      end;
    end;
    if Flag = sifMoreThanMax then
      iTo := -1
    else
    begin
      if VarIsNull(FRangeTo) then
        iTo := RecordCount - 1
      else
        // 这里要把索引节点自身包含的记录算上，注意要考虑没找到节点的情况
        FIndex.FindNearestKeyIndex(FRangeTo, iTo, True);
    end;
  end;
  List := TList.Create;
  try
    List.Assign(FDataList);
    FDataList.Clear;
    if iFrom >= 0 then
      for I := iFrom to iTo do
      begin
        Rec := TsdDataRecord(List[I]);
        if FilterRecord(Rec) then
          FDataList.Add(Rec);
      end;
  finally
    List.Free;
  end;
  DoCustomSort(FDataList);
  if not DataSet.FKeepPosition then
  begin
    ResetCurrent;
    CurrentIndex := 0;
  end;
  NotifyControlDataViewChanged;
  NotifyDataChanged;
end;

function TsdDataView.CheckRange(ARecord: TsdDataRecord; AValue: TsdValue): Integer;
var
  I, iFrom, iTo, iIndex, iPos: Integer;
  Rec: TsdDataRecord;
  Flag: TsdIndexFlag;
begin
  Result := -1;
  if RangeLocked then Exit;
  if not Active then Exit;
  if (AValue <> nil) and (FIndex <> nil) and (not FIndex.IsKeyField(AValue.FieldName)) then
    Exit;
  if FIndex = nil then
  begin
    if FDataList.IndexOf(ARecord) < 0 then
    begin
      if FilterRecord(ARecord) then
        Result := FDataList.Add(ARecord);
    end
    else if FilterRecord(ARecord) then
      Result := FDataList.IndexOf(ARecord)
    else
      FDataList.Remove(ARecord);
    Exit;
  end;
  Flag := sifNull;
  if VarIsNull(FRangeFrom) then
    iFrom := 0
  else
  begin
    // sifLessThanMin: 比最前一个节点更靠前，则从-1开始
    // sifMoreThanMax：开始点到比最后节点更靠后，则将iTo设为-1
    Flag := FIndex.FindNearestKeyIndex(FRangeFrom, iFrom);
    case Flag of
      sifLessThanMin:
        iFrom := -1;
    end;
  end;

  if Flag = sifMoreThanMax then
    iTo := -1
  else
  begin
    if VarIsNull(FRangeTo) then
      // 为空需要放在最后，所以这里RecordCount不减1
      iTo := FIndex.RecordCount
    else
      // 这里要把索引节点自身包含的记录算上，注意要考虑没找到节点的情况
      FIndex.FindNearestKeyIndex(FRangeTo, iTo, True);
  end;

  iIndex := FIndex.IndexOf(ARecord);
  //已存在先删除
  if FDataList.IndexOf(ARecord) >= 0 then
    FDataList.Remove(ARecord);
  if (iIndex >= iFrom) and (iIndex <= iTo) then
  begin
    // 过滤
    if not FilterRecord(ARecord) then Exit;
    // 没有记录
    if FDataList.Count = 0 then
    begin
      Result := FDataList.Add(ARecord);
      // 新增记录 已指定CurrentIndex，则强制触发CurrentChanged事件
      if ARecord.Inserting then
      begin
        if FCurrentIndex = -1 then
          FCurrentIndex := 0;
        if FCurrentIndex = 0 then
          CheckCurrent(True);
      end;
      NotifyDataChanged;
      Exit;
    end;
    // 是符合条件的第一条记录
    Rec := Records[0];
    if FIndex.CompareData(ARecord, Rec) <= 0 then
    begin
      FDataList.Insert(0, ARecord);
      DoCustomSort(FDataList);
      NotifyDataChanged;
      Result := 0;
      Exit;
    end;
    // 是符合条件的最后一条记录
    Rec := Records[FDataList.Count - 1];
    if FIndex.CompareData(Rec, ARecord) < 0 then
    begin
      Result := FDataList.Add(ARecord);
      DoCustomSort(FDataList);
      NotifyDataChanged;
      Exit;
    end;

    iPos := -1;
    I := iIndex - 1;
    repeat
      Rec := FIndex.Records[I];
      if IndexOf(Rec) >= 0 then
      begin
        iPos := IndexOf(Rec);
        Break;
      end;
      Dec(I);
    until I < 0;
    FDataList.Insert(iPos + 1, ARecord);
    Result := iPos;

    DoCustomSort(FDataList);

    NotifyDataChanged;
    (*Rec := FIndex.Records[iTo];
    if Rec <> nil then
      Result := FDataList.IndexOf(Rec);
    if Result = -1 then
      Result := FDataList.Count;
    FDataList.Insert(Result, ARecord);*)
  end;
end;

procedure TsdDataView.RegisterControl(Control: IsdViewControl);
begin
  if FControlList.IndexOf(Control) < 0 then
    FControlList.Add(Control);
end;

function TsdDataView.FindColumn(const AFieldName: string): TsdViewColumn;
begin
  Result := FColumns.FindColumn(AFieldName);
end;

function TsdDataView.FilterRecord(ARecord: TsdDataRecord): Boolean;
begin
  Result := True;
  if FFiltered and (FFilter <> '') then
    Result := FFilterHelper.Calc(ARecord);
  if FFiltered and Assigned(FOnFilterRecord) then
    FOnFilterRecord(ARecord, Result);
end;

function TsdDataView.Insert(Index: Integer; NeedBeginUpdate: Boolean): TsdDataRecord;
var
  Rec: TsdDataRecord;
begin
  Result := nil;
  FDataSet.FCurrentView := Self;
  try
    Rec := DataSet.CreateRecord;
    FDataSet.FEventRec := Rec;
    Rec.SetInserting(True, NeedBeginUpdate);
    Rec.BeginUpdate;
    DataSet.InitRecord(Rec);
    try
      if DataSet.AddRecord(Rec, False) < 0 then
        Exit;
      // 保存当前记录以备后面检查当前记录是否改变
      FOldCurrentIndex := CurrentIndex;
      FOldCurrent := Current;
      if FIndex <> nil then
        FDataList.Insert(Index, Rec)
      else
        FDataList.Add(Rec);
      // 注意Insert的记录必须在此事件中处理索引字段值
      DoBeforeSortAddedRecord(Rec);
      { // EndUpdate中已经处理
      if not Rec.IsUpdating then
      begin
        DataSet.CheckIndex(Rec, nil);
        DataSet.Changed(Rec, sroAdd);
      end; }
    finally
      // 如需BeginUpadte，则在外部EndUpdate
      if not NeedBeginUpdate then
        Rec.EndUpdate;
    end;
//    if Assigned(FAfterAddRecord) then
//      FAfterAddRecord(Rec);
    Result := Rec;
  finally
    if not Rec.IsUpdating then
    begin
      FDataSet.FCurrentView := nil;
      FDataSet.FEventRec := nil;
    end;
    if not NeedBeginUpdate then
      Rec.SetInserting(False, NeedBeginUpdate);
  end;
end;

procedure TsdDataView.SetAfterAddRecord(const Value: TsdRecordEvent);
begin
  FAfterAddRecord := Value;
end;

procedure TsdDataView.SetAfterDeleteRecord(const Value: TsdRecordEvent);
begin
  FAfterDeleteRecord := Value;
end;

procedure TsdDataView.SetAfterValueChanged(const Value: TsdValueEvent);
begin
  FAfterValueChanged := Value;
end;

procedure TsdDataView.SetBeforeAddRecord(const Value: TsdAllowRecordEvent);
begin
  FBeforeAddRecord := Value;
end;

procedure TsdDataView.SetBeforeDeleteRecord(
  const Value: TsdAllowRecordEvent);
begin
  FBeforeDeleteRecord := Value;
end;

procedure TsdDataView.SetBeforeValueChange(
  const Value: TsdAllowValueEvent);
begin
  FBeforeValueChange := Value;
end;

procedure TsdDataView.SetBeforeSortAddedRecord(
  const Value: TsdRecordEvent);
begin
  FBeforeSortAddedRecord := Value;
end;

function TsdDataView.IndexOf(ARecord: TsdDataRecord): Integer;
begin
  Result := FDataList.IndexOf(ARecord);
end;

procedure TsdDataView.GetFieldNames(AFieldNames: TStringList);
var
  I: Integer;
begin
  AFieldNames.Clear;
  for I := 0 to FColumns.Count - 1 do
    AFieldNames.Add(FColumns[I].FieldName);
end;

procedure TsdDataView.SetColumns(const Value: TsdViewColumnList);
begin
  FColumns.Assign(Value);
end;

procedure TsdDataView.Loaded;
begin
  inherited Loaded;
  try
    ReloadFields;
    IndexName := FIndexName;
    if FStreamedActive then
      Active := True;
  except
    if csDesigning in ComponentState then
      raise;
  end;
end;

procedure TsdDataView.ReloadFields;
var
  I: Integer;
begin
  for I := 0 to Columns.Count - 1 do
    Columns[I].FieldName := Columns[I].FieldName;
end;

procedure TsdDataView.UnRegisterControl(Control: IsdViewControl);
begin
  FControlList.Remove(Control);
end;

procedure TsdDataView.Close;
begin
  Active := False;
end;

procedure TsdDataView.Open;
begin
  Active := True;
end;

procedure TsdDataView.RefreshFilter;
begin
  Filtered := False;
  Filtered := True;
end;

procedure TsdDataView.NotifyDataChanged(RecIndex: Integer);
begin
  if not DataSet.ControlsDisabled then
    NotifyControlDataChanged(RecIndex);
end;

procedure TsdDataView.SetAfterClose(const Value: TNotifyEvent);
begin
  FAfterClose := Value;
end;

procedure TsdDataView.SetAfterOpen(const Value: TNotifyEvent);
begin
  FAfterOpen := Value;
end;

procedure TsdDataView.DoAfterValueChanged(AValue: TsdValue);
begin
  if Assigned(FAfterValueChanged) then
    FAfterValueChanged(AValue);
end;

procedure TsdDataView.DoBeforeValueChange(AValue: TsdValue; const NewValue: Variant;
  var Allow: Boolean);
begin
  if Assigned(FBeforeValueChange) then
    FBeforeValueChange(AValue, NewValue, Allow);
end;

procedure TsdDataView.DoOnGetText(var Text: string; ARecord: TsdDataRecord;
  AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean);
begin
  if Assigned(ARecord) and (not ARecord.IsInEvent) and Assigned(FOnGetText) then
  begin
    ARecord.EnterEvent;
    try
      FOnGetText(Text, ARecord, AValue, AColumn, DisplayText);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

procedure TsdDataView.DoOnSetText(var Text: string; ARecord: TsdDataRecord;
  AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean);
begin
  if (not ARecord.IsInEvent) and Assigned(FOnSetText) then
  begin
    ARecord.EnterEvent;
    try
      FOnSetText(Text, ARecord, AValue, AColumn, Allow);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

function TsdDataView.LocateInControl(ARecord: TsdDataRecord): Boolean;
var
  I: Integer;
begin
  Result := False;
  I := IndexOf(ARecord);
  // zhangyin 2016-09-25
  // 很多地方需要刷新当前记录的子项，并且TDataSet.Locate也是不管有没有变化的
  // 所以这里屏蔽掉判断
  //if (I <> CurrentIndex) or (ARecord <> Current) then
  begin
    CurrentIndex := I;
    Result := Current <> nil;
  end;
end;

function TsdDataView.LocateInControl(const KeyFields: string;
  const KeyValues: Variant): Boolean;
var
  Rec: TsdDataRecord;
begin
  Rec := Locate(KeyFields, KeyValues);
  Result := (Rec <> nil);
  if Result then
    Result := LocateInControl(Rec);
end;

function TsdDataView.GetCurrent: TsdDataRecord;
begin
  Result := Records[CurrentIndex];
end;
{var
  C: IsdViewControl;
begin
  Result :=  nil;
  if FControlList.Count = 0 then Exit;
  C := IsdViewControl(FControlList[0]);
  if C <> nil then
  begin
    Result := Records[C.ActiveRecord];
  end;
end; }

procedure TsdDataView.SetOnCurrentChanged(const Value: TsdRecordEvent);
begin
  FOnCurrentChanged := Value;
end;

procedure TsdDataView.RefreshField(AViewColumn: TsdViewColumn);
begin
  NotifyControlFieldChanged(AViewColumn.FieldName);
end;

function TsdDataView.Remove(ARecord: TsdDataRecord): Boolean;
begin
  FDataSet.FCurrentView := Self;
  FDataSet.FEventRec := ARecord;
  try
    Result := FDataSet.RemoveRecord(ARecord);
  finally
    FDataSet.FCurrentView := nil;
    FDataSet.FEventRec := nil;
  end;
end;

procedure TsdDataView.AddLookupRecord(ARecIndex, ACol: Integer; Text: string);
var
  Rec, LookupRec: TsdDataRecord;
  Column: TsdViewColumn;
begin
  Rec := Records[ARecIndex];
  if Rec <> nil then
  begin
    Column := FColumns.Items[ACol];
    if Column.IsLookup and Assigned(FOnNeedLookupRecord) then
       FOnNeedLookupRecord(Rec, Column, Text);
  end;
end;

procedure TsdDataView.SetOnNeedLookupRecord(
  const Value: TsdNeedLookupRecordEvent);
begin
  FOnNeedLookupRecord := Value;
end;

procedure TsdDataView.NotifyControlActiveChanged;
var
  I: Integer;
begin
  for I := 0 to FControlList.Count - 1 do
    IsdViewControl(FControlList[I]).ActiveChanged;
end;

procedure TsdDataView.NotifyControlActiveRecordChanged(RecIndex: Integer);
var
  I: Integer;
begin
  for I := 0 to FControlList.Count - 1 do
    IsdViewControl(FControlList[I]).ActiveRecordChanged(RecIndex);
end;

procedure TsdDataView.NotifyControlDataViewChanged;
var
  I: Integer;
begin
  for I := 0 to FControlList.Count - 1 do
    IsdViewControl(FControlList[I]).DataViewChanged;
end;

procedure TsdDataView.NotifyControlFieldChanged(AFieldName: string);
var
  I: Integer;
begin
  for I := 0 to FControlList.Count - 1 do
    IsdViewControl(FControlList[I]).FieldChanged(AFieldName);
end;

procedure TsdDataView.NotifyControlDataChanged(RecIndex: Integer);
var
  I: Integer;
begin
  for I := 0 to FControlList.Count - 1 do
    IsdViewControl(FControlList[I]).DataChanged(RecIndex);
end;

procedure TsdDataView.SetValueText(AValue: TsdValue; ARecord: TsdDataRecord; var Text: string; AColumn: TsdViewColumn);
var
  bAllow: Boolean;
  pData, pCache: Pointer;
  vValue: Variant;
  iLength: Integer;
  bNoNull: Boolean;
  bIsLookup: Boolean;
begin
  bAllow := True;
  // 让没有字段对应的列也能触发SetText事件
  if AValue = nil then
  begin
    DoOnSetText(Text, ARecord, AValue, AColumn, bAllow);
    Exit;
  end;
  pData := nil;
  pCache := AValue.CopyCache;
  try
    bIsLookup := AValue.Owner <> ARecord;
    // 这样保证Lookup字段也能触发当前DataView事件
    if bIsLookup then
      AValue.Owner.Owner.FCurrentView := Self;
    // 节约内存，有变化时才缓存原始值
    AValue.CacheOriginalValue;
    // 考虑有Lookup的情况存在，必须将DataView中对应的Record传进DoOnSetText
    DoOnSetText(Text, ARecord, AValue, AColumn, bAllow);
    if not bAllow then
    begin
      AValue.Owner.Owner.FCurrentView := nil;
      Exit;
    end;

    AValue.ConvertDataBeforeWriteData(Text, pData, vValue, iLength, bNoNull);
    if not AValue.CanWriteData(pData, pCache, iLength, bNoNull) then
    begin
      // 多个字段写入时，由EndUpdate负责这一句
      if not AValue.Owner.IsUpdating then
        AValue.Owner.Owner.FCurrentView := nil;
      Exit;
    end;

    bAllow := True;
    AValue.Owner.Owner.DoBeforeValueChange(AValue, vValue, bAllow);
    if not bAllow then
    begin
      AValue.Owner.Owner.FCurrentView := nil;
      Exit;
    end;

    AValue.InnerWriteData(pData, vValue, iLength, bNoNull);

    AValue.Owner.Owner.DoAfterValueChanged(AValue);
    AValue.Owner.Changed(AValue);
  finally
    if bIsLookup then
      AValue.Owner.Owner.FCurrentView := nil;
    if Assigned(pData) then
      FreeMem(pData);
    AValue.ClearCache(pCache);
  end;
end;

function TsdDataView.GetColumns(Index: Integer): TsdViewColumn;
begin
  Result := Columns[Index];
end;

procedure TsdDataView.SaveToXML(AFileName: string);
var
  xmlDoc: IXMLDocument;
  vRoot, vItem: IXMLNode;
  I, J: Integer;
  Rec: TsdDataRecord;
begin
  xmlDoc := TXMLDocument.Create(nil) as IXMLDocument;
  try
    xmlDoc.Active := True;
    xmlDoc.Encoding := 'gb2312';
    xmlDoc.Options := xmlDoc.Options + [doAttrNull, doNodeAutoIndent];
    vRoot := xmlDoc.AddChild('SmartDataView_data_list');
    vRoot.Attributes['DataSet'] := Name;
    for I := 0 to RecordCount - 1 do
    begin
      Rec := Records[I];
      vItem := vRoot.AddChild('Record');
      for J := 0 to FieldCount - 1 do
        vItem.Attributes[Columns[J].FieldName] := Rec.Values[Columns[J].Field.FieldNo].Value;
    end;
    xmlDoc.SaveToFile(AFileName);
  finally
    xmlDoc := nil;
  end;
end;

procedure TsdDataView.BeginLockRange;
begin
  Inc(FRangeLock);
end;

procedure TsdDataView.EndLockRange(ARefresh: Boolean);
begin
  if FRangeLock > 0 then
    Dec(FRangeLock);
  if ARefresh and (FRangeLock = 0) then
    RefreshRange;
end;

function TsdDataView.GetRangeLocked: Boolean;
begin
  Result := FRangeLock > 0;
end;

procedure TsdDataView.DoBeforeAddRecord(ARecord: TsdDataRecord;
  var Allow: Boolean);
begin
  if Assigned(FBeforeAddRecord) then
    FBeforeAddRecord(ARecord, Allow);
end;

procedure TsdDataView.DoAfterAddRecord(ARecord: TsdDataRecord);
begin
  if Assigned(FAfterAddRecord) then
    FAfterAddRecord(ARecord);
end;

procedure TsdDataView.SetAfterRecordChanged(const Value: TsdRecordEvent);
begin
  FAfterRecordChanged := Value;
end;

procedure TsdDataView.DoAfterRecordChanged(ARecord: TsdDataRecord);
begin
  if Assigned(FAfterRecordChanged) then
    FAfterRecordChanged(ARecord);
end;

function TsdDataView.Locate(const KeyFields: string;
  const KeyValues: Variant): TsdDataRecord;
var
  KeyCount, I, J: Integer;
  Value: TsdValue;
  V, VR: Variant;
  bFound: Boolean;
  NameList: TStringList;
  FieldNoList: TList;
  Col: TsdViewColumn;
  Field: TsdField;
  Rec: TsdDataRecord;
begin
  Result := nil;
  if VarIsArray(KeyValues) then
    KeyCount := VarArrayHighBound(KeyValues, 1) - VarArrayLowBound(KeyValues, 1) + 1
  else
    KeyCount := 1;
  FieldNoList := TList.Create;
  try
    NameList := TStringList.Create;
    try
      NameList.Delimiter := ';';
      NameList.DelimitedText := KeyFields;
      if NameList.Count  <> KeyCount then
        raise EsdDataView.Create('Fields do not match values');
      for I := 0 to NameList.Count - 1 do
      begin
        Col := FindColumn(NameList[I]);
        if Col = nil then
          raise EsdDataView.Create(Format('Can not find column ''%s''', [NameList[I]]));
        Field := Col.FField;
        if Field = nil then
          raise EsdDataView.Create(Format('Can not find field ''%s''', [NameList[I]]));
        FieldNoList.Add(Pointer(Field.FieldNo));
      end;
    finally
      NameList.Free;
    end;
    for I := 0 to FDataList.Count - 1 do
    begin
      bFound := True;
      Rec := Records[I];
      for J := 0 to KeyCount - 1 do
      begin
        if VarIsArray(KeyValues) then
          V := KeyValues[J]
        else
          V := KeyValues;
        Value := Rec.Values[Integer(FieldNoList[J])];
        if Value.Field.IsVarField then
        begin
          if VarIsNull(V) then
            V := '';
          if Value.IsNull then
            VR := ''
          else
            VR := Value.Value;
        end
        else
          VR := Value.Value;
        if V <> VR then
        begin
          bFound := False;
          Break;
        end;
      end;
      if bFound then
      begin
        Result := Rec;
        Break;
      end;
    end;
  finally
    FieldNoList.Free;
  end;
end;

function TsdDataView.Exchange(const Index1, Index2: Integer): Integer;
var
  Rec1, Rec2: TsdDataRecord;
begin
  Result := -1;
  if FIndex = nil then Exit;
  Rec1 := Records[Index1];
  Rec2 := Records[Index2];
  Result := FIndex.Exchange(Rec1, Rec2);
  if FCurrentIndex = Index1 then
    FCurrentIndex := Index2
  else if FCurrentIndex = Index2 then
    FCurrentIndex := Index1;
  ChangeCurrent;
end;

procedure TsdDataView.Edit(ARecord: TsdDataRecord);
begin
  DataSet.FCurrentView := Self;
  DataSet.FEventRec := ARecord;
end;

procedure TsdDataView.ChangeCurrent;
var
  I: Integer;
begin
  for I := 0 to FDetailList.Count - 1 do
    TsdDataView(FDetailList[I]).MasterChanged(Current);
  // to do: 一个DataView有多个DBA时，每个DBA都会触发这个方法，需优化。但这种情况不多，暂不花精力。
  DoOnCurrentChanged(Current);
end;

procedure TsdDataView.DoBeforeSortAddedRecord(ARecord: TsdDataRecord);
begin
  if Assigned(ARecord) and (not ARecord.IsInEvent) and Assigned(FBeforeSortAddedRecord) then
  begin
    ARecord.EnterEvent;
    try
      FBeforeSortAddedRecord(ARecord);
    finally
      ARecord.ExitEvent;
    end;
  end;
end;

function TsdDataView.GetCurrentIndex: Integer;
begin
  Result := FCurrentIndex;
end;

procedure TsdDataView.SetCurrentIndex(const Value: Integer);
var
  bChanged: Boolean;
begin
  bChanged := False;
  if Active and (FCurrentIndex <> Value) then
  begin
    DoBeforeCurrentChange(Current);
    FCurrentIndex := Value;
    bChanged := True;
    //ChangeCurrent;
  end;
  // 不管有没有变化都通知，以防出现DataView和IDTree不同步的情况
  if Active then
    NotifyControlActiveRecordChanged(FCurrentIndex);
  // zhangyin 2021-01-8 先通知控件，再触发CurrentChanged事件，保证在事件中使用树时能获得正确的当前节点
  if bChanged then
    ChangeCurrent;
end;

procedure TsdDataView.CheckCurrent(AReset: Boolean);
var
  iCurrent: Integer;
begin
  if RecordCount > 0 then
  begin
    // 此套逻辑是为树结构准备，因为DataView不知道树结构，删除当前行时无法给出合理的新当前行
    // 所以必须由树结构在删除记录前调用PrepareNewCurrent通知DataView新当前行
    if FNewCurrent <> nil then
    begin
      iCurrent := IndexOf(FNewCurrent);
      FNewCurrent := nil;
      ResetCurrent;
      CurrentIndex := iCurrent;
    end
    else if FCurrentIndex >= RecordCount then
      CurrentIndex := RecordCount - 1
    else if AReset then
      ChangeCurrent;
  end
  else
    CurrentIndex := -1;
end;

procedure TsdDataView.PrepareNewCurrent(ARecord: TsdDataRecord);
begin
  FNewCurrent := ARecord;
end;

procedure TsdDataView.ResetCurrent;
begin
  FCurrentIndex := -1;
end;

procedure TsdDataView.MasterChanged(ACurrent: TsdDataRecord);
var
  MasterValue: Variant;
begin
  if not Active then Exit;
  if not IsDetail then Exit;
  if ACurrent = nil then
    SetRange([Null], [Null])
  else if (FMasterField <> '') and (ACurrent.ValueByName(FMasterField) <> nil) then
  begin
    MasterValue := ACurrent.ValueByName(FMasterField).Value;
    SetRange([MasterValue], [MasterValue]);
  end;
end;

procedure TsdDataView.SetKeyField(const Value: string);
begin
  FKeyField := Value;
end;

procedure TsdDataView.SetMasterDataView(const Value: TsdDataView);
begin
  if FMasterDataView <> Value then
  begin
    if FMasterDataView <> nil then
      FMasterDataView.UnRegisterDetail(Self);
    FMasterDataView := Value;
    FMasterDataView.RegisterDetail(Self);
    if Active then MasterChanged(FMasterDataView.Current);
  end;
end;

procedure TsdDataView.SetMasterField(const Value: string);
begin
  FMasterField := Value;
end;

procedure TsdDataView.RegisterDetail(ADetail: TsdDataView);
begin
  if FDetailList.IndexOf(ADetail) < 0 then
    FDetailList.Add(ADetail);
end;

procedure TsdDataView.UnRegisterDetail(ADetail: TsdDataView);
begin
  if FDetailList.IndexOf(ADetail) >= 0 then
    FDetailList.Remove(ADetail);
end;

procedure TsdDataView.ClearMasterDataView;
begin
  FMasterDataView := nil;
end;

function TsdDataView.IsDetail: Boolean;
begin
  Result := (FMasterDataView <> nil) and (FIndex <> nil)
   and FIndex.HasKeyFields(FKeyField);
end;

procedure TsdDataView.SetFilter(const Value: string);
begin
  FFilter := Value;
end;

procedure TsdDataView.ParseFilter;
begin
  FFilterHelper.ParseExpression(FFilter);
end;

procedure TsdDataView.DoAfterDeleteRecord(ARecord: TsdDataRecord);
begin
  if Assigned(FAfterDeleteRecord) then
    FAfterDeleteRecord(ARecord);
end;

procedure TsdDataView.DoBeforeDeleteRecord(ARecord: TsdDataRecord;
  var Allow: Boolean);
begin
  if Assigned(FBeforeDeleteRecord) then
    FBeforeDeleteRecord(ARecord, Allow);
end;

procedure TsdDataView.First;
begin
  if RecordCount > 0 then
    CurrentIndex := 0;
end;

procedure TsdDataView.Last;
begin
  if RecordCount > 0 then
    CurrentIndex := RecordCount - 1;
end;

procedure TsdDataView.DoCustomSort(RecordList: TList);
begin
  if Assigned(FOnCustomSort) then
    FOnCustomSort(RecordList);
end;

procedure TsdDataView.SetOnCustomSort(const Value: TsdCustomSortEvent);
begin
  FOnCustomSort := Value;
end;

procedure TsdDataView.DoOnCurrentChanged(ARecord: TsdDataRecord);
begin
  FCurrentChanging := False;
  if Assigned(FOnCurrentChanged) then
    FOnCurrentChanged(ARecord);
end;

procedure TsdDataView.DoBeforeCurrentChange(ARecord: TsdDataRecord);
begin
  if (not FCurrentChanging) and Assigned(FBeforeCurrentChange) then
  begin
    FBeforeCurrentChange(ARecord);
    FCurrentChanging := True;
  end;
end;

procedure TsdDataView.SetBeforeCurrentChange(const Value: TsdRecordEvent);
begin
  FBeforeCurrentChange := Value;
end;

procedure TsdDataView.ResetIndex;
begin
  if (csReading in ComponentState) and (FDataSet = nil) then
    Exit;
  FIndex := FDataSet.FindIndex(FIndexName);
end;

procedure TsdDataView.AssignRecords(AList: TList);
begin
  AList.Assign(FDataList);
end;

{ TsdAggregator }

function TsdAggregator.Aggregate(const KeyValues: Variant; const FieldName: string): Variant;
var
  List: TList;
  I: Integer;
  Field: TsdField;
  Rec: TsdDataRecord;
begin
  Result := 0;
  if (FDataSet = nil) or (not FDataSet.Active) then Exit;
  FIndex := FDataSet.FindIndex(FIndexName);
  if FIndex = nil then Exit;
  List := TList.Create;
  try
    if FIndex.RecordsByKey(KeyValues, List) > 0 then
    begin
      Field := FDataSet.Fields.FieldByName(FieldName);
      for I := 0 to List.Count - 1 do
      begin
        Rec := TsdDataRecord(List[I]);
        Result := Result + Rec.Values[Field.FieldNo].AsVariant;
      end;
    end;
  finally
    List.Free;
  end;
end;

constructor TsdAggregator.Create(AOwner: TComponent);
begin
  inherited;

end;

destructor TsdAggregator.Destroy;
begin

  inherited;
end;

procedure TsdAggregator.SetDataSet(const Value: TsdDataSet);
begin
  FDataSet := Value;
end;

procedure TsdAggregator.SetIndexName(const Value: string);
begin
  FIndexName := Value;
end;

{ TsdDetailList }

procedure TsdDetailList.Add(ARecord: TsdDataRecord);
begin
  FList.Add(ARecord);
end;

constructor TsdDetailList.Create(AMasterItem: TsdMasterItem);
begin
  FMasterItem := AMasterItem;
  FList := TList.Create;
end;

destructor TsdDetailList.Destroy;
begin
  FList.Free;
  inherited;
end;

function TsdDetailList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TsdDetailList.GetRecords(Index: Integer): TsdDataRecord;
begin
  Result := TsdDataRecord(FList[Index]);
end;

{ TsdMasterItem }

procedure TsdMasterItem.AddDetailRec(ARecord: TsdDataRecord);
begin
  FList.Add(ARecord);
end;

constructor TsdMasterItem.Create(AMap: TsdMasterDetailMap);
begin
  FMap := AMap;
  FList := TsdDetailList.Create(Self);
  FMap.FList.Add(Self);
end;

destructor TsdMasterItem.Destroy;
begin
  FList.Free;
  inherited;
end;

function TsdMasterItem.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TsdMasterItem.GetRecords(Index: Integer): TsdDataRecord;
begin
  Result := FList[Index];
end;

{ TsdMasterDetailMap }

function TsdMasterDetailMap.CheckDetailIndex: Boolean;
begin
  Result := False;
end;

function TsdMasterDetailMap.CheckMasterIndex: Boolean;
begin
  Result := False;
end;

constructor TsdMasterDetailMap.Create;
begin
  FList := TList.Create;
end;

procedure TsdMasterDetailMap.CreateMap;
var
  I, J, iIndex, iMasterCount, iDetailCount: Integer;
  MasterRec, DetailRec: TsdDataRecord;
  MasterValue, DetailValue: Variant;
  MasterItem: TsdMasterItem;
  iResult: Integer;
begin
  if FMasterField = '' then
    raise EsdMasterDetailMap.Create('MasterField is null');
  if FDetailField = '' then
    raise EsdMasterDetailMap.Create('DetailField is null');
  if not CheckMasterIndex then
    raise EsdMasterDetailMap.Create('Can not find MasterIndex');
  if not CheckDetailIndex then
    raise EsdMasterDetailMap.Create('Can not find DetailIndex');

  for I := 0 to Count - 1 do
    Items[I].Free;
  FList.Clear;

  // 有序双列表遍历算法，一次遍历完成映射表
  iIndex := 0;
  iMasterCount := GetMasterRecordCount;
  iDetailCount := GetDetailRecordCount;
  for I := 0 to iMasterCount - 1 do
  begin
    MasterItem := TsdMasterItem.Create(Self);
    MasterRec := GetMasterRecords(I);
    MasterValue := MasterRec.ValueByName(FMasterField).Value;
    MasterItem.FRec := MasterRec;
    for J := iIndex to iDetailCount - 1 do
    begin
      DetailRec := GetDetailRecords(J);
      CompareValues(MasterRec, DetailRec, iResult);
      // 找到对应从表记录
      if iResult = 0 then
        MasterItem.AddDetailRec(DetailRec)
      // 找过头了
      else if iResult < 0 then
      begin
        iIndex := J;
        Break;
      end;
      // 注意主表当前记录比从表大，则从表直接循环
    end;
  end;
end;

destructor TsdMasterDetailMap.Destroy;
begin
  FList.Free;
  inherited;
end;

procedure TsdMasterDetailMap.CompareValues(MasterRecord,
  DetailRecord: TsdDataRecord; var AResult: Integer);
var
  MasterValue, DetailValue: Variant;
begin
  // 有事件则使用事件的对比
  if Assigned(FOnCompareValues) then
    FOnCompareValues(MasterRecord, DetailRecord, AResult)
  else
  begin
    MasterValue := MasterRecord.ValueByName(FMasterField).Value;
    DetailValue := DetailRecord.ValueByName(FDetailField).Value;
    if MasterValue < DetailValue then
      AResult := -1
    else if MasterValue > DetailValue then
      AResult := 1
    else
      AResult := 0;
  end;
end;

function TsdMasterDetailMap.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TsdMasterDetailMap.GetItems(Index: Integer): TsdMasterItem;
begin
  Result := TsdMasterItem(FList[Index]);
end;

procedure TsdMasterDetailMap.SetDetailField(const Value: string);
begin
  FDetailField := Value;
end;

procedure TsdMasterDetailMap.SetMasterField(const Value: string);
begin
  FMasterField := Value;
end;

procedure TsdMasterDetailMap.SetOnCompareValues(
  const Value: TsdCompareValuesEvent);
begin
  FOnCompareValues := Value;
end;

function TsdMasterDetailMap.ItemByRecord(
  ARecord: TsdDataRecord): TsdMasterItem;
var
  I, iIndex: Integer;
  Item: TsdMasterItem;
begin
  Result := nil;
  if FMasterIndex <> nil then
  begin
    iIndex := FMasterIndex.IndexOf(ARecord);
    Result := GetItems(iIndex);
  end
  else
  begin
    for I := 0 to FList.Count - 1 do
    begin
      Item := TsdMasterItem(FList[I]);
      if Item.Rec = ARecord then
      begin
        Result := Item;
        Break;
      end;
    end;
  end;
end;

function TsdMasterDetailMap.ItemByDetailRecord(
  ARecord: TsdDataRecord): TsdMasterItem;
var
  Item: TsdMasterItem;
  I: Integer;
begin
  Result := nil;
  for I := 0 to FList.Count - 1 do
  begin
    Item := TsdMasterItem(FList[I]);
    if Item.Rec.ValueByName(FMasterField).Value =
        ARecord.ValueByName(FDetailField).Value then
    begin
      Result := Item;
      Break;
    end;
  end;
end;

function TsdMasterDetailMap.RecordByDetailRecord(
  ARecord: TsdDataRecord): TsdDataRecord;
var
  Item: TsdMasterItem;
begin
  Result := nil;
  Item := ItemByDetailRecord(ARecord);
  if Item <> nil then
    Result := Item.Rec;
end;

{ TsdDataSetMasterDetailMap }

function TsdDataSetMasterDetailMap.CheckDetailIndex: Boolean;
begin
  if FDetailDataSet = nil then
    raise EsdMasterDetailMap.Create('DetailDataSet is nil');
  FDetailIndex := FDetailDataSet.IndexList.FindByKeyFields(DetailField, True);
  Result := FDetailIndex <> nil;
end;

function TsdDataSetMasterDetailMap.CheckMasterIndex: Boolean;
begin
  if FMasterDataSet = nil then
    raise EsdMasterDetailMap.Create('MasterDataSet is nil');
  FMasterIndex := FMasterDataSet.IndexList.FindByKeyFields(MasterField, True);
  Result := FMasterIndex <> nil;
end;

function TsdDataSetMasterDetailMap.GetDetailRecordCount: Integer;
begin
  Result := FDetailDataSet.RecordCount;
end;

function TsdDataSetMasterDetailMap.GetDetailRecords(
  AIndex: Integer): TsdDataRecord;
begin
  Result := FDetailIndex.Records[AIndex];
end;

function TsdDataSetMasterDetailMap.GetMasterRecordCount: Integer;
begin
  Result := FMasterDataSet.RecordCount;
end;

function TsdDataSetMasterDetailMap.GetMasterRecords(
  AIndex: Integer): TsdDataRecord;
begin
  Result := FMasterIndex.Records[AIndex];
end;

procedure TsdDataSetMasterDetailMap.SetDetailDataSet(
  const Value: TsdDataSet);
begin
  FDetailDataSet := Value;
end;

procedure TsdDataSetMasterDetailMap.SetMasterDataSet(
  const Value: TsdDataSet);
begin
  FMasterDataSet := Value;
end;

{ TsdDataViewMasterDetailMap }

function TsdDataViewMasterDetailMap.CheckDetailIndex: Boolean;
begin
  if FDetailDataView = nil then
    raise EsdMasterDetailMap.Create('DetailDataView is nil');
  FDetailIndex := nil;
  if FDetailDataView.FIndex.HasKeyFields(DetailField) then
    FDetailIndex := FDetailDataView.FIndex;
  Result := FDetailIndex <> nil;
end;

function TsdDataViewMasterDetailMap.CheckMasterIndex: Boolean;
begin
  if FMasterDataView = nil then
    raise EsdMasterDetailMap.Create('DetailDataView is nil');
  FMasterIndex := nil;
  if FMasterDataView.FIndex.HasKeyFields(MasterField) then
    FMasterIndex := FMasterDataView.FIndex;
  Result := FMasterIndex <> nil;
end;

function TsdDataViewMasterDetailMap.GetDetailRecordCount: Integer;
begin
  if FDetailIndex <> nil then
    Result := FDetailDataView.RecordCount
  else
    Result := 0;
end;

function TsdDataViewMasterDetailMap.GetDetailRecords(
  AIndex: Integer): TsdDataRecord;
begin
  if FDetailIndex <> nil then
    Result := FDetailDataView[AIndex]
  else
    Result := nil;
end;

function TsdDataViewMasterDetailMap.GetMasterRecordCount: Integer;
begin
  if FMasterIndex <> nil then
    Result := FMasterDataView.RecordCount
  else
    Result := 0;
end;

function TsdDataViewMasterDetailMap.GetMasterRecords(
  AIndex: Integer): TsdDataRecord;
begin
  if FMasterIndex <> nil then
    Result := FMasterDataView[AIndex]
  else
    Result := nil;
end;

procedure TsdDataViewMasterDetailMap.SetDetailDataView(
  const Value: TsdDataView);
begin
  FDetailDataView := Value;
end;

procedure TsdDataViewMasterDetailMap.SetMasterDataView(
  const Value: TsdDataView);
begin
  FMasterDataView := Value;
end;

{ TsdListMasterDetailMap }

function TsdListMasterDetailMap.CheckDetailIndex: Boolean;
begin
  FDetailIndex := nil;
  Result := True;
end;

function TsdListMasterDetailMap.CheckMasterIndex: Boolean;
begin
  FMasterIndex := nil;
  Result := True;
end;

function TsdListMasterDetailMap.GetDetailRecordCount: Integer;
begin
  Result := FDetailList.Count;
end;

function TsdListMasterDetailMap.GetDetailRecords(
  AIndex: Integer): TsdDataRecord;
begin
  Result := TsdDataRecord(FDetailList[AIndex]);
end;

function TsdListMasterDetailMap.GetMasterRecordCount: Integer;
begin
  Result := FMasterList.Count;
end;

function TsdListMasterDetailMap.GetMasterRecords(
  AIndex: Integer): TsdDataRecord;
begin
  Result := TsdDataRecord(FMasterList[AIndex]);
end;

procedure TsdListMasterDetailMap.SetDetailList(const Value: TList);
begin
  FDetailList := Value;
end;

procedure TsdListMasterDetailMap.SetMasterList(const Value: TList);
begin
  FMasterList := Value;
end;

{ TsdOperationManager }

constructor TsdOperationManager.Create;
begin
  FActive := True;
  FItems := TList.Create;
  FDataSets := TList.Create;
  // 默认Undo 3次
  FLimitedCount := 10;
  FSavePoint := 0;
  FSnapShooting := False;
  FNeedConfirmSnapShoot := False;
end;

destructor TsdOperationManager.Destroy;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    TsdOperationItem(FItems[I]).Free;
  FItems.Free;
  FDataSets.Free;
  inherited;
end;

function TsdOperationManager.FindItem(AID: Integer): TsdOperationItem;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := nil;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := TsdOperationItem(FItems[I]);
    if Item.ID = AID then
    begin
      Result := Item;
      Break;
    end;
  end;
end;

function TsdOperationManager.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TsdOperationManager.GetItems(I: Integer): TsdOperationItem;
begin
  Result := TsdOperationItem(FItems[I]);
end;

procedure TsdOperationManager.RegisterDataSet(ADataSet: TsdDataSet);
begin
  ADataSet.UseSavePoint := True;
  if FDataSets.IndexOf(ADataSet) < 0 then
  begin
    FDataSets.Add(ADataSet);
    ADataSet.FOperationManager := Self;
  end;
end;

// undo是对FSavePoint前一条记录，redo是对FSavePoint当前记录
procedure TsdOperationManager.Undo(AID: Integer);
var
  I: Integer;
  Item, PrevItem: TsdOperationItem;
begin
  if not Active then Exit;
  // 防止出错
  EndSnapShoot;
  if Count = 0 then Exit;
  SaveHistory('D:\Code\temp\UndoTest\Operations\DataSetBeforeUndo' + FloatToStr(Now) + '.log');
  BeginLog('D:\Code\temp\UndoTest\Operations\UndoLog' + FloatToStr(Now) + '.log');
  try
    // SavePoint是最新的时候要先处理最后一个Item
    Item := FItems[FItems.Count - 1];
    if Item.ID = FSavePoint - 1 then
      Item.EndSnap;
    if AID = -1 then
    begin
      Item := FindPrev(SavePoint);
      if Item <> nil then
      begin
        Item.Undo;
        FSavePoint := Item.ID;
      end;
    end
    else
    begin
      if AID > FSavePoint then
        raise EsdHistory.Create('Can not undo to newer record');
      // 如果中间有多次记录，要依次Undo
      // 1,2,3,4,5  SavePoint = 4, Undo到2, 执行操作集3、2 Undo, SavePoint = 3
      for I := Count - 1 downto 0 do
      begin
        Item := TsdOperationItem(FItems[I]);
        if (Item.ID >= AID) and (Item.ID < FSavePoint) then
        begin
          Item.Undo;
          if Item.ID = AID then
          begin
            FSavePoint := AID;
            Break;
          end;
        end;
      end;
    end;
  finally
    EndLog;
  end;
end;

// undo是对FSavePoint前一条记录，redo是对FSavePoint当前记录
procedure TsdOperationManager.Redo(AID: Integer);
var
  I: Integer;
  Item, NextItem: TsdOperationItem;
begin
  if not Active then Exit;
  // 防止出错
  EndSnapShoot;
  if Count = 0 then Exit;
  SaveHistory('D:\Code\temp\UndoTest\Operations\DataSetBeforeRedo' + FloatToStr(Now) + '.log');
  BeginLog('D:\Code\temp\UndoTest\Operations\RedoLog' + FloatToStr(Now) + '.log');
  try


  if AID = -1 then
  begin
    Item := FindItem(SavePoint);
    if Item <> nil then
    begin
      Item.Redo;
      NextItem := FindNext(Item.ID);
      if NextItem <> nil then
        FSavePoint := NextItem.ID
      else
        FSavePoint := Item.ID + 1;
    end;
  end
  else
  begin
    if AID < FSavePoint then
      raise EsdHistory.Create('Can not redo to older record');
    // 中间有多次记录，要依次Redo
    // 1,2,3,4,5  SavePoint = 2, Redo到4, 执行操作集3、4 Redo, SavePoint = 5
    for I := 0 to Count - 1 do
    begin
      Item := TsdOperationItem(FItems[I]);
      if (Item.ID <= AID) and (Item.ID >= FSavePoint) then
      begin
        Item.Redo;
        if Item.ID = AID then
        begin
          FSavePoint := AID + 1;
          Break;
        end;
      end;
    end;
  end;

  finally
  EndLog;
  end;
end;

function TsdOperationManager.SnapShoot(AName: string; BeginSnapShoot, NeedConfirm: Boolean): Integer;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := -1;
  if not Active then Exit;
  if FSnapShooting then
  begin
    Result := -2;
    Exit;
  end;
  // 还未Confirm的操作先Confirm
  if FNeedConfirmSnapShoot then Confirm;

  FSnapShooting := BeginSnapShoot;
  if FDataSets.Count = 0 then Exit;
  ClearNewerItems;
  // 处理前一个Item
  if FItems.Count > 0 then
  begin
    Item := FItems[FItems.Count - 1];
    if Item <> nil then
      Item.EndSnap;
  end;
  // 创建新Item
  Item := TsdOperationItem.Create(Self, SavePoint, AName);
  Item.SnapShoot;
  FItems.Add(Item);
  // 无需Confirm则清除旧项目
  FNeedConfirmSnapShoot := NeedConfirm;
  if not NeedConfirm then
    while FItems.Count > FLimitedCount do
    begin
      Item := FItems[0];
      Item.Free;
      FItems.Delete(0);
      // 清理旧的Item中记录的需要删除的DataRecord
      Item := FItems[0];
      if Item <> nil then
        Item.ClearOlderHistoryRecord;
    end;
  // 当前SavePoint是虚拟ID，比最大项ID大1
  FSavePoint := NewID;
end;

procedure TsdOperationManager.EndSnapShoot;
begin
  FSnapShooting := False;
end;

procedure TsdOperationManager.UnRegisterDataSet(ADataSet: TsdDataSet);
begin
  FDataSets.Remove(ADataSet);
  ADataSet.FOperationManager := nil;
  // 还应该清理FItems，但是好像用不到本方法，暂不管
end;

function TsdOperationManager.GetDataSet(I: Integer): TsdDataSet;
begin
  Result := TsdDataSet(FDataSets[I]);
end;

function TsdOperationManager.GetDataSetCount: Integer;
begin
  Result := FDataSets.Count;
end;

procedure TsdOperationManager.SetLimitedCount(const Value: Integer);
begin
  FLimitedCount := Value;
end;

function TsdOperationManager.NewID: Integer;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := 0;
  if FItems.Count > 0 then
  begin
    for I := 0 to FItems.Count - 1 do
    begin
      Item := TsdOperationItem(FItems[I]);
      Result := Max(Result, Item.ID);
    end;
    Inc(Result);
  end;
end;

procedure TsdOperationManager.SetDataSetAfterUndo(const Value: TsdOperationDataSetAfterEvent);
begin
  FDataSetAfterUndo := Value;
end;

procedure TsdOperationManager.SetDataSetBeforeUndo(
  const Value: TsdOperationDataSetBeforeEvent);
begin
  FDataSetBeforeUndo := Value;
end;

procedure TsdOperationManager.DoDataSetAfterUndo(ADataSet: TsdDataSet;
  ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord;
  AFields: TStrings; AData: Pointer);
begin
  if Assigned(FDataSetAfterUndo) then
    FDataSetAfterUndo(ADataSet, ARecord, AOperation, ADataRec, AFields, AData);
end;

procedure TsdOperationManager.DoDataSetBeforeUndo(ADataSet: TsdDataSet;
  ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord;
  AFields: TStrings; AData: Pointer; var CanDo: Boolean);
begin
  if Assigned(FDataSetBeforeUndo) then
    FDataSetBeforeUndo(ADataSet, ARecord, AOperation, ADataRec, AFields, AData, CanDo);
end;

function TsdOperationManager.FindNext(AID: Integer): TsdOperationItem;
var
  I, Idx: Integer;
  Item: TsdOperationItem;
begin
  Result := nil;
  if Count = 0 then Exit;
  Idx := IndexByID(AID);
  if Idx < 0 then Exit;
  if Idx + 1 >= Count then Exit;
  Result := TsdOperationItem(FItems[Idx + 1]);
end;

function TsdOperationManager.FindPrev(AID: Integer): TsdOperationItem;
var
  I, Idx: Integer;
  Item: TsdOperationItem;
begin
  Result := nil;
  if Count = 0 then Exit;
  // 最新的ID是虚拟ID（最大ID+ 1）
  if AID = TsdOperationItem(FItems[Count - 1]).ID + 1 then
  begin
    Result := TsdOperationItem(FItems[Count - 1]);
    Exit;
  end;
  Idx := IndexByID(AID);
  if Idx < 0 then Exit;
  if Idx - 1 < 0 then Exit;
  Result := TsdOperationItem(FItems[Idx - 1]);
end;

procedure TsdOperationManager.OperationList(AList: TStrings; Undo: Boolean);
var
  I: Integer;
  Item: TsdOperationItem;
begin
  AList.Clear;
  if Undo then
    for I := FItems.Count - 1 downto 0 do
    begin
      Item := TsdOperationItem(FItems[I]);
      if Item.ID < FSavePoint then
        AList.AddObject(Item.Name, Pointer(Item.ID));
    end
  else
    for I := 0 to FItems.Count - 1 do
    begin
      Item := TsdOperationItem(FItems[I]);
      if Item.ID >= FSavePoint then
        AList.AddObject(Item.Name, Pointer(Item.ID));
    end;
end;

function TsdOperationManager.IndexByID(AID: Integer): Integer;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := -1;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := TsdOperationItem(FItems[I]);
    if Item.ID = AID then
    begin
      Result := I;
      Break;
    end;
  end;
end;

procedure TsdOperationManager.DoDataSetAfterRedo(ADataSet: TsdDataSet;
  ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord;
  AFields: TStrings; AData: Pointer);
begin
  if Assigned(FDataSetAfterRedo) then
    FDataSetAfterRedo(ADataSet, ARecord, AOperation, ADataRec, AFields, AData);
end;

procedure TsdOperationManager.DoDataSetBeforeRedo(ADataSet: TsdDataSet;
  ARecord: TsdDataRecord; AOperation: TsdOperation; ADataRec: TsdDataRecord;
  AFields: TStrings; AData: Pointer; var CanDo: Boolean);
begin
  if Assigned(FDataSetBeforeRedo) then
    FDataSetBeforeRedo(ADataSet, ARecord, AOperation, ADataRec, AFields, AData, CanDo);
end;

procedure TsdOperationManager.SetDataSetAfterRedo(const Value: TsdOperationDataSetAfterEvent);
begin
  FDataSetAfterRedo := Value;
end;

procedure TsdOperationManager.SetDataSetBeforeRedo(
  const Value: TsdOperationDataSetBeforeEvent);
begin
  FDataSetBeforeRedo := Value;
end;

function TsdOperationManager.RedoCount: Integer;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := 0;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := TsdOperationItem(FItems[I]);
    if Item.ID >= FSavePoint then
      Inc(Result);
  end;
end;

function TsdOperationManager.UndoCount: Integer;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := 0;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := TsdOperationItem(FItems[I]);
    if Item.ID < FSavePoint then
      Inc(Result);
  end;
end;

function TsdOperationManager.CurrentRedoName: string;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := '';
  if FItems.Count = 0 then Exit;
  Item := FItems[FItems.Count - 1];
  // 当前最新，则没有Redo
  if Item.ID < FSavePoint then Exit;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := TsdOperationItem(FItems[I]);
    if Item.ID = FSavePoint then
    begin
      Result := Item.Name;
      Break;
    end;
  end;
end;

function TsdOperationManager.CurrentUndoName: string;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  Result := '';
  if FItems.Count = 0 then Exit;
  Item := FItems[0];
  // 已全部Undo完
  if Item.ID = FSavePoint then Exit;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := TsdOperationItem(FItems[I]);
    // 当前Undo是前一个操作
    if (Item.ID = (FSavePoint - 1)) then
    begin
      Result := Item.Name;
      Break;
    end;
  end;
end;

procedure TsdOperationManager.ClearNewerItems;
var
  I: Integer;
  Item: TsdOperationItem;
begin
  if FItems.Count = 0 then Exit;
  for I := FItems.Count - 1 downto 0 do
  begin
    Item := FItems[I];
    if Item.ID >= FSavePoint then
    begin
      FItems.Remove(Item);
      Item.ClearNewerHistoryRecord;
      Item.Free;
    end;
  end;
end;

procedure TsdOperationManager.SaveHistory(AFileName: string);
var
  I, J, K, L: Integer;
  slLogs: TStringList;
  Item: TsdOperationItem;
  pInfo: PsdHistoryInfo;
  DataSet: TsdDataSet;
  HList: TsdHistoryList;
  HRec: TsdHistoryRecord;
  HValue: TsdHistoryValue;
  V: TsdValue;
  F, FOrg: TsdField;
  strIndent, strRec: string;
  Dir: string;
begin
  Dir := ExtractFileDir(AFileName);
  if not DirectoryExists(Dir) then Exit;
  slLogs := TStringList.Create;
  V := TsdValue.Create(nil);
  F := TsdField.Create(nil);
  V.FField := F;
  try
    for I := 0 to Count - 1 do
    begin
      Item := Items[I];
      slLogs.Add(Format('Operation: %s; SavePoint: %d', [Item.Name, SavePoint]));
      for J := 0 to Item.FInfos.Count - 1 do
      begin
        pInfo := Item.FInfos[J];
        DataSet := pInfo^.DataSet;
        strIndent := '  ';
        slLogs.Add(Format('%sDataSet: %s; SavePoint: %d StartPoint: %d; EndPoint: %d', [strIndent, DataSet.Name, DataSet.SavePoint, pInfo^.StartPoint, pInfo^.EndPoint]));
        HList := DataSet.FHistory;
        strIndent := '    ';
        for K := 0 to HList.FRecList.Count - 1 do
        begin
          HRec := TsdHistoryRecord(HList.FRecList[K]);
          case HRec.Operation of
            sroAdd: strRec := strIndent + 'Add: ';
            sroDelete: strRec := strIndent + 'Delete: ';
            sroModify: strRec := strIndent + 'Modify: ';
          end;
          for L := 0 to HRec.Count - 1 do
          begin
            HValue := HRec.Values[L];
            FOrg := DataSet.FieldByName(HValue.FieldName);
            F.FDataType := FOrg.FDataType;
            HValue.CopyTo(V);
            strRec := strRec + Format('%s=%s; ', [HValue.FieldName, V.AsString]);
          end;
          slLogs.Add(strRec);
        end;
      end;
    end;
    slLogs.SaveToFile(AFileName);
  finally
    slLogs.Free;
    V.Free;
    F.Free;
  end;
end;

procedure TsdOperationManager.RenameCurrentItem(AName: string);
var
  Item: TsdOperationItem;
begin
  if FSnapShooting then Exit;
  if FItems.Count = 0 then Exit;
  Item := FItems[FItems.Count - 1];
  Item.FName := AName;
end;

procedure TsdOperationManager.Reset;
begin
  // 防止出错
  EndSnapShoot;
  ClearNewerItems;
end;

procedure TsdOperationManager.ResetWhenNecessary;
begin
  if FSavePoint < NewID then
    Reset;
end;

procedure TsdOperationManager.Cancel;
var
  Item: TsdOperationItem;
begin
  // 防止出错
  EndSnapShoot;
  if not FNeedConfirmSnapShoot then Exit;
  FNeedConfirmSnapShoot := False;
  // 取消则删除当前操作
  if FItems.Count = 0 then Exit;
  Item := FItems[FItems.Count - 1];
  // 撤销
  Item.Undo;
  // 删除本操作
  FItems.Remove(Item);
  Item.ClearNewerHistoryRecord;
  Item.Free;
  FSavePoint := NewID;
end;

procedure TsdOperationManager.Confirm;
var
  Item: TsdOperationItem;
begin
  EndSnapShoot;
  if not FNeedConfirmSnapShoot then Exit;
  FNeedConfirmSnapShoot := False;
  // 确认则清除超出限制的旧操作
  while FItems.Count > FLimitedCount do
  begin
    Item := FItems[0];
    Item.Free;
    FItems.Delete(0);
    // 清理旧的Item中记录的需要删除的DataRecord
    Item := FItems[0];
    if Item <> nil then
      Item.ClearOlderHistoryRecord;
  end;
end;

procedure TsdOperationManager.BeginSnapShoot;
begin
  if not Active then Exit;
  FSnapShooting := True;
end;

procedure TsdOperationManager.Resume;
var
  I: Integer;
  sdsData: TsdDataSet;
begin
  for I := 0 to DataSetCount - 1 do
  begin
    sdsData := DataSet[I];
    sdsData.FHistory.Resume;
  end;
end;

procedure TsdOperationManager.Suspend;
var
  I: Integer;
  sdsData: TsdDataSet;
begin
  for I := 0 to DataSetCount - 1 do
  begin
    sdsData := DataSet[I];
    sdsData.FHistory.Suspend;
  end;
end;

procedure TsdOperationManager.SetActive(const Value: Boolean);
begin
  FActive := Value;
end;

procedure TsdOperationManager.SetAfterRedo(
  const Value: TsdOperationAfterEvent);
begin
  FAfterRedo := Value;
end;

procedure TsdOperationManager.SetAfterUndo(
  const Value: TsdOperationAfterEvent);
begin
  FAfterUndo := Value;
end;

procedure TsdOperationManager.SetBeforeRedo(
  const Value: TsdOperationBeforeEvent);
begin
  FBeforeRedo := Value;
end;

procedure TsdOperationManager.SetBeforeUndo(
  const Value: TsdOperationBeforeEvent);
begin
  FBeforeUndo := Value;
end;

procedure TsdOperationManager.DoAfterRedo(AItem: TsdOperationItem);
begin
  if Assigned(FAfterRedo) then
    FAfterRedo(AItem);
end;

procedure TsdOperationManager.DoAfterUndo(AItem: TsdOperationItem);
begin
  if Assigned(FAfterUndo) then
    FAfterUndo(AItem);
end;

procedure TsdOperationManager.DoBeforeRedo(AItem: TsdOperationItem;
  var CanDo: Boolean);
begin
  if Assigned(FBeforeRedo) then
    FBeforeRedo(AItem, CanDo);
end;

procedure TsdOperationManager.DoBeforeUndo(AItem: TsdOperationItem;
  var CanDo: Boolean);
begin
  if Assigned(FBeforeUndo) then
    FBeforeUndo(AItem, CanDo);
end;

function TsdOperationManager.GetModified: Boolean;
var
  I: Integer;
  DataSet: TsdDataSet;
begin
  Result := False;
  for I := 0 to FDataSets.Count - 1 do
  begin
    DataSet := TsdDataSet(FDataSets[I]);
    if DataSet.Modified then
    begin
      Result := True;
      Break;
    end;
  end;
end;

{ TsdOperationItem }

procedure TsdOperationItem.SnapShoot;
var
  I: Integer;
  sdsData: TsdDataSet;
  pInfo: PsdHistoryInfo;
begin
  for I := 0 to FOwner.DataSetCount - 1 do
  begin
    sdsData := FOwner.DataSet[I];
    New(pInfo);
    pInfo^.DataSet := sdsData;
    pInfo^.StartPoint := sdsData.SavePoint;
    pInfo^.EndPoint := -1;
    // 开始新操作，清理所有新操作记录
    sdsData.FHistory.ClearNewerRecord(sdsData.SavePoint);
    FInfos.Add(pInfo);
  end;
end;

constructor TsdOperationItem.Create(AOwner: TsdOperationManager; AID: Integer; AName: string);
begin
  FOwner := AOwner;
  FID := AID;
  FName := AName;
  FInfos := TList.Create;
end;

destructor TsdOperationItem.Destroy;
begin
  Clear;
  FInfos.Free;
  inherited;
end;

procedure TsdOperationItem.Clear;
var
  I: Integer;
  pInfo: PsdHistoryInfo;
begin
  for I := 0 to FInfos.Count - 1 do
  begin
    pInfo := PsdHistoryInfo(FInfos[I]);
    Dispose(pInfo);
  end;
  FInfos.Clear;
end;

procedure TsdOperationItem.Redo;
var
  I: Integer;
  sdsData: TsdDataSet;
  pInfo: PsdHistoryInfo;
  bCanDo: Boolean;
begin
  bCanDo := True;
  FOwner.DoBeforeRedo(Self, bCanDo);
  if bCanDo then
  begin
    try
      for I := 0 to FInfos.Count - 1 do
      begin
        pInfo := PsdHistoryInfo(FInfos[I]);
        sdsData := pInfo^.DataSet;
        sdsData.Redo(pInfo^.EndPoint);
      end;
    finally
      FOwner.DoAfterRedo(Self);
    end;
  end;
end;

procedure TsdOperationItem.Undo;
var
  I: Integer;
  sdsData: TsdDataSet;
  pInfo: PsdHistoryInfo;
  bCanDo: Boolean;
begin
  bCanDo := True;
  FOwner.DoBeforeUndo(Self, bCanDo);
  if bCanDo then
  begin
    try
      for I := 0 to FInfos.Count - 1 do
      begin
        pInfo := PsdHistoryInfo(FInfos[I]);
        sdsData := pInfo^.DataSet;
        sdsData.Undo(pInfo^.StartPoint);
      end;
    finally
      FOwner.DoAfterUndo(Self);
    end;
  end;
end;

procedure TsdOperationItem.EndSnap;
var
  I: Integer;
  sdsData: TsdDataSet;
  pInfo: PsdHistoryInfo;
begin
  for I := FInfos.Count - 1 downto 0 do
  begin
    pInfo := PsdHistoryInfo(FInfos[I]);
    sdsData := pInfo^.DataSet;
    // 如果StartPoint=EndPoint，说明这次操作中该DataSet没有变化，删掉
    if pInfo^.StartPoint = sdsData.SavePoint then
      FInfos.Delete(I)
    else
      pInfo^.EndPoint := sdsData.SavePoint;
  end;
end;

procedure TsdOperationItem.ClearOlderHistoryRecord;
var
  I: Integer;
  sdsData: TsdDataSet;
  pInfo: PsdHistoryInfo;
begin
  for I := 0 to FInfos.Count - 1 do
  begin
    pInfo := FInfos[I];
    sdsData := pInfo^.DataSet;
    sdsData.FHistory.ClearOlderRecord(pInfo^.StartPoint);
  end;
end;

procedure TsdOperationItem.ClearNewerHistoryRecord;
var
  I: Integer;
  sdsData: TsdDataSet;
  pInfo: PsdHistoryInfo;
begin
  for I := 0 to FInfos.Count - 1 do
  begin
    pInfo := FInfos[I];
    sdsData := pInfo^.DataSet;
    sdsData.FHistory.ClearNewerRecord(pInfo^.StartPoint);
  end;
end;

{ TsdHistoryList }

procedure TsdHistoryList.Add(ARecord: TsdDataRecord);
var
  HistoryRec: TsdHistoryRecord;
begin
  if IsUpdatingRecord then
    raise EsdHistory.Create('添加操作不支持批量处理');
  // 若OperationManager.SavePiont不是最新则Reset
  FDataSet.OperationManager.ResetWhenNecessary;
  HistoryRec := TsdHistoryRecord.Create(Self);
  HistoryRec.FID := LastID + 1;
  FRecList.Add(HistoryRec);
  HistoryRec.Add(ARecord);
  FSavePoint := HistoryRec.FID + 1;
end;

procedure TsdHistoryList.BeginAdd;
begin
  FAdding := True;
end;

procedure TsdHistoryList.BeginRecordUpdate(ARecord: TsdDataRecord);
var
  HistoryRec: TsdHistoryRecord;
begin
  // 若OperationManager.SavePiont不是最新则Reset
  FDataSet.OperationManager.ResetWhenNecessary;
  Inc(FUpdateRecordLock);
  HistoryRec := TsdHistoryRecord.Create(Self);
  HistoryRec.FID := LastID + 1;
  HistoryRec.FRec := ARecord;
  FRecList.Add(HistoryRec);
  FSavePoint := HistoryRec.FID + 1;
end;

procedure TsdHistoryList.Clear;
var
  I: Integer;
begin
  ClearAllDataRecords;
  for I := 0 to FRecList.Count - 1 do
    TsdHistoryRecord(FRecList[I]).Free;
  FRecList.Clear;
end;

// 清除新的记录，包括自己
procedure TsdHistoryList.ClearNewerRecord(AID: Integer);
var
  I, iIdx: Integer;
  Rec: TsdHistoryRecord;
begin
  iIdx := IndexByID(AID);
  if iIdx < 0 then Exit;
  for I := FRecList.Count - 1 downto iIdx do
  begin
    Rec := TsdHistoryRecord(FRecList[I]);
    FRecList.Delete(I);
    // 新增操作、且是新增记录或已保存过的删除记录，FRec才释放
    if (Rec.Operation = sroAdd) and (Rec.FRec.New or (FDataSet.FDeletedList.IndexOf(Rec.FRec) < 0)) and Rec.FNeedFreeCheck then
      Rec.FRec.Free;
    Rec.Free;
  end;
end;

// 清除旧的记录，不包括自己
procedure TsdHistoryList.ClearOlderRecord(AID: Integer);
var
  I, iIdx: Integer;
  Rec: TsdHistoryRecord;
begin
  iIdx := IndexByID(AID);
  if iIdx < 0 then Exit;
  for I := iIdx - 1 downto 0 do
  begin
    Rec := TsdHistoryRecord(FRecList[I]);
    FRecList.Delete(I);
    // 删除操作、且是新增记录或已保存过的删除记录，FRec才释放
    if (Rec.Operation = sroDelete) and (Rec.FRec.New or (FDataSet.FDeletedList.IndexOf(Rec.FRec) < 0)) and Rec.FNeedFreeCheck then
      Rec.FRec.Free;
    Rec.Free;
  end;
end;

constructor TsdHistoryList.Create(ADataSet: TsdDataSet);
begin
  FDataSet := ADataSet;
  FRecList := TList.Create;
  FLastHistoryRecords := TList.Create;
  FSavePoint := 0;
  FUpdateRecordLock := 0;
  FAdding := False;
  FStopping := 0;
end;

procedure TsdHistoryList.Delete(ARecord: TsdDataRecord);
var
  HistoryRec: TsdHistoryRecord;
begin
  if IsUpdatingRecord then
    raise EsdHistory.Create('删除操作不支持批量处理');
  // 若OperationManager.SavePiont不是最新则Reset
  if FDataSet.OperationManager <> nil then
    FDataSet.OperationManager.ResetWhenNecessary;
  HistoryRec := TsdHistoryRecord.Create(Self);
  HistoryRec.FID := LastID + 1;
  FRecList.Add(HistoryRec);
  HistoryRec.Delete(ARecord);
  FSavePoint := HistoryRec.FID + 1;
end;

destructor TsdHistoryList.Destroy;
var
  I: Integer;
begin
  Clear;
  FRecList.Free;
  for I := 0 to FLastHistoryRecords.Count - 1 do
    TsdHistoryRecord(FLastHistoryRecords[I]).Free;
  FLastHistoryRecords.Free;
  inherited;
end;

procedure TsdHistoryList.EndAdd;
begin
  FAdding := False;
end;

procedure TsdHistoryList.EndRecordUpdate;
begin
  if FUpdateRecordLock > 0 then
    Dec(FUpdateRecordLock);
end;

function TsdHistoryList.IndexByID(AID: Integer): Integer;
var
  I: Integer;
  HistoryRec: TsdHistoryRecord;
begin
  Result := -1;
  for I := 0 to FRecList.Count - 1 do
  begin
    HistoryRec := TsdHistoryRecord(FRecList[I]);
    if AID = HistoryRec.ID then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TsdHistoryList.GetSavePoint: Integer;
begin
  // SavePoint是当前值，所以在历史记录中还不存在
  Result := FSavePoint;
end;

function TsdHistoryList.IsUpdatingRecord: Boolean;
begin
  Result := FUpdateRecordLock > 0;
end;

function TsdHistoryList.LastID: Integer;
var
  HistoryRec: TsdHistoryRecord;
begin
  Result := -1;
  if FRecList.Count > 0 then
  begin
    HistoryRec := TsdHistoryRecord(FRecList.Last);
    Result := HistoryRec.ID;
  end;
end;

procedure TsdHistoryList.Modify(AValue: TsdValue);
var
  HistoryRec: TsdHistoryRecord;
begin
  // 插入记录未完成，前面的操作无需记录
  if FAdding then Exit;
  if IsUpdatingRecord then
  begin
    HistoryRec := TsdHistoryRecord(FRecList.Last);
    if HistoryRec.FRec <> AValue.Owner then
      raise EsdHistory.Create('Can update 2 record once');
  end
  else
  begin
    // 若OperationManager.SavePiont不是最新则Reset
    FDataSet.OperationManager.ResetWhenNecessary;
    HistoryRec := TsdHistoryRecord.Create(Self);
    HistoryRec.FID := LastID + 1;
    HistoryRec.FRec := AValue.Owner;
    FRecList.Add(HistoryRec);
    FSavePoint := HistoryRec.FID + 1;
  end;
  HistoryRec.Modify(AValue);
end;

procedure TsdHistoryList.Redo(AID: Integer);

  function FindDelRec(AIndex: Integer; CurRec: TsdDataRecord): TsdDataRecord;
  var
    I: Integer;
    HRec: TsdHistoryRecord;
  begin
    Result := nil;
    for I := AIndex to FRecList.Count - 1 do
    begin
      HRec := TsdHistoryRecord(FRecList[I]);
      if HRec.ID > AID then
        Break;
      if (HRec.Operation = sroDelete) and (CurRec = HRec.FRec) then
      begin
        Result := HRec.FRec;
        Break;
      end;
    end;
  end;

var
  I: Integer;
  HistoryRec: TsdHistoryRecord;
  AddRec, DelRec: TsdDataRecord;
begin
  if (AID < 0) or (AID - 1 > LastID) then Exit;
  AddLog(Format('DataSet: %s; SavePoint: %d',  [DataSet.Name, DataSet.SavePoint]));
  Suspend;
  try
    AddRec := nil;
    DelRec := nil;
    // 1,2,3,4,5  SavePoint = 2, Redo到4, 执行操作集3、4 Redo, SavePoint = 5
    for I := 0 to FRecList.Count - 1 do
    begin
      HistoryRec := TsdHistoryRecord(FRecList[I]);
      // 注意DataSet.SavePoint最新值都是虚拟值，所以这里不能等于目标值，要小于
      if (HistoryRec.ID < AID) and (HistoryRec.ID >= FSavePoint) then
      begin
        // Delete操作前面的全部略过，因为Redo直接删除记录就好了
        DelRec := FindDelRec(I, HistoryRec.FRec);
        // Add操作的Rec要传入Redo
        if HistoryRec.Operation = sroAdd then
          AddRec := HistoryRec.FRec;
        // 1.add操作的undo不会改动记录，所以add操作后面的操作可以略过
        // 2.del操作前面的操作全部略过，redo直接删除就好了
        // 2023/10/24 暂屏蔽，不一步步全部Undo的话，LastValue缓存不全，对应Redo也要一步步全部操作
        //if (not ((AddRec <> nil) and (AddRec = HistoryRec.FRec) and (HistoryRec.Operation = sroModify)))
        //  and (not ((DelRec <> nil) and (DelRec = HistoryRec.FRec) and (HistoryRec.Operation = sroModify))) then
        begin
          HistoryRec.Redo(AddRec);
          if HistoryRec.ID = AID - 1 then
          begin
            FSavePoint := AID;
            Break;
          end;
        end;
      end;
    end;
  finally
    Resume;
    DataSet.FKeepPosition := True;
    try
      DataSet.NotifyChanged(nil, sdoReset);
    finally
      DataSet.FKeepPosition := False;
    end;
  end;
end;

procedure TsdHistoryList.SetSavePoint(const Value: Integer);
begin
  Undo(Value);
end;

procedure TsdHistoryList.Undo(AID: Integer);

  function FindAddRec(AIndex: Integer): TsdDataRecord;
  var
    I: Integer;
    HRec: TsdHistoryRecord;
  begin
    Result := nil;
    for I := AIndex downto 0 do
    begin
      HRec := TsdHistoryRecord(FRecList[I]);
      if HRec.ID < AID then
        Break;
      if HRec.Operation = sroAdd then
      begin
        Result := HRec.FRec;
        Break;
      end;
    end;
  end;

var
  I: Integer;
  HistoryRec: TsdHistoryRecord;
  Rec: TsdDataRecord;
begin
  if (AID < 0) or (AID > LastID) then Exit;
  Suspend;
  AddLog(Format('DataSet: %s; SavePoint: %d',  [DataSet.Name, DataSet.SavePoint]));
  try
    // 1,2,3,4,5  SavePoint = 4, Undo到2, 执行操作集3、2 Undo, SavePoint = 3
    for I := FRecList.Count - 1 downto 0 do
    begin
      HistoryRec := TsdHistoryRecord(FRecList[I]);
      if (HistoryRec.ID >= AID) and (HistoryRec.ID < FSavePoint) then
      begin
        // 最新的undo前要清空LastRecords;
        if I = FRecList.Count - 1 then
          ClearLastRecords;
        // 2025/03/4 找到Add操作的记录传入HistoryRec.Undo，在里面Add操作后面的全部略过，因为Undo直接删除记录就好了
        // 但是LastValue仍要一步步缓存，以便Redo时读取
        Rec := FindAddRec(I);
        HistoryRec.Undo(Rec);
        if HistoryRec.ID = AID then
        begin
          FSavePoint := AID;
          Break;
        end;
      end;
    end;
  finally
    Resume;
    DataSet.FKeepPosition := True;
    try
      DataSet.NotifyChanged(nil, sdoReset);
    finally
      DataSet.FKeepPosition := False;
    end;
  end;
end;

procedure TsdHistoryList.ClearAllDataRecords;
var
  I: Integer;
  Rec: TsdHistoryRecord;
begin
  for I := 0 to FRecList.Count - 1 do
  begin
    Rec := TsdHistoryRecord(FRecList[I]);
    if Rec.FRec <> nil then
    begin
      // 释放条件：1.如果不是关闭DataSet的过程中，则所有删除操作的记录都释放；
      //           2.如果是关闭DataSet的过程中，且是新增记录，FRec才释放
      // 因为关闭DataSet时会释放除新增记录外所有删除的记录，而正常保存不会先释放任何记录
      if (Rec.Operation = sroDelete) and (FDataSet.Active or (FDataSet.FDeletedList.IndexOf(Rec.FRec) < 0) or Rec.FRec.New) then
        Rec.FRec.Free;
    end;
  end;
end;

function TsdHistoryList.FindLastRecord(ARecord: TsdDataRecord): TsdHistoryRecord;
var
  I: Integer;
begin
  // 先查找FLastHistoryRecords中是否有对应记录
  Result := nil;
  for I := 0 to FLastHistoryRecords.Count - 1 do
  begin
    if TsdHistoryRecord(FLastHistoryRecords[I]).FRec = ARecord then
    begin
      Result := TsdHistoryRecord(FLastHistoryRecords[I]);
      Break;
    end;
  end;
end;

procedure TsdHistoryList.CacheLastRecord(AValue: TsdValue);
var
  I, J: Integer;
  HRec: TsdHistoryRecord;
begin
  // 先查找FLastHistoryRecords中是否有对应记录
  HRec := FindLastRecord(AValue.Owner);
  if HRec <> nil then
  begin
    // 已Cache过的退出
    if HRec.FindValue(AValue) <> nil then
      Exit;
  end
  else
  begin
    // TsdHistoryRecord.Create的参数仅在Undo/Redo中使用，所以这里可以为nil
    HRec := TsdHistoryRecord.Create(nil);
    FLastHistoryRecords.Add(HRec);
  end;
  HRec.Modify(AValue);
end;

procedure TsdHistoryList.CopyLastValue(AID: Integer;
  AValue: TsdValue);
var
  I: Integer;
  HRec: TsdHistoryRecord;
  bHasValue: Boolean;
  V: TsdHistoryValue;
begin
  bHasValue := False;
  // 先检查AID以后的记录中有没有缓存该值，有则用此值Redo
  for I := 0 to FRecList.Count - 1 do
  begin
    HRec := FRecList[I];
    if (HRec.FRec = AValue.Owner) and (HRec.ID > AID) then
    begin
      V := HRec.FindValue(AValue);
      if V <> nil then
      begin
        V.CopyTo(AValue);
        bHasValue := True;
        Break;
      end;
    end;
  end;
  // 没有则用LastRecord的缓存Redo, Redo完删除
  if not bHasValue then
  begin
    HRec := FindLastRecord(AValue.Owner);
    // 找不到则说明前面Undo时没有正确缓存LastRecord，报错
    if not Assigned(HRec) then
      raise EsdHistory.Create('Can not find last record after undo');
    V := HRec.FindValue(AValue);
    V.CopyTo(AValue);
    HRec.RemoveValue(AValue);
    if HRec.Count = 0 then
      FLastHistoryRecords.Remove(HRec);
  end;
end;

function TsdHistoryList.FindLastValue(AValue: TsdValue): TsdHistoryValue;
var
  I, J: Integer;
  HRec: TsdHistoryRecord;
begin
  for I := 0 to FLastHistoryRecords.Count - 1 do
  begin
    HRec := FLastHistoryRecords[I];
    if HRec.FRec = AValue.Owner then
    begin
      Result := HRec.FindValue(AValue);
      Break;
    end;
  end;
end;

function TsdHistoryList.FindByRecord(
  ARecord: TsdDataRecord): TsdHistoryRecord;
var
  I: Integer;
  HRec: TsdHistoryRecord;
begin
  Result := nil;
  for I := 0 to FRecList.Count - 1 do
  begin
    HRec := FRecList[I];
    if HRec.FRec = ARecord then
    begin
      Result := HRec;
      Break;
    end;
  end;
end;

procedure TsdHistoryList.ClearLastRecords;
var
  I: Integer;
begin
  for I := 0 to FLastHistoryRecords.Count - 1 do
    TsdHistoryRecord(FLastHistoryRecords[I]).Free;
  FLastHistoryRecords.Clear;
end;

function TsdHistoryList.GetStopping: Boolean;
begin
  Result := ((FDataSet.OperationManager = nil) or FDataSet.OperationManager.Active) and (FStopping > 0);
end;

procedure TsdHistoryList.Resume;
begin
  if FStopping = 0 then
    Exit
  else
    Dec(FStopping);
end;

procedure TsdHistoryList.Suspend;
begin
  Inc(FStopping);
end;

procedure TsdHistoryList.WriteHistoryData(AOperation: TsdOperation; AObject: IsdHistoryObject; AData: Pointer);
var
  HistoryRec: TsdHistoryRecord;
begin
  if IsUpdatingRecord then
    raise EsdHistory.Create('外部记录操作不支持批量处理');
  // 若OperationManager.SavePiont不是最新则Reset
  FDataSet.OperationManager.ResetWhenNecessary;
  HistoryRec := TsdHistoryRecord.Create(Self);
  HistoryRec.FID := LastID + 1;
  FRecList.Add(HistoryRec);
  HistoryRec.FHistoryObject := AObject;
  HistoryRec.FData := AData;
  HistoryRec.Operation := AOperation;             
  FSavePoint := HistoryRec.FID + 1;
end;

{ TsdHistoryRecord }

procedure TsdHistoryRecord.Add(ARecord: TsdDataRecord);
begin
  FOperation := sroAdd;
  // 新增时缓存新增的记录，以便Rollback时删除
  FRec := ARecord;
  FModified := False;
end;

constructor TsdHistoryRecord.Create(AOwner: TsdHistoryList);
begin
  FID := -1;
  FRec := nil;
  FHistoryObject := nil;
  FData := nil;
  FOwner := AOwner;
  FValueList := TList.Create;
  // 仅用sdoActive作为初始值
  FOperation := sdoActive;
  FModified := False;
  FNeedFreeCheck := False;
end;

procedure TsdHistoryRecord.Delete(ARecord: TsdDataRecord);
begin
  FOperation := sroDelete;
  // 删除时缓存删除前的记录，注意DataSet中不能释放
  FRec := ARecord;
  FModified := ARecord.Modified;
end;

destructor TsdHistoryRecord.Destroy;
var
  I: Integer;
begin
  for I := 0 to FValueList.Count - 1 do
    TsdHistoryValue(FValueList[I]).Free;
  FValueList.Free;
  if Assigned(FHistoryObject) then
    FHistoryObject := nil;
  if Assigned(FData) then
    Dispose(FData);
  inherited;
end;

function TsdHistoryRecord.FindValue(AValue: TsdValue): TsdHistoryValue;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FValueList.Count - 1 do
  begin
    if SameText(AValue.FieldName, Values[I].FieldName) then
    begin
      Result := Values[I];
      Break;
    end;
  end;
end;

function TsdHistoryRecord.GetCount: Integer;
begin
  Result := FValueList.Count;
end;

function TsdHistoryRecord.GetValues(I: Integer): TsdHistoryValue;
begin
  Result := TsdHistoryValue(FValueList[I]);
end;

procedure TsdHistoryRecord.Modify(AValue: TsdValue);
var
  Item: TsdHistoryValue;
begin
  if FOperation = sdoActive then
    FOperation := sroModify;
  Item := FindValue(AValue);
  if Item = nil then
  begin
    Item := TsdHistoryValue.Create;
    FValueList.Add(Item);
    if not Assigned(FRec) then
      FRec := AValue.Owner;
  end;
  Item.CopyFrom(AValue);
  FModified := AValue.Owner.Modified;
end;

procedure TsdHistoryRecord.Redo(ADataRecord: TsdDataRecord);
var
  DataSet: TsdDataSet;
  iIndex, I: Integer;
  CacheValue: TsdHistoryValue;
  DataValue: TsdValue;
  slstFields: TStringList;
  CanDo: Boolean;
begin
  DataSet := FOwner.DataSet;
  CanDo := True;
  if Assigned(DataSet.FOperationManager) then
  begin
    DataSet.FOperationManager.DoDataSetBeforeRedo(DataSet, FRec, FOperation, ADataRecord, nil, FData, CanDo);
    if not CanDo then
      Exit;
  end;
  if FHistoryObject = nil then
  begin
    case FOperation of
      sroAdd:
      begin
        // 插入到正确的位置
        if (FRec.FIndex >= 0) and (FRec.FIndex <= DataSet.RecordCount) then
          DataSet.FDataList.Insert(FRec.FIndex, FRec)
        else
          FRec.FIndex := DataSet.FDataList.Add(FRec);
        // 计算索引
        FRec.ForceNotifyIndex;
        DataSet.CheckIndex(FRec);
        // 从FDeletedList中删除
        DataSet.FDeletedList.Remove(FRec);
        if FRec.ValueByName('ID') <> nil then
          AddLog(Format('  Add: ID=%s', [FRec.ValueByName('ID').AsString]))
        else if FRec.ValueByName('GLJID') <> nil then
          AddLog(Format('  Add: GLJID=%s', [FRec.ValueByName('GLJID').AsString]))
        else
          AddLog('  Add: ID=-1');

        if Assigned(DataSet.FOperationManager) then
          DataSet.FOperationManager.DoDataSetAfterRedo(DataSet, FRec, FOperation, nil, nil, nil);
      end;
      sroDelete:
      begin
        iIndex := DataSet.FDataList.IndexOf(FRec);
        if iIndex < 0 then
          raise EsdDataSet.Create(Format('Redo delete record error: Error index is %d', [FRec.FIndex]));
        if FRec.ValueByName('ID') <> nil then
          AddLog(Format('  Delete: ID=%s', [FRec.ValueByName('ID').AsString]))
        else if FRec.ValueByName('GLJID') <> nil then
          AddLog(Format('  Delete: GLJID=%s', [FRec.ValueByName('GLJID').AsString]))
        else
          AddLog('  Add: ID=-1');
      
        DataSet.FDataList.Remove(FRec);
        // 删除记录相关的索引信息
        DataSet.DeleteRecordIndex(FRec);
        DataSet.RenumberIndex(iIndex);
        // 从FChangedList中删除
        DataSet.FChangedList.Remove(FRec);
        // 检查FDeletedList
        if (not FRec.New) and (DataSet.FDeletedList.IndexOf(FRec) < 0) then
          DataSet.FDeletedList.Add(FRec);
        if Assigned(DataSet.FOperationManager) then
          DataSet.FOperationManager.DoDataSetAfterRedo(DataSet, FRec, FOperation, nil, nil, nil);
        FNeedFreeCheck := True;
      end;
      sroModify:
      begin
        slstFields := TStringList.Create;
        try
          for I := 0 to FValueList.Count - 1 do
          begin
            CacheValue := TsdHistoryValue(FValueList[I]);
            DataValue := FRec.ValueByName(CacheValue.FieldName);
            slstFields.Add(CacheValue.FFieldName);
            if DataValue = nil then
              raise EsdHistory.Create(Format('Can not find Field "%s"', [CacheValue.FieldName]));
            // 获取新值
            FOwner.CopyLastValue(FID, DataValue);
            if FRec.ValueByName('ID') <> nil then
              AddLog(Format('  Modify: Count=%d; I=%d; ID=%d; %s=%s', [FValueList.Count, I, DataValue.Owner.ValueByName('ID').AsInteger, DataValue.FieldName, DataValue.AsString]))
            else if FRec.ValueByName('GLJID') <> nil then
              AddLog(Format('  Modify: Count=%d; I=%d; ID=%d; %s=%s', [FValueList.Count, I, DataValue.Owner.ValueByName('GLJID').AsInteger, DataValue.FieldName, DataValue.AsString]))
            else
              AddLog(Format('  Modify: Count=%d; I=%d; ID=%d; %s=%s', [FValueList.Count, I, -1, DataValue.FieldName, DataValue.AsString]));
          
            // 处理变化
            FRec.NotifyIndex(DataValue);
            FRec.FOwner.CheckIndex(FRec);
            FRec.FOwner.NotifyChanged(DataValue, sroModify);
            FRec.NotifyLookup(DataValue.Field);
            if DataSet.FChangedList.IndexOf(FRec) < 0 then
              DataSet.FChangedList.Add(FRec);
          end;
          if Assigned(DataSet.FOperationManager) then
            DataSet.FOperationManager.DoDataSetAfterRedo(DataSet, FRec, FOperation, ADataRecord, slstFields, nil);
        finally
          slstFields.Free;
        end;
      end;
    end;
  end
  else
  begin
    FHistoryObject.Undo(FData);
    if Assigned(DataSet.FOperationManager) then
      DataSet.FOperationManager.DoDataSetAfterRedo(DataSet, FRec, FOperation, ADataRecord, slstFields, FData);
  end;
end;

procedure TsdHistoryRecord.RemoveValue(AValue: TsdValue);
var
  I: Integer;
  V: TsdHistoryValue;
begin
  for I := 0 to FValueList.Count - 1 do
  begin
    V := FValueList[I];
    if SameText(AValue.FieldName, V.FieldName) then
    begin
      FValueList.Remove(V);
      Break;
    end;
  end;
end;

procedure TsdHistoryRecord.Undo(ADataRecord: TsdDataRecord);
var
  DataSet: TsdDataSet;
  iIndex, I: Integer;
  CacheValue: TsdHistoryValue;
  DataValue: TsdValue;
  slstFields: TStringList;
  Cando: Boolean;
begin
  DataSet := FOwner.DataSet;
  Cando := True;
  if Assigned(DataSet.FOperationManager) then
  begin
    DataSet.FOperationManager.DoDataSetBeforeUndo(DataSet, FRec, FOperation, ADataRecord, nil, FData, Cando);
    if not Cando then
      Exit;
  end;

  if FHistoryObject = nil then
  begin
    case FOperation of
      sroAdd:
      begin
        iIndex := DataSet.FDataList.IndexOf(FRec);
        if iIndex < 0 then
          raise EsdDataSet.Create(Format('Undo add record error: Error index is %d', [FRec.FIndex]));
        DataSet.FDataList.Remove(FRec);
        // 删除记录相关的索引信息
        DataSet.DeleteRecordIndex(FRec);
        DataSet.RenumberIndex(iIndex);
        // 从FChangedList中删除
        DataSet.FChangedList.Remove(FRec);
        // 检查FDeletedList
        if (not FRec.New) and (DataSet.FDeletedList.IndexOf(FRec) < 0) then
          DataSet.FDeletedList.Add(FRec);

        if FRec.ValueByName('ID') <> nil then
          AddLog(Format('  Add: ID=%s', [FRec.ValueByName('ID').AsString]))
        else if FRec.ValueByName('GLJID') <> nil then
          AddLog(Format('  Add: GLJID=%s', [FRec.ValueByName('GLJID').AsString]))
        else
          AddLog('  Add: ID=-1');

        if Assigned(DataSet.FOperationManager) then
          DataSet.FOperationManager.DoDataSetAfterUndo(DataSet, FRec, FOperation, nil, nil, nil);
        // 增减必须立即通知DataView
        //DataSet.NotifyChanged(FRec, sroDelete);
        // 因为是新增记录，直接释放 // 改到清理时释放
        FNeedFreeCheck := True;
        //FreeAndNil(FRec);
      end;
      sroDelete:
      begin
        // 插入到正确的位置
        if (FRec.FIndex >= 0) and (FRec.FIndex <= DataSet.RecordCount) then
          DataSet.FDataList.Insert(FRec.FIndex, FRec)
        else
          FRec.FIndex := DataSet.FDataList.Add(FRec);

        if FRec.ValueByName('ID') <> nil then
          AddLog(Format('  Delete: ID=%s', [FRec.ValueByName('ID').AsString]))
        else if FRec.ValueByName('GLJID') <> nil then
          AddLog(Format('  Delete: GLJID=%s', [FRec.ValueByName('GLJID').AsString]))
        else
          AddLog('  Add: ID=-1');

        // 计算索引
        FRec.ForceNotifyIndex;
        DataSet.CheckIndex(FRec);
        // 回滚后从FDeletedList删除本记录
        if DataSet.FDeletedList.IndexOf(FRec) >= 0 then
          DataSet.FDeletedList.Remove(FRec);
        // 保存过再撤销删除，要重新将整条记录设置为新记录，才能正常保存
        if DataSet.SavedPoint > ID then
        begin
          FRec.FNew := True;
          DataSet.FChangedList.Add(FRec);
          for I := 0 to FRec.Count - 1 do
            if FRec.FChangedValueList.IndexOf(FRec[I]) < 0 then
              FRec.FChangedValueList.Add(FRec[I]);
        end
        // 未保存就撤销删除，需要检查是否需要重新添加到FChangedList
        else if FModified and (DataSet.FChangedList.IndexOf(FRec) < 0) then
          DataSet.FChangedList.Add(FRec);
        // 增减必须立即通知DataView
        //DataSet.NotifyChanged(FRec, sroAdd);
        if Assigned(DataSet.FOperationManager) then
          DataSet.FOperationManager.DoDataSetAfterUndo(DataSet, FRec, FOperation, nil, nil, nil);
        //FRec := nil;
      end;
      sroModify:
      begin
        slstFields := TStringList.Create;
        try
          for I := 0 to FValueList.Count - 1 do
          begin
            CacheValue := TsdHistoryValue(FValueList[I]);
            DataValue := FRec.ValueByName(CacheValue.FieldName);
            // 缓存LastValue以备Redo
            FOwner.CacheLastRecord(DataValue);
            // -------------------2025-03-04 zhangyin-------------------------//
            // ADataRecord <> nil表示正在撤销Add记录的操作，所以这里只需缓存原值以备Redo，无需进行undo操作。
            // 原因：新添加的记录值都是null，如果撤销会导致ID也变成null，这样在保存时无法根据ID找到这条记录，无法正确删除这条记录
            // -------------------2025-03-04 zhangyin-------------------------//
            if (ADataRecord = nil) or (ADataRecord <> FRec) then
            begin
              slstFields.Add(CacheValue.FFieldName);
              if DataValue = nil then
                raise EsdHistory.Create(Format('Can not find Field "%s"', [CacheValue.FieldName]));
              CacheValue.CopyTo(DataValue);

              if FRec.ValueByName('ID') <> nil then
                AddLog(Format('  Modify: Count=%d; I=%d; ID=%d; %s=%s', [FValueList.Count, I, DataValue.Owner.ValueByName('ID').AsInteger, DataValue.FieldName, DataValue.AsString]))
              else if FRec.ValueByName('GLJID') <> nil then
                AddLog(Format('  Modify: Count=%d; I=%d; ID=%d; %s=%s', [FValueList.Count, I, DataValue.Owner.ValueByName('GLJID').AsInteger, DataValue.FieldName, DataValue.AsString]))
              else
                AddLog(Format('  Modify: Count=%d; I=%d; ID=%d; %s=%s', [FValueList.Count, I, -1, DataValue.FieldName, DataValue.AsString]));


              // 处理变化
              FRec.NotifyIndex(DataValue);
              FRec.FOwner.CheckIndex(FRec);
              FRec.FOwner.NotifyChanged(DataValue, sroModify);
              FRec.NotifyLookup(DataValue.Field);
              // 保存过再撤销
              if DataSet.SavedPoint > ID then
              begin
                // 需要重新加入ChangedList
                if DataSet.FChangedList.IndexOf(FRec) < 0 then
                  DataSet.FChangedList.Add(FRec);
                // 将Value重新加入FChangedValueList
                if FRec.FChangedValueList.IndexOf(DataValue) < 0 then
                  FRec.FChangedValueList.Add(DataValue);
              end
              // 未保存过，检查是否需要从FChangedList中删除
              else if not FModified then
                DataSet.FChangedList.Remove(FRec);
            end;
          end;
          if (ADataRecord = nil) and Assigned(DataSet.FOperationManager) then
            DataSet.FOperationManager.DoDataSetAfterUndo(DataSet, FRec, FOperation, ADataRecord, slstFields, nil);
        finally
          slstFields.Free;
        end;
      end;
    end;
  end
  else
  begin
    FHistoryObject.Undo(FData);
    if Assigned(DataSet.FOperationManager) then
      DataSet.FOperationManager.DoDataSetAfterUndo(DataSet, FRec, FOperation, ADataRecord, slstFields, FData);
  end;
end;

{ TsdHistoryValue }

procedure TsdHistoryValue.CopyFrom(AValue: TsdValue);
begin
  if Assigned(FOriginalCache) then
  begin
    FreeMemory(FOriginalCache);
    FOriginalCache := nil;
  end;
  if Assigned(FData) then
  begin
    FreeMemory(FData);
    FData := nil;
  end;
  FFieldName := AValue.FieldName;
  if AValue.Field.IsVarField then
  begin
    FOriginalCacheLength := AValue.InnerCacheLength(AValue.FOriginalValue);
    FLength := AValue.ActualLength;
    if AValue.DataType = ftWideString then
    begin
      FOriginalCacheLength := FOriginalCacheLength * 2;
      FLength := FLength * 2;
    end;
  end
  else
  begin
    FOriginalCacheLength := AValue.DataSize;
    FLength := AValue.DataSize;
  end;
  if Assigned(AValue.FOriginalValue) then
  begin
    FOriginalCache := AllocMem(FOriginalCacheLength);
    CopyMemory(FOriginalCache, AValue.FOriginalValue, FOriginalCacheLength);
  end;
  if Assigned(AValue.FData) then
  begin
    FData := AllocMem(FLength);
    CopyMemory(FData, AValue.FData, FLength);
  end;
  FIsNull := AValue.IsNull;
end;

procedure TsdHistoryValue.CopyTo(AValue: TsdValue);
var
  iLength: Integer;
begin
  if Assigned(FOriginalCache) then
  begin
    iLength := FOriginalCacheLength;
    // 字符串以#0结尾
    if AValue.Field.IsVarField then
    begin
      if AValue.DataType = ftWideString then
        iLength := iLength + 2
      else
        iLength := iLength + 1;
    end;
    if Assigned(AValue.FOriginalValue) then
      FreeMemory(AValue.FOriginalValue);
    AValue.FOriginalValue := AllocMem(iLength);
    // 按FOriginalCacheLength复制，这样字符串最后以#0结尾
    CopyMemory(AValue.FOriginalValue, FOriginalCache, FOriginalCacheLength);
  end
  else
  begin
    FreeMemory(AValue.FOriginalValue);
    AValue.FOriginalValue := nil;
  end;
  AValue.FOriginalCached := True;

  if Assigned(FData) then
  begin
    iLength := FLength;
    // 字符串以#0结尾
    if AValue.Field.IsVarField then
    begin
      if AValue.DataType = ftWideString then
        iLength := iLength + 2
      else
        iLength := iLength + 1;
    end;
    if Assigned(AValue.FData) then
      FreeMemory(AValue.FData);
    AValue.FData := AllocMem(iLength);
    // 按FLength复制，这样字符串最后以#0结尾
    CopyMemory(AValue.FData, FData, FLength);
    AValue.FIsNull := FIsNull;
  end
  else
  begin
    FreeMemory(AValue.FData);
    AValue.FData := nil;
    AValue.FIsNull := True;
  end;
end;

constructor TsdHistoryValue.Create;
begin
  FOriginalCache := nil;
  FData := nil;
  FOriginalCacheLength := 0;
  FLength := 0;
  FIsNull := True;
end;

destructor TsdHistoryValue.Destroy;
begin
  if Assigned(FOriginalCache) then
    FreeMemory(FOriginalCache);
  if Assigned(FData) then
    FreeMemory(FData);
  inherited;
end;

{ TsdValueCache }

constructor TsdValueCache.Create(AOwner: TsdDataRecordCache);
begin

end;

destructor TsdValueCache.Destroy;
begin
  FValue := Null;
  inherited;
end;

procedure TsdValueCache.SetValue(const Value: Variant);
begin
  FValue := Value;
end;

{ TsdDataRecordCache }

procedure TsdDataRecordCache.AddValues;
var
  I: Integer;
  V: TsdValue;
  Cache: TsdValueCache;
begin
  for I := 0 to FRecord.Count - 1 do
  begin
    V := FRecord[I];
    Cache := TsdValueCache.Create(Self);
    Cache.Value := V.Value;
    FList.Add(Cache);
  end;
end;

constructor TsdDataRecordCache.Create(AOwner: TsdDataRecord);
begin
  FRecord := AOwner;
  FList := TList.Create;
  AddValues;
end;

destructor TsdDataRecordCache.Destroy;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    TsdValueCache(FList[I]).Free;
  FList.Free;
  inherited;
end;

function TsdDataRecordCache.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TsdDataRecordCache.GetValues(I: Integer): TsdValueCache;
begin
  Result := nil;
  if (I >= 0) and (I <= FList.Count - 1) then
    Result := TsdValueCache(FList[I]);
end;

initialization
  LogOn := False;

end.