📄 memtableeh.pas
字号:
{*******************************************************}
{ }
{ EhLib vX.X }
{ }
{ TMemTableEh component (Build 11) }
{ }
{ Copyright (c) 2003,04 by Dmitry V. Bolshakov }
{ }
{*******************************************************}
unit MemTableEh {$IFDEF CIL} platform{$ENDIF};
{$I EHLIB.INC}
interface
uses Windows, SysUtils, Classes, Controls, DB,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
{$IFDEF EH_LIB_5} Contnrs, {$ENDIF}
{$IFDEF CIL}
System.Runtime.InteropServices,
{$ENDIF}
ToolCtrlsEh, DBCommon, MemTableDataEh, DataDriverEh, MemTreeEh;
type
TCustomMemTableEh = class;
TLoadMode = (lmCopy, lmAppend);
{ 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 GetKeyFieldName: String;
function GetRefParentFieldName: String;
procedure SetActive(const Value: Boolean);
procedure SetKeyFieldName(const Value: String);
procedure SetRefParentFieldName(const Value: String);
function GetDefaultNodeExpanded: Boolean;
function GetDefaultNodeHasChildren: Boolean;
procedure SetDefaultNodeExpanded(const Value: Boolean);
procedure SetDefaultNodeHasChildren(const Value: Boolean);
public
constructor Create(AMemTable: TCustomMemTableEh);
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;
end;
{ TCustomMemTableEh }
TMasterDetailSideEh = (mdsOnSelfEh, mdsOnProviderEh);
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;
{ TRecInfo = record
Bookmark: TRecIdEh;
BookmarkFlag: TBookmarkFlag;
RecordStatus: Integer;
RecordNumber: Integer;
NewTreeNodeExpanded: Boolean;
NewTreeNodeHasChildren: Boolean;
TreeNode: TMemoryTreeNodeEh;
end;}
{ TFieldValBuf = record
VarValue: Variant;
end;
PFieldValBuf = ^TFieldValBuf;}
TFBRecBufValues = array of Variant;
TRecBuf = class(TObject)
InUse: Boolean;
Bookmark: TRecIdEh;
BookmarkFlag: TBookmarkFlag;
RecordStatus: Integer;
RecordNumber: Integer;
NewTreeNodeExpanded: Boolean;
NewTreeNodeHasChildren: Boolean;
TreeNode: TMemoryTreeNodeEh;
// RecInfo: TRecInfo;
Values: TFBRecBufValues;
end;
// PRecBuf = ^TRecBuf;
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}
FInstantReadCurRow: Integer;
FKeyFields: String;
FMasterDetailSide: TMasterDetailSideEh;
FMasterValues: Variant;
FOnFetchRecord: TMTFetchRecordEventEh;
FOnTreeNodeExpanding: TMTTreeNodeExpandingEventEh;
FOnUpdateRecord: TMTUpdateRecordEventEh;
// FOrderByList: TList;
FParams: TParams;
FReadOnly: Boolean;
FRecBufSize: Integer;
FRecordPos: Integer;
FRecordsView: TRecordsViewEh;
FTreeList: TMemTableTreeListEh;
function GetAggregatesActive: Boolean;
function GetAutoIncrement: TAutoIncrementEh;
function GetCachedUpdates: Boolean;
function GetDataFieldsCount: Integer;
function GetInstantReadCurRow: Integer;
function GetMasterFields: String;
function GetMasterSource: TDataSource;
function GetTreeNode: TMemoryTreeNodeEh;
function GetTreeNodeChildCount: Integer;
function GetTreeNodeExpanded: Boolean;
function GetTreeNodeHasChildren: Boolean;
function GetUpdateError: TUpdateErrorEh;
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 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 SortData(ParamSort: TObject);
protected
FInstantReadMode: Boolean;
FMasterDataLink: TMasterDataLinkEh;
function GetActiveRecBuf(var RecBuf: TRecBuf): Boolean; virtual;
function GetTreeNodeHasChields: Boolean;
function GetTreeNodeLevel: 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;
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: TTreeNodeEh; 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;
{$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 GetBookmarkStr: TBookmarkStr; override;
function GetCanModify: Boolean; override;
function GetRecNo: Integer; override;
function GetRecordCount: Integer; override;
function GetRecordSize: Word; override;
function IndexOfBookmark(Bookmark: TBookmark): Integer;
function IsCursorOpen: Boolean; override;
function InternalApplyUpdates(MaxErrors: Integer): Integer; virtual;
function UpdateRecord(DeltaDataSet: TDataSet; UpdateKind: TUpdateKind; RefreshRecord: Boolean): Integer; virtual;
function ParseOrderByStr(OrderByStr: String): TObject;
procedure BindFields(Binding: Boolean);
procedure BindCalFields;
procedure CloseBlob(Field: TField); override;
procedure CreateFields; override;
{$IFDEF CIL}
procedure DataEvent(Event: TDataEvent; Info: TObject); override;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure GetBookmarkData(Buffer: TRecordBuffer; var Bookmark: TBookmark); override;
procedure InitRecord(Buffer: TRecordBuffer); override;
procedure InternalAddRecord(Buffer: TRecordBuffer; Append: Boolean); override;
procedure InternalGotoBookmark(const Bookmark: TBookmark); override;
procedure InternalInitRecord(Buffer: TRecordBuffer); override;
procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
procedure RecordToBuffer(MemRec: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh; Buffer: TRecordBuffer);
procedure SetBookmarkData(Buffer: TRecordBuffer; const Bookmark: TBookmark); override;
procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
procedure SetFieldData(Field: TField; Buffer: TValueBuffer); override;
procedure SetFieldData(Field: TField; Buffer: TValueBuffer; NativeFormat: Boolean); override;
procedure SetMemoryRecordData(Buffer: TRecordBuffer; Rec: TMemoryRecordEh); virtual;
procedure VarValueToFieldValue(VarValue: Variant; FieldBuffer: TObject; Field: TField);
{$ELSE}
procedure DataEvent(Event: TDataEvent; Info: Longint); override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure InitRecord(Buffer: PChar); override;
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
procedure InternalGotoBookmark(Bookmark: TBookmark); override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalSetToRecord(Buffer: PChar); override;
procedure RecordToBuffer(MemRec: TMemoryRecordEh; DataValueVersion: TDataValueVersionEh; Buffer: PChar);
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
procedure SetMemoryRecordData(Buffer: PChar; Rec: TMemoryRecordEh); virtual;
procedure VarValueToFieldValue(VarValue: Variant; FieldBuffer: Pointer; Field: TField);
{$ENDIF}
procedure DoOnNewRecord; override;
procedure DoOrderBy(const OrderByStr: String); virtual;
procedure ReadState(Reader: TReader); override;
{$IFNDEF CIL}
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
{$ENDIF}
procedure InitFieldDefsFromFields;
procedure InternalCancel; override;
procedure InternalClose; override;
procedure InternalDelete; override;
procedure InternalFirst; override;
procedure InternalHandleException; override;
procedure InternalInitFieldDefs; override;
procedure InternalInsert; override;
procedure InternalLast; override;
procedure InternalOpen; override;
procedure InternalPost; override;
procedure InternalRefresh; override;
procedure MasterChange(Sender: TObject);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure OpenCursor(InfoQuery: Boolean); override;
procedure ResetAggField(Field: TField); override;
procedure SetBlobData(Field: TField; Buffer: TRecBuf; Value: TMemBlobData);
procedure SetFiltered(Value: Boolean); override;
procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
procedure SetRecNo(Value: Integer); override;
procedure UpdateDetailMode(AutoRefresh: Boolean);
property AggregatesActive: Boolean read GetAggregatesActive write SetAggregatesActive default False;
property DataFieldsCount: Integer read GetDataFieldsCount;
// property InstantBuffer: PChar read GetInstantBuffer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ApplyUpdates(MaxErrors: Integer): Integer; virtual;
function BookmarkValid({$IFDEF CIL}const{$ENDIF} Bookmark: TBookmark): Boolean; override;
function CompareBookmarks({$IFDEF CIL}const{$ENDIF} Bookmark1, Bookmark2: TBookmark): Integer; override;
function GetCurrentRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): Boolean; override;
function GetFieldData(Field: TField; Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}Pointer{$ENDIF}; NativeFormat: Boolean): Boolean; override;
{$IFDEF CIL}
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
{$ENDIF}
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
function FetchRecords(Count: Integer): Integer;
function FindRec(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Integer;
function InstantReadIndexOfBookmark(Bookmark: TBookmarkStr): Integer;
function InstantReadRowCount: Integer;
function IsSequenced: Boolean; override;
function LoadFromDataSet(Source: TDataSet; RecordCount: Integer;
Mode: TLoadMode; UseIfCachedUpdates: Boolean): Integer;
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; override;
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
function SaveToDataSet(Dest: TDataSet; RecordCount: Integer): Integer;
function UpdateStatus: TUpdateStatus; override;
procedure CancelUpdates;
procedure CreateDataSet;
procedure CopyStructure(Source: TDataSet);
procedure EmptyTable;
procedure InstantReadEnter(RowNum: Integer);
procedure InstantReadLeave;
procedure FetchParams;
procedure FetchRecord(DataSet: TDataSet);
procedure MergeChangeLog;
procedure SortByFields(const SortByStr: string);
procedure RefreshRecord;
procedure Resync(Mode: TResyncMode); override;
procedure RevertRecord;
procedure SetFilterText(const Value: string); override;
property CachedUpdates: Boolean read GetCachedUpdates write SetCachedUpdates default False;
property DetailFields: String read FDetailFields write SetDetailFields;
property InstantReadCurRow: Integer read GetInstantReadCurRow;
property FetchAllOnOpen: Boolean read FFetchAllOnOpen write FFetchAllOnOpen default False;
property KeyFields: String read FKeyFields write SetKeyFields;
property MasterDetailSide: TMasterDetailSideEh read FMasterDetailSide write SetMasterDetailSide default mdsOnSelfEh;
property MasterFields: String read GetMasterFields write SetMasterFields;
property MasterSource: TDataSource read GetMasterSource write SetMasterSource;
property UpdateError: TUpdateErrorEh read GetUpdateError;
property Params: TParams read FParams write SetParams;
property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
property OnUpdateRecord: TMTUpdateRecordEventEh read FOnUpdateRecord write FOnUpdateRecord;
property OnFetchRecord: TMTFetchRecordEventEh read FOnFetchRecord write FOnFetchRecord;
property OnTreeNodeExpanding: TMTTreeNodeExpandingEventEh read FOnTreeNodeExpanding write FOnTreeNodeExpanding;
property DataDriver: TDataDriverEh read FDataDriver write SetDataDriver;
property RecordsView: TRecordsViewEh read FRecordsView;
property AutoIncrement: TAutoIncrementEh read GetAutoIncrement write SetAutoIncrement;
property TreeList: TMemTableTreeListEh read FTreeList write FTreeList;
property TreeNode: TMemoryTreeNodeEh read GetTreeNode;
property TreeNodeLevel: Integer read GetTreeNodeLevel;
property TreeNodeExpanded: Boolean read GetTreeNodeExpanded write SetTreeNodeExpanded;
property TreeNodeHasChildren: Boolean read GetTreeNodeHasChildren write SetTreeNodeHasChildren;
property TreeNodeChildCount: Integer read GetTreeNodeChildCount;
end;
{ TMemBlobStreamEh }
TMemBlobStreamEh = class(TStream)
private
FBuffer: TRecBuf;
FCached: Boolean;
FDataSet: TCustomMemTableEh;
FField: TBlobField;
FMode: TBlobStreamMode;
FModified: Boolean;
FOpened: Boolean;
FPosition: Longint;
function GetBlobFromRecord(Field: TField): TMemBlobData;
function GetBlobSize: Longint;
protected
{$IFDEF CIL}
procedure SetSize(NewSize: Int64); override;
{$ENDIF}
public
constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
destructor Destroy; override;
{$IFDEF CIL}
function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
{$ELSE}
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF}
procedure Truncate;
end;
{ TMemTableEh }
TMemTableEh = class(TCustomMemTableEh)
published
property Active;
property AggregatesActive;
property AutoCalcFields;
property AutoIncrement;
property CachedUpdates;
property DetailFields;
property FieldDefs;
property Filter;
property Filtered;
property FetchAllOnOpen; //FetchAllOnOpen
property KeyFields;
property MasterDetailSide;
property MasterFields;
property MasterSource;
property Params;
// property ProviderDataSet;
property DataDriver;
property ReadOnly;
// property ObjectView default False;
property BeforeOpen;
property AfterOpen;
property BeforeClose;
property AfterClose;
property BeforeInsert;
property AfterInsert;
property BeforeEdit;
property AfterEdit;
property BeforePost;
property AfterPost;
property BeforeCancel;
property AfterCancel;
property BeforeDelete;
property AfterDelete;
property BeforeScroll;
property AfterScroll;
property BeforeRefresh;
property AfterRefresh;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -