memtableeh.pas

最新的 DBGRIDEH4.0

{*******************************************************}
{                                                       }
{                      EhLib v4.2                       }
{                 TMemTableEh component                 }
{                     Build 4.2.37                      }
{                                                       }
{      Copyright (c) 2004-07 by Dmitry V. Bolshakov     }
{                                                       }
{*******************************************************}

unit MemTableEh;// {$IFDEF CIL} platform{$ENDIF};

{$I EHLIB.INC}

interface

uses Windows, SysUtils, Classes, Controls, DB, Dialogs,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
{$IFDEF EH_LIB_5} Contnrs, {$ENDIF}
{$IFDEF CIL}
  System.Runtime.InteropServices,
  EhLibVCLNET,
{$ELSE}
  EhLibVCL,
{$ENDIF}
  ToolCtrlsEh, DBCommon, MemTableDataEh, DataDriverEh, MemTreeEh;

type

  TCustomMemTableEh = class;

  TLoadMode = (lmCopy, lmAppend);

// TMemTableOptionsEh = ddoCascadeDeletesEh, ddoCascadeUpdatesEh

{ TMasterDataLinkEh }

  TMasterDataLinkEh = class(TDetailDataLink)
  private
    FDataSet: TDataSet;
    FFieldNames: string;
    FFields: TObjectList;
    FOnMasterChange: TNotifyEvent;
    FOnMasterDisable: TNotifyEvent;
    procedure SetFieldNames(const Value: string);
  protected
    function GetDetailDataSet: TDataSet; override;
    procedure ActiveChanged; override;
    procedure CheckBrowseMode; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
  public
    constructor Create(DataSet: TDataSet);
    destructor Destroy; override;
    property FieldNames: string read FFieldNames write SetFieldNames;
    property Fields: TObjectList read FFields;
    property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
    property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
  end;

{ TMemTableTreeListEh }

  TMemTableTreeListEh = class(TPersistent)
  private
    FMemTable: TCustomMemTableEh;
    function GetActive: Boolean;
    function GetDefaultNodeExpanded: Boolean;
    function GetDefaultNodeHasChildren: Boolean;
    function GetFilterNodeIfParentVisible: Boolean;
    function GetFullBuildCheck: Boolean;
    function GetKeyFieldName: String;
    function GetRefParentFieldName: String;
    procedure SetActive(const Value: Boolean);
    procedure SetDefaultNodeExpanded(const Value: Boolean);
    procedure SetDefaultNodeHasChildren(const Value: Boolean);
    procedure SetFilterNodeIfParentVisible(const Value: Boolean);
    procedure SetFullBuildCheck(const Value: Boolean);
    procedure SetKeyFieldName(const Value: String);
    procedure SetRefParentFieldName(const Value: String);
  public
    constructor Create(AMemTable: TCustomMemTableEh);
    function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; virtual;
    procedure FullCollapse; virtual;
    procedure FullExpand; virtual;
  published
    property Active: Boolean read GetActive write SetActive default False;
    property KeyFieldName: String read GetKeyFieldName write SetKeyFieldName;
    property RefParentFieldName: String read GetRefParentFieldName write SetRefParentFieldName;
    property DefaultNodeExpanded: Boolean read GetDefaultNodeExpanded write SetDefaultNodeExpanded default False;
    property DefaultNodeHasChildren: Boolean read GetDefaultNodeHasChildren write SetDefaultNodeHasChildren default False;
    property FullBuildCheck: Boolean read GetFullBuildCheck write SetFullBuildCheck default True;
    property FilterNodeIfParentVisible: Boolean read GetFilterNodeIfParentVisible write SetFilterNodeIfParentVisible default True;
  end;

