memtabledataeh.pas

Ehlib.v3.4.for.Delphi5678.rar是DELPHI的三方控件源码.此控件适用于DELPHI5,6,7,8.

    TMTBooleanDataFieldEh,      { ftBoolean }
    TMTNumericDataFieldEh,      { ftFloat }
    TMTNumericDataFieldEh,      { ftCurrency }
    TMTNumericDataFieldEh,      { ftBCD }
    TMTDateTimeDataFieldEh,     { ftDate }
    TMTDateTimeDataFieldEh,     { ftTime }
    TMTDateTimeDataFieldEh,     { ftDateTime }
    nil{TBytesField},           { ftBytes }
    nil{TVarBytesField},        { 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 }
    nil{TVariantField},         { ftVariant }
    nil{TInterfaceField},       { ftInterface }
    nil{TIDispatchField},       { ftIDispatch }
    TMTStringDataFieldEh        { ftGuid }
{$IFDEF EH_LIB_6}
    ,TMTDateTimeDataFieldEh     { ftTimeStamp }
    ,TMTNumericDataFieldEh      { ftFMTBCD }
{$ENDIF}
    );

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

implementation

uses DBConsts
{$IFDEF EH_LIB_6}
  ,DateUtils
{$ENDIF}
 ,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 VarCast(Dest, Source, AVarType);
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;
begin
  Result := FCurValue;
  Inc(FCurValue, FStep);
end;

procedure TAutoIncrementEh.Reset;
begin
  FCurValue := FInitValue;
end;

procedure TAutoIncrementEh.SetInitValue(const Value: Integer);
begin
  if FInitValue = FCurValue then
    FCurValue := Value;
  FInitValue := Value;
end;

{ TMemTableDataEh }

function TMemTableDataEh.BeginRestruct: TMTDataStructEh;
begin
  if FRestructMode then
    raise Exception.Create('MemTableData already in RestructMode.');
  FNewDataStruct.Assign(FDataStruct);
  FRestructMode := True;
  Result := FNewDataStruct;
end;

procedure TMemTableDataEh.CancelRestruct;
begin
  FRestructMode := False;
  FNewDataStruct.Clear;
end;

procedure TMemTableDataEh.CheckInactive;
begin

end;

procedure TMemTableDataEh.CommitRestruct;
begin
  FRestructMode := False;
  Restruct;
end;

constructor TMemTableDataEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataStruct := TMTDataStructEh.Create(Self);
  FDataStruct.Name := 'DataStruct';
  FNewDataStruct := TMTDataStructEh.Create(Self);
  FRecordsList := TRecordsListEh.Create(Self);
  FRecordsList.Name := 'RecordsList';
  FAutoIncrement := TAutoIncrementEh.Create;
end;

destructor TMemTableDataEh.Destroy;
begin
  FDataStruct.Free;
  FNewDataStruct.Free;
  FRecordsList.Free;
  FreeAndNil(FAutoIncrement);
  inherited Destroy;
end;

procedure TMemTableDataEh.DestroyTable;
begin
  RecordsList.Clear;
  DataStruct.Clear;
end;

procedure TMemTableDataEh.AncestorNotFound(Reader: TReader;
  const ComponentName: string; ComponentClass: TPersistentClass;
  var Component: TComponent);
begin
  if (ComponentName = 'DataStruct') and (Reader.Root <> nil) then
    Component := FDataStruct
  else if (ComponentName = 'RecordsList') and (Reader.Root <> nil) then
    Component := FRecordsList;
end;

procedure TMemTableDataEh.CreateComponent(Reader: TReader;
  ComponentClass: TComponentClass; var Component: TComponent);
begin
  if ComponentClass.InheritsFrom(TMTDataStructEh) then
    Component := FDataStruct
  else if ComponentClass.InheritsFrom(TRecordsListEh) then
    Component := FRecordsList;
end;

procedure TMemTableDataEh.ReadState(Reader: TReader);
var
  OldOnCreateComponent: TCreateComponentEvent;
  OldOnAncestorNotFound: TAncestorNotFoundEvent;
begin
  DestroyTable; //Clear before read

  OldOnCreateComponent := Reader.OnCreateComponent;
  OldOnAncestorNotFound := Reader.OnAncestorNotFound;
  Reader.OnCreateComponent := CreateComponent;
  Reader.OnAncestorNotFound := AncestorNotFound;

  try
    inherited ReadState(Reader);
  finally
    Reader.OnCreateComponent := OldOnCreateComponent;
    Reader.OnAncestorNotFound := OldOnAncestorNotFound;
  end;
