memtabledataeh.pas

最新的 DBGRIDEH4.0

    constructor Create(ADataSet: TDataSet); reintroduce;
    destructor Destroy; override;

//    function FetchRecord(Rec: TMemoryRecordEh): Boolean;
//    function FindRecId(RecId: TRecIdEh): Integer;

    function AccountableItemsCount: Integer;
    function AddRecord(Rec: TMemoryRecordEh): Integer;
    function CalcAggrFieldFunc(FieldName, AggrFuncName: String): Variant;
    function IndexOf(Rec: TMemoryRecordEh): Integer;
    function NewRecord: TMemoryRecordEh;
    function ViewItemsCount: Integer;
    procedure CancelUpdates;
    procedure DeleteRecord(Index: Integer);
    procedure InsertRecord(Index: Integer; Rec: TMemoryRecordEh);
    procedure InstantDisableFilter;
    procedure InstantEnableFilter;
    procedure LockCachedUpdates;
    procedure MergeChangeLog;
    procedure RebuildMemoryTreeList;
    procedure RefreshFilteredRecsList;
    procedure RefreshRecord(Index: Integer; Rec: TMemoryRecordEh);
    procedure RevertRecord(Index: Integer);
    procedure UnlockCachedUpdates;
    procedure UpdateFields; virtual;

    procedure QuickSort(L, R: Integer; Compare: TCompareRecords; ParamSort: TObject);
    procedure SortData(Compare: TCompareRecords; ParamSort: TObject);
    
//    property MemTableData: TMemTableDataEh read FMemTableData write SetMemTableData;

    property AccountableRecord[Index: Integer]: TMemoryRecordEh read GetAccountableRecord;
    property Aggregates: TMTAggregatesEh read FAggregates;
//    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
    property CatchChanged: Boolean read FCatchChanged write FCatchChanged;
    property Count: Integer read GetCount;
    property MemoryTreeList: TMemoryTreeListEh read FMemoryTreeList;
    property OldRecVals[Index: Integer]: TRecDataValues read GetOldRecVals;
    property OnCompareRecords: TCompareRecords read FOnCompareRecords write FOnCompareRecords;
    property OnCompareTreeNode: TCompareNodesEh read FOnCompareTreeNode write FOnCompareTreeNode;
    property OnFilterRecord: TRecordsViewFilterEventEh read FOnFilterRecord write FOnFilterRecord;
    property OnGetPrefilteredList: TGetPrefilteredListEventEh read FOnGetPrefilteredList write FOnGetPrefilteredList;
    property OnParseOrderByStr: TParseOrderByStrEventEh read FOnParseOrderByStr write FOnParseOrderByStr;
    property OnViewDataEvent: TRecordsListNotificatorDataEventEh read FOnViewDataEvent write FOnViewDataEvent;
    property Rec[Index: Integer]: TMemoryRecordEh read GetRec write SetRec;
    property TreeViewKeyFieldName: String read FTreeViewKeyFieldName write SetTreeViewKeyFieldName;
    property TreeViewKeyFields: TIntArray read FTreeViewKeyFields;
    property TreeViewRefParentFieldName: String read FTreeViewRefParentFieldName write SetTreeViewRefParentFieldName;
    property TreeViewRefParentFields: TIntArray read FTreeViewRefParentFields;
    property Value[RecNo, ValNo: Integer]: Variant read GetValue write SetValue;
    property ViewAsTreeList: Boolean read GetViewAsTreeList write SetViewAsTreeList;
    property ViewRecord[Index: Integer]: TMemoryRecordEh read GetViewRecord; default;
    property SortOrder: String read GetSortOrder write SetSortOrder;
    property StatusFilter: TUpdateStatusSet read GetStatusFilter write SetStatusFilter default [usUnmodified, usModified, usInserted];
    property MemTableData: TMemTableDataEh read GetMemTableData write SetMemTableData;
  end;

const
  mrEditStatesEh = [resEditEh, resInsertEh];
  StringDataFieldsToFields: array[TStringDataFieldTypesEh] of TFieldType =
    (ftString, ftFixedChar, ftWideString, ftGuid
{$IFDEF EH_LIB_10}
     , ftFixedWideChar, ftOraInterval
{$ENDIF}
    );
  NumericDataFieldsToFields: array[TNumericDataFieldTypesEh] of TFieldType =
    (ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftAutoInc,
     ftLargeint
{$IFDEF EH_LIB_6}
     ,ftFMTBcd
{$ENDIF}
     );
  DateTimeDataFieldsToFields: array[TDateTimeDataFieldTypesEh] of TFieldType =
    (ftDate, ftTime, ftDateTime
//{$IFDEF EH_LIB_6}
//     ,ftTimeStamp
//{$ENDIF}
     );
   InterfaceDataFieldsToFields: array[TInterfaceDataFieldTypesEh] of TFieldType =
    (ftInterface, ftIDispatch);
   VariantDataFieldsToFields: array[TVariantDataFieldTypesEh] of TFieldType =
    (ftVariant, ftBytes, ftVarBytes);
{$IFDEF EH_LIB_6}
  SQLTimeStampDataFieldsToFields: array[TSQLTimeStampDataFieldTypesEh] of TFieldType =
    (ftTimeStamp
{$IFDEF EH_LIB_10}
     ,ftOraTimeStamp
{$ENDIF}
     );
{$ENDIF}