{ TCustomMemTableEh }

  TMasterDetailSideEh = (mdsOnSelfEh, mdsOnProviderEh, mdsOnSelfAfterProviderEh);

  TMTUpdateActionEh = (uaFailEh, uaAbortEh, uaSkipEh, uaRetryEh, uaApplyEh, uaAppliedEh);

  TMTUpdateRecordEventEh = procedure(DeltaDataSet: TDataSet; UpdateKind: TUpdateKind;
    var UpdateAction: TMTUpdateActionEh) of object;

  TMTFetchRecordEventEh = procedure(PacketDataSet: TDataSet; var ProviderEOF,
    Applied: Boolean) of object;

  TMTRefreshRecordEventEh = procedure(PacketDataSet: TDataSet; var Applied: Boolean)
    of object;

  TMTTreeNodeExpandingEventEh = procedure(Sender: TObject; RecNo: Integer;
    var AllowExpansion: Boolean) of object;

  TRecordsViewTreeNodeExpandingEventEh = procedure (Sender: TObject; Node: TMemRecViewEh;
    var AllowExpansion: Boolean) of object;

  TRecordsViewTreeNodeExpandedEventEh = procedure (Sender: TObject; Node: TMemRecViewEh) of object;

  TRecordsViewCheckMoveNodeEventEh = function (Sender: TObject;
    SourceNode, AppointedParent: TMemRecViewEh; AppointedIndex: Integer): Boolean of object;

  TMemTableChangeFieldValueEventEh = procedure (MemTable: TCustomMemTableEh;
    Field: TField; var Value: Variant) of object;

{  TRecInfo = record
    Bookmark: TRecIdEh;
    BookmarkFlag: TBookmarkFlag;
    RecordStatus: Integer;
    RecordNumber: Integer;
    NewTreeNodeExpanded: Boolean;
    NewTreeNodeHasChildren: Boolean;
    TreeNode: TMemRecViewEh;
  end;}

{  TFieldValBuf = record
    VarValue: Variant;
  end;

  PFieldValBuf = ^TFieldValBuf;}

  TFBRecBufValues = array of Variant;

{ TRecBuf }

  TRecBuf = class(TObject)
  private
//    function GetTreeNode: TMemRecViewEh;
//    function GetMemRec: TMemoryRecordEh;
  public
    InUse: Boolean;
    Bookmark: Integer;
    BookmarkFlag: TBookmarkFlag;
    RecordStatus: Integer;
    RecordNumber: Integer;
    NewTreeNodeExpanded: Boolean;
    NewTreeNodeHasChildren: Boolean;
    RecView: TMemRecViewEh;
    MemRec: TMemoryRecordEh;
//    RecordsView: TRecordsViewEh;
    Values: TFBRecBufValues;
    UseMemRec: Boolean;
    function GetValue(Field: TField): Variant;
    function ReadValueCount: Integer;
    procedure SetValue(Field: TField; v: Variant);
    procedure SetLength(Len: Integer);
    procedure Clear;
    destructor Destroy; override;
    property Value[Field: TField]: Variant read GetValue write SetValue;
    property ValueCount: Integer read ReadValueCount;
//    property TreeNode: TMemRecViewEh read GetTreeNode;
//    property MemRec: TMemoryRecordEh read GetMemRec;
  end;

//  PRecBuf = ^TRecBuf;

  TSortedVarItemEh = class (TObject)
  protected
    Value:Variant;
  public
    constructor Create(NewValue:variant);
  end;

  TSortedVarlistEh = class(TObjectList)
  protected
    function  VarInList(Value:variant):boolean;
    function  FindValueIndex(Value: Variant; var Index: Integer):boolean;
  public
    function Add(AObject: TSortedVarItemEh): Integer;
    procedure Insert(Index: Integer; AObject: TSortedVarItemEh);
  end;

  TCustomMemTableEh = class(TDataSet, IMemTableEh {$IFNDEF CIL}, IUnknown{$ENDIF})
  private
    FRecordCache: TObjectList;
    FActive: Boolean;
    FAutoInc: Longint;
//    FCachedUpdates: Boolean;
    FCalcFieldIndexes: array of Integer;
    FDataDriver: TDataDriverEh;
//    FDataRecordSize: Integer;
    FDataSetReader: TDataSet;
    FDetailFieldList: TObjectList;
    FDetailFields: String;
    FDetailMode: Boolean;
    FFetchAllOnOpen: Boolean;
    FFilterExpr: TDataSetExprParserEh;
{$IFDEF CIL}
//    FInstantBuffer: TRecordBuffer;
{$ELSE}
//    FInstantBuffer: PChar;
{$ENDIF}
    FInstantBuffers: TObjectList;
    FInstantReadCurRowNum: Integer;
//    FKeyFields: String;
    FMasterDetailSide: TMasterDetailSideEh;
    FMasterValues: Variant;