end;

procedure TMemTableDataEh.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
  Proc(DataStruct);
  Proc(RecordsList);
end;

procedure TMemTableDataEh.Restruct;

  function FieldId(AFieldId: Longint): TMTDataFieldEh;
  var
    i: Integer;
  begin
    Result := nil;
    for i := 0 to DataStruct.Count-1 do
    begin
      if DataStruct[i].FFieldId = AFieldId then
      begin
        Result := DataStruct[i];
        Exit;
      end;
    end;
  end;

var
  i: Integer;
begin
  for i := 0 to FNewDataStruct.Count-1 do
  begin
    if FieldId(FNewDataStruct[i].FFieldId) <> nil then
    begin
      { TODO : Really do change struct}
    end;
  end;
end;

function TMemTableDataEh.GetIsEmpty: Boolean;
begin
  Result := (DataStruct.Count = 0);
end;

procedure TMemTableDataEh.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('AutoIncCurValue', ReadAutoIncCurValue,
    WriteAutoIncCurValue, AutoIncrement.CurValue <> AutoIncrement.InitValue);
end;

procedure TMemTableDataEh.ReadAutoIncCurValue(Reader: TReader);
begin
  FAutoIncrement.FCurValue := Reader.ReadInteger;
end;

procedure TMemTableDataEh.WriteAutoIncCurValue(Writer: TWriter);
begin
  Writer.WriteInteger(FAutoIncrement.FCurValue);
end;

{ TMTDataStructEh }

constructor TMTDataStructEh.Create(AMemTableData: TMemTableDataEh);
begin
  inherited Create(AMemTableData);
  FMemTableData := AMemTableData;
  FList := TList.Create;
end;

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

procedure TMTDataStructEh.Clear;
var
  i: Integer;
begin
  for i := 0 to FList.Count-1 do
    TMTDataFieldEh(FList[i]).Free;
  FList.Clear;  
end;

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

function TMTDataStructEh.GetDataField(Index: Integer): TMTDataFieldEh;
begin
  Result := TMTDataFieldEh(FList[Index]);
end;

function TMTDataStructEh.CreateField(FieldClass: TMTDataFieldClassEh): TMTDataFieldEh;
begin
  Result := FieldClass.Create(Self);
  Result.DataStruct := Self;
  Result.FFieldId := FNextFieldId;
  Inc(FNextFieldId);
end;

procedure TMTDataStructEh.InsertField(Field: TMTDataFieldEh);
begin
//  if Field.FDataStruct <> nil then
//    Field.DataStruct.RemoveField(Field);
  FList.Add(Field);
  Field.FDataStruct := Self;
end;

procedure TMTDataStructEh.RemoveField(Field: TMTDataFieldEh);
var
  Index: Integer;
begin
  if Field.DataStruct <> Self then Exit;
  Index := FList.IndexOf(Field);
  if Index >= 0 then
  begin
    FList.Delete(Index);
    Field.FDataStruct := nil;
  end;
end;

procedure TMTDataStructEh.CheckFieldName(const FieldName: string);
begin
  if FieldName = '' then DatabaseError('SFieldNameMissing', MemTableData);
  if FindField(FieldName) <> nil then
    DatabaseErrorFmt(SDuplicateFieldName, [FieldName], MemTableData);
end;

function TMTDataStructEh.FindField(const FieldName: string): TMTDataFieldEh;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
  begin
    Result := TMTDataFieldEh(FList.Items[I]);
    if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
  end;
  Result := nil;
end;

procedure TMTDataStructEh.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
  Field: TMTDataFieldEh;
begin
  for I := 0 to Count - 1 do
  begin
    Field := DataFields[I];
    Proc(Field);
  end;
end;

function TMTDataStructEh.GetChildOwner: TComponent;
begin
  Result := Self;
end;

procedure TMTDataStructEh.BuildStructFromFieldDefs(FieldDefs: TFieldDefs);
var
  i: Integer;
  DataField: TMTDataFieldEh;
begin
  MemTableData.DestroyTable;
  for i := 0 to FieldDefs.Count-1 do
  begin
    DataField := CreateField(DefaultDataFieldClasses[FieldDefs[i].DataType]);