var
  DefaultDataFieldClasses: array[TFieldType] of TMTDataFieldClassEh = (
    TMTRefObjectFieldEh,        { ftUnknown }
    TMTStringDataFieldEh,       { ftString }
    TMTNumericDataFieldEh,      { ftSmallint }
    TMTNumericDataFieldEh,      { ftInteger }
    TMTNumericDataFieldEh,      { ftWord }
    TMTBooleanDataFieldEh,      { ftBoolean }
    TMTNumericDataFieldEh,      { ftFloat }
    TMTNumericDataFieldEh,      { ftCurrency }
    TMTNumericDataFieldEh,      { ftBCD }
    TMTDateTimeDataFieldEh,     { ftDate }
    TMTDateTimeDataFieldEh,     { ftTime }
    TMTDateTimeDataFieldEh,     { ftDateTime }
    TMTVariantDataFieldEh,      { ftBytes }
    TMTVariantDataFieldEh,      { ftVarBytes }
    TMTNumericDataFieldEh,      { ftAutoInc }
    TMTBlobDataFieldEh,         { ftBlob }
    TMTBlobDataFieldEh,         { ftMemo }
    TMTBlobDataFieldEh,         { ftGraphic }
    TMTBlobDataFieldEh,         { ftFmtMemo }
    TMTBlobDataFieldEh,         { ftParadoxOle }
    TMTBlobDataFieldEh,         { ftDBaseOle }
    TMTBlobDataFieldEh,         { ftTypedBinary }
    nil,                        { ftCursor }
    TMTStringDataFieldEh,       { ftFixedChar }
    TMTStringDataFieldEh,       { ftWideString }
    TMTNumericDataFieldEh,      { ftLargeInt }
    nil{TADTField},             { ftADT }
    nil{TArrayField},           { ftArray }
    nil{TReferenceField},       { ftReference }
    nil{TDataSetField},         { ftDataSet }
    TMTBlobDataFieldEh,         { ftOraBlob }
    TMTBlobDataFieldEh,         { ftOraClob }
    TMTVariantDataFieldEh,      { ftVariant }
    TMTInterfaceDataFieldEh,    { ftInterface }
    TMTInterfaceDataFieldEh,    { ftIDispatch }
    TMTStringDataFieldEh        { ftGuid }
{$IFDEF EH_LIB_6}
    ,TMTSQLTimeStampDataFieldEh { ftTimeStamp }
    ,TMTNumericDataFieldEh      { ftFMTBCD }
{$ENDIF}
{$IFDEF EH_LIB_10}
    ,TMTStringDataFieldEh       { ftFixedWideChar }
    ,TMTBlobDataFieldEh         { ftWideMemo }
    ,TMTSQLTimeStampDataFieldEh { ftOraTimeStamp }
    ,TMTStringDataFieldEh       { ftOraInterval }
{$ENDIF}
    );

function CalcAggregateValue(Aggregate: TMTAggregateEh; DataSet: TDataSet; Records: TRecordsViewEh): Variant;

implementation

uses DBConsts
{$IFDEF EH_LIB_6}
  ,DateUtils, RTLConsts
{$ELSE}
  ,Consts
{$ENDIF}
 ,memtableeh
 ,ToolCtrlsEh;

type
{$IFNDEF EH_LIB_6}
  PWordBool     = ^WordBool;
{$ENDIF}

  TDataSetCrack = class(TDataSet);

function PrepareExpr(Expr: String): String;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(Expr) do
  begin
    if Expr[i] <> ' ' then
      Result := Result + Expr[i];
  end;
  Result := AnsiUpperCase(Result);
end;

function CalcAggregateValue(Aggregate: TMTAggregateEh; DataSet: TDataSet; Records: TRecordsViewEh): Variant;
var
  AggrExpStr: String;
  FuncName: String;
  FieldName: String;
begin
  Result := Null;
  FieldName := '';
  FuncName := '';
  AggrExpStr := PrepareExpr(Aggregate.Expression);

  //Function
  if Copy(AggrExpStr,1,Length('COUNT(')) = 'COUNT(' then
  begin
    FuncName := 'COUNT';
    AggrExpStr := Copy(AggrExpStr, Length('COUNT(')+1, Length(AggrExpStr));
  end else if Copy(AggrExpStr,1,Length('SUM(')) = 'SUM(' then
  begin
    FuncName := 'SUM';
    AggrExpStr := Copy(AggrExpStr, Length('SUM(')+1, Length(AggrExpStr));
  end else if Copy(AggrExpStr,1,Length('MIN(')) = 'MIN(' then
  begin
    FuncName := 'MIN';
    AggrExpStr := Copy(AggrExpStr, Length('MIN(')+1, Length(AggrExpStr));
  end else if Copy(AggrExpStr,1,Length('MAX(')) = 'MAX(' then
  begin
    FuncName := 'MAX';
    AggrExpStr := Copy(AggrExpStr, Length('MAX(')+1, Length(AggrExpStr));
  end else if Copy(AggrExpStr,1,Length('AVG(')) = 'AVG(' then
  begin
    FuncName := 'AVG';
    AggrExpStr := Copy(AggrExpStr, Length('AVG(')+1, Length(AggrExpStr));
  end;

  //Field
  if (Length(AggrExpStr) > 0) and (AggrExpStr[Length(AggrExpStr)] = ')') then
    FieldName := Copy(AggrExpStr, 1, Length(AggrExpStr)-1);

  Result := Records.CalcAggrFieldFunc(FieldName, FuncName);