//    FOnFetchRecord: TMTFetchRecordEventEh;
    FOnTreeNodeExpanding: TMTTreeNodeExpandingEventEh;
    FOnRecordsViewTreeNodeExpanding: TRecordsViewTreeNodeExpandingEventEh;
    FOnRecordsViewTreeNodeExpanded: TRecordsViewTreeNodeExpandedEventEh;
    FOnRecordsViewCheckMoveNode: TRecordsViewCheckMoveNodeEventEh;
//    FOnUpdateRecord: TMTUpdateRecordEventEh;
//    FOrderByList: TList;
    FParams: TParams;
    FReadOnly: Boolean;
    FRecBufSize: Integer;
    FRecordPos: Integer;
    FRecordsView: TRecordsViewEh;
    FTreeList: TMemTableTreeListEh;
    FIndexDefs: TIndexDefs;
    FStoreDefs: Boolean;
    FDetailRecList: TObjectList;
    FDetailRecListActive: Boolean;
    FInternMemTableData: TMemTableDataEh;
    FExternalMemData: TCustomMemTableEh;
    FRecordsViewUpdating: Integer;
    FRecordsViewUpdated: Boolean;
    FMasterValList: TSortedVarlistEh;
    FSortOrder: String;
    FOnGetFieldValue: TMemTableChangeFieldValueEventEh;
    FOnSetFieldValue: TMemTableChangeFieldValueEventEh;
    procedure BeginRecordsViewUpdate;
    procedure EndRecordsViewUpdate(AutoResync: Boolean);
    function GetAggregatesActive: Boolean;
    function GetAutoIncrement: TAutoIncrementEh;
    function GetCachedUpdates: Boolean;
    function GetDataFieldsCount: Integer;
    function GetInstantReadCurRowNum: Integer;
//    function GetKeyFields: String;
    function GetMasterFields: String;
    function GetMasterSource: TDataSource;
    function GetTreeNode: TMemRecViewEh;
    function GetTreeNodeChildCount: Integer;
    function GetTreeNodeExpanded: Boolean;
    function GetTreeNodeHasChildren: Boolean;
    function GetUpdateError: TUpdateErrorEh;
    function GetIndexDefs: TIndexDefs;
{$IFDEF CIL}
    function GetInstantBuffer: TRecordBuffer;
{$ELSE}
    function GetInstantBuffer: PChar;
{$ENDIF}
    function IsRecordInFilter(Rec: TMemoryRecordEh): Boolean;
    procedure AncestorNotFound(Reader: TReader; const ComponentName: string; ComponentClass: TPersistentClass; var Component: TComponent);
    procedure ClearRecords;
    procedure CreateComponent(Reader: TReader; ComponentClass: TComponentClass; var Component: TComponent);
    procedure InitBufferPointers(GetProps: Boolean);
    procedure RefreshParams;
    procedure SetAggregatesActive(const Value: Boolean);
    procedure SetAutoIncrement(const Value: TAutoIncrementEh);
    procedure SetCachedUpdates(const Value: Boolean);
    procedure SetDataDriver(const Value: TDataDriverEh);
    procedure SetDetailFields(const Value: String);
    procedure SetExternalMemData(Value: TCustomMemTableEh);
//    procedure SetKeyFields(const Value: String);
    procedure SetMasterDetailSide(const Value: TMasterDetailSideEh);
    procedure SetMasterFields(const Value: String);
    procedure SetMasterSource(const Value: TDataSource);
    procedure SetParams(const Value: TParams);
    procedure SetParamsFromCursor;
    procedure SetTreeNodeExpanded(const Value: Boolean);
    procedure SetTreeNodeHasChildren(const Value: Boolean);
    procedure SetIndexDefs(Value: TIndexDefs);
    procedure SortData(ParamSort: TObject);
    function GetSortOrder: String;
    procedure SetSortOrder(const Value: String);
    function GetStatusFilter: TUpdateStatusSet;
    procedure SetStatusFilter(const Value: TUpdateStatusSet);
    procedure SetReadOnly(const Value: Boolean);
  protected
    { IProviderSupport }
    function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; override;
  protected
    FInstantReadMode: Boolean;
    FMasterDataLink: TMasterDataLinkEh;
    FAutoIncrementFieldName: String;

    function GetActiveRecBuf(var RecBuf: TRecBuf; IsForWrite: Boolean = False): Boolean; virtual;
    function GetTreeNodeHasChields: Boolean;
    function GetTreeNodeLevel: Integer;
    function GetRecObject: TObject;
    function GetPrevVisibleTreeNodeLevel: Integer;
    function GetNextVisibleTreeNodeLevel: Integer;
    function MemTableIsTreeList: Boolean;
    function ParentHasNextSibling(ParenLevel: Integer): Boolean;
    function IMemTableGetTreeNodeExpanded(RowNum: Integer): Boolean;
    function IMemTableEh.GetTreeNodeExpanded = IMemTableGetTreeNodeExpanded;
    function IMemTableSetTreeNodeExpanded(RowNum: Integer; Value: Boolean): Integer;
    function IMemTableEh.SetTreeNodeExpanded = IMemTableSetTreeNodeExpanded;
    function GetFieldValueList(AFieldName: String): IMemTableDataFieldValueListEh;

    procedure RecreateFilterExpr;
    procedure DestroyFilterExpr;

{$IFNDEF EH_LIB_5}
    function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; override;
    function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
      Decimals: Integer): Boolean; override;
{$ENDIF}
    function AllocRecordBuffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}; override;
//    function ApplyUpdate(OldRecValues, NewRecValues: PRecValues; UpdateKind: TUpdateKind; TargetDataSet: TDataSet; OutRecValues: PRecValues): Integer;
    function CompareRecords(Rec1, Rec2: TMemoryRecordEh; ParamSort: TObject): Integer; virtual;
    function CompareTreeNodes(Rec1, Rec2: TBaseTreeNodeEh; ParamSort: TObject): Integer; virtual;
    function CreateDeltaDataSet: TCustomMemTableEh;
    function DoFetchRecords(Count: Integer): Integer;
    function FieldValueToVarValue(FieldBuffer: {$IFDEF CIL}TObject{$ELSE}Pointer{$ENDIF}; Field: TField): Variant;
    function GetBlobData(Field: TField; Buffer: TRecBuf): TMemBlobData;
//    function GetBlobData(Field: TField; var Data: Variant): Boolean;
{$IFDEF CIL}
    function BufferToIndex(Buf: TRecordBuffer): Integer;
    function BufferToRecBuf(Buf: TRecordBuffer): TRecBuf;
    function IndexToBuffer(I: Integer):TRecordBuffer;
    function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    procedure ClearCalcFields(Buffer: TRecordBuffer); override;
    procedure CopyBuffer(FromBuf, ToBuf: TRecordBuffer);
{$ELSE}
    function BufferToIndex(Buf: PChar): Integer;
    function BufferToRecBuf(Buf: PChar): TRecBuf;
    function IndexToBuffer(I: Integer): PChar;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    procedure ClearCalcFields(Buffer: PChar); override;
    procedure CopyBuffer(FromBuf, ToBuf: PChar);
{$ENDIF}
    function GetAggregateValue(Field: TField): Variant; override;
    function GetDataSource: TDataSource; override;
    function GetBookmarkStr: TBookmarkStr; override;
    function GetCanModify: Boolean; override;
    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
    function GetRecNo: Integer; override;
    function GetRecordCount: Integer; override;
    function GetRecordSize: Word; override;
    function GetRec: TMemoryRecordEh;
    function IndexOfBookmark(Bookmark: TBookmark): Integer;
    function IsCursorOpen: Boolean; override;
    function InternalApplyUpdates(AMemTableData: TMemTableDataEh; MaxErrors: Integer): Integer; virtual;
//    function UpdateRecord(DeltaDataSet: TDataSet; UpdateKind: TUpdateKind; RefreshRecord: Boolean): Integer; virtual;
    function ParseOrderByStr(OrderByStr: String): TObject;
    function SetToRec(Rec: TObject): Boolean;
    procedure BindFields(Binding: Boolean);
    procedure BindCalFields;
    procedure CloseBlob(Field: TField); override;
    procedure CreateFields; override;
    procedure CreateIndexesFromDefs; virtual;
{$IFDEF CIL}
    procedure DataEvent(Event: TDataEvent; Info: TObject); override;
    procedure DefChanged(Sender: TObject); override;
    procedure FetchRecord(DataSet: TDataSet);
    procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;