end;

procedure DataVarCast(var Dest: Variant; const Source: Variant; AVarType: Integer);
//function DataVarCast(const Source: Variant; AVarType: Integer): Variant;
begin
  if VarIsNull(Source) then
    Dest := Null
  else if AVarType = varVariant then
    Dest := Source
  else
    VarCast(Dest, Source, AVarType);
end;

{ TOrderByList }

function TOrderByList.GetToken(Exp: String; var FromIndex: Integer): String;
begin
  Result := '';
  if FromIndex > Length(Exp) then Exit;
  while Exp[FromIndex] = ' ' do
  begin
    Inc(FromIndex);
    if FromIndex > Length(Exp) then Exit;
  end;
  if FromIndex > Length(Exp) then Exit;
  if Exp[FromIndex] in [',', ';'] then
  begin
    Result := Result + Exp[FromIndex];
    Inc(FromIndex);
    Exit;
  end;
  while not (Exp[FromIndex] in [#0, ' ', ',', ';']) do
  begin
    Result := Result + Exp[FromIndex];
    Inc(FromIndex);
    if FromIndex > Length(Exp) then Exit;
  end;
end;

function TOrderByList.FindFieldIndex(FieldName: String): Integer;
begin
  Result := -1;
end;

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

procedure TOrderByList.ParseOrderByStr(OrderByStr: String);
var
  FieldName, Token: String;
//  Exp: PChar;
  FromIndex: Integer;
  Desc: Boolean;
  OByItem: TOrderByItemEh;
  FieldIndex: Integer;
  OrderByList: TOrderByList;
  i: Integer;
begin
  OrderByList := TOrderByList.Create(False);
  try
//    Exp := PChar(OrderByStr);
    FromIndex := 1;
    FieldName := GetToken(OrderByStr, FromIndex);
    if FieldName = '' then Exit;
    FieldIndex := FindFieldIndex(FieldName);
    if FieldIndex = -1 then
      raise Exception.Create(' Field - "' + FieldName + '" not found.');
    Desc := False;
    while True do
    begin
      Token := GetToken(OrderByStr, FromIndex);
      if AnsiUpperCase(Token) = 'ASC' then
        Continue
      else if AnsiUpperCase(Token) = 'DESC' then
      begin
        Desc := True;
        Continue
      end else if (Token = ';') or (Token = ',') or (Token = '') then

      else
        raise Exception.Create(' Invalid token - "' + Token + '"');

      OByItem := TOrderByItemEh.Create;
//      OByItem.Field := Field;
      OByItem.FieldIndex := FieldIndex;
      OByItem.Desc := Desc;
      TOrderByList(OrderByList).Add(OByItem);

      FieldName := GetToken(OrderByStr, FromIndex);
      if FieldName = '' then Break;
      FieldIndex := FindFieldIndex(FieldName);
      if FieldIndex = -1 then
        raise Exception.Create(' Field - "' + FieldName + '" not found.');
      Desc := False;
    end;
    Clear;
    for i := 0 to OrderByList.Count-1 do
      Add(OrderByList[i]);
//    Self.Assign(OrderByList);
  except
    OrderByList.Free;
    raise;
  end;
end;

procedure TOrderByList.SetItem(Index: Integer; const Value: TOrderByItemEh);
begin
  inherited Items[Index] := Value;
end;

{ TRecordsViewOrderByList }

constructor TRecordsViewOrderByList.Create(ARecordsView: TRecordsViewEh);
begin
  inherited Create;
  FRecordsView := ARecordsView;
end;

function TRecordsViewOrderByList.FindFieldIndex(FieldName: String): Integer;
begin
  Result := FRecordsView.MemTableData.DataStruct.FieldIndex(FieldName);
end;

{ TAutoIncrementEh }

procedure TAutoIncrementEh.Assign(Source: TPersistent);
begin
  if Source is TAutoIncrementEh then
  begin
    Step := TAutoIncrementEh(Source).Step;
    InitValue := TAutoIncrementEh(Source).InitValue;
  end
  else
    inherited Assign(Source);
end;

constructor TAutoIncrementEh.Create;
begin
  inherited Create;
  FStep := -1;
  FInitValue := -1;
  Reset;
end;

function TAutoIncrementEh.Promote: Longint;