memtableeh.pas

增加了条件求和功能

      Data := FindFieldData(Buffer, Fields[I]);
      if Data <> nil then
      begin
        Boolean(Data[0]) := True;
        Inc(Data);
        Move(FAutoInc, Data^, SizeOf(Longint));
        Inc(Count);
      end;
    end;
  if Count > 0 then
    Inc(FAutoInc);
end;

procedure TCustomMemTableEh.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var
  RecPos: Integer;
  Rec: TMemoryRecordEh;
begin

  if Append then
  begin
    Rec := FRecordsView.NewRecord;
    try
      SetAutoIncFields(Buffer);

//      if (ProviderDataSet <> nil) and not CachedUpdates then
//        UpdateThroughProvider(Rec, ActiveBuffer, ukInsert, FRecordsView.Count - 1);
      SetMemoryRecordData(Buffer, Rec.Data);
    except
      Rec.Free;
      raise;
    end;
    FRecordsView.AddRecord(Rec);
    if not CachedUpdates then
      try
        InternalApplyUpdates(-1);
      except
        FRecordsView.CancelUpdates;
        raise;
      end;
    FRecordPos := FRecordsView.Count - 1;
  end else
  begin
    Rec := FRecordsView.NewRecord;
    try
      SetAutoIncFields(Buffer);
//      if (ProviderDataSet <> nil) and not CachedUpdates then
//        if FRecordPos = -1
//          then UpdateThroughProvider(FRecordsView[FRecordPos], ActiveBuffer, ukInsert, 0)
//          else UpdateThroughProvider(FRecordsView[FRecordPos], ActiveBuffer, ukInsert, FRecordPos);
      SetMemoryRecordData(Buffer, Rec.Data);

      if FRecordPos = -1
        then RecPos := 0
        else RecPos := FRecordPos;
    except
      Rec.Free;
      raise;
    end;

    FRecordsView.InsertRecord(RecPos, Rec);
    if not CachedUpdates then
      try
        InternalApplyUpdates(-1);
      except
        FRecordsView.CancelUpdates;
        raise;
      end;
    FRecordPos := RecPos;
  end;
end;

procedure TCustomMemTableEh.InternalCancel;
begin
  if not CachedUpdates and FRecordsView.MemTableData.RecordsList.HasCachedChanges then
    CancelUpdates;
end;

procedure TCustomMemTableEh.InternalPost;
begin
  if State = dsEdit then
  begin
//    if (ProviderDataSet <> nil) and not CachedUpdates then
//      UpdateThroughProvider(FRecordsView[FRecordPos], ActiveBuffer, ukModify, FRecordPos);
    FRecordsView[FRecordPos].BeginEdit;
    SetMemoryRecordData(ActiveBuffer, FRecordsView[FRecordPos].Data);
    FRecordsView[FRecordPos].EndEdit(True);
    if not CachedUpdates then
      try
        InternalApplyUpdates(-1);
      except
        FRecordsView.CancelUpdates;
        raise;
      end;
  end else
    InternalAddRecord(ActiveBuffer, Eof);
end;

procedure TCustomMemTableEh.InternalDelete;
begin
//  if (ProviderDataSet <> nil) and not CachedUpdates then
//    UpdateThroughProvider(FRecordsView[FRecordPos], ActiveBuffer, ukDelete, FRecordPos);

  FRecordsView.DeleteRecord(FRecordPos);
  if not CachedUpdates then
    InternalApplyUpdates(-1);

  if FRecordPos >= FRecordsView.Count then
    Dec(FRecordPos);
  Resync([]);
end;

{ obsolete
procedure TCustomMemTableEh.UpdateThroughProvider(MemRec: TMemoryRecordEh;
  NewBuffer: PChar; UpdateKind: TUpdateKind; RecPos: Integer);
var
  TmpRecData: TRecDataValues;
begin
  if UpdateKind in [ukModify, ukInsert] then
  begin
    SetLength(TmpRecData, DataFieldsCount);
    SetMemoryRecordData(NewBuffer, @TmpRecData);
    ApplyUpdate(MemRec.Data, @TmpRecData, UpdateKind, ProviderDataSet, @TmpRecData);
    RecordToBuffer(@TmpRecData, NewBuffer)
  end else
    ApplyUpdate(MemRec.Data, MemRec.Data, UpdateKind, ProviderDataSet, nil);
end;
}

procedure TCustomMemTableEh.CreateFields;
(*
  procedure CreateFieldsFromProvider;
  var
    I: Integer;
    AField: TField;
    FieldClass: TFieldClass;
  begin
    for I := 0 to ProviderDataSet.Fields.Count-1 do
    begin
      FieldClass := GetFieldClass(ProviderDataSet.Fields[i].DataType);
//      if Assigned(FieldClass) then
//        FieldClass.CheckTypeSize(ProviderDataSet.Fields[i].Size);
      AField := FieldClass.Create(Self);
      with ProviderDataSet.Fields[i] do
      begin
//        AField.Name := FieldName;
        AField.FieldName := FieldName;
        AField.Size := Size;
        AField.Required := Required;

        AField.Alignment := Alignment;
//        AField.AutoGenerateValue := AutoGenerateValue;
//        AField.CustomConstraint := CustomConstraint;
//        AField.ConstraintErrorMessage := ConstraintErrorMessage;
        AField.DefaultExpression := DefaultExpression;
        AField.DisplayLabel := DisplayLabel;
        AField.DisplayWidth := DisplayWidth;
        AField.FieldKind := FieldKind;
        AField.LookupDataSet := LookupDataSet;
        AField.LookupKeyFields := LookupKeyFields;
        AField.LookupResultField := LookupResultField;
        AField.KeyFields := KeyFields;
        AField.LookupCache := LookupCache;
        AField.ProviderFlags := ProviderFlags;
        AField.ReadOnly := ReadOnly;
        AField.Visible := Visible;
        AField.EditMask := EditMask;

        if (AField is TStringField) and (ProviderDataSet.Fields[i] is TStringField) then
        begin
          TStringField(AField).FixedChar := TStringField(ProviderDataSet.Fields[i]).FixedChar;
          TStringField(AField).Transliterate := TStringField(ProviderDataSet.Fields[i]).Transliterate;
        end
        else if (AField is TNumericField) and (ProviderDataSet.Fields[i] is TNumericField) then
        begin
          with ProviderDataSet.Fields[i] as TNumericField do
          begin
            TNumericField(AField).DisplayFormat := DisplayFormat;
            TNumericField(AField).EditFormat := EditFormat;
          end;
          if (AField is TIntegerField) and (ProviderDataSet.Fields[i] is TIntegerField) then
            with ProviderDataSet.Fields[i] as TIntegerField do
            begin
              TIntegerField(AField).MaxValue := MaxValue;
              TIntegerField(AField).MinValue := MinValue;
            end;
          if (AField is TLargeintField) and (ProviderDataSet.Fields[i] is TLargeintField) then
            with ProviderDataSet.Fields[i] as TLargeintField do
            begin
              TLargeintField(AField).MaxValue := MaxValue;
              TLargeintField(AField).MinValue := MinValue;
            end;
          if (AField is TFloatField) and (ProviderDataSet.Fields[i] is TFloatField) then
            with ProviderDataSet.Fields[i] as TFloatField do
            begin
              TFloatField(AField).currency := currency;
              TFloatField(AField).MaxValue := MaxValue;
              TFloatField(AField).MinValue := MinValue;
              TFloatField(AField).Precision := Precision;
            end;
          if (AField is TBCDField) and (ProviderDataSet.Fields[i] is TBCDField) then
            with ProviderDataSet.Fields[i] as TBCDField do
            begin
              TBCDField(AField).currency := currency;
              TBCDField(AField).MaxValue := MaxValue;
              TBCDField(AField).MinValue := MinValue;
              TBCDField(AField).Precision := Precision;
            end;
{$IFDEF EH_LIB_6}
          if (AField is TFMTBCDField) and (ProviderDataSet.Fields[i] is TFMTBCDField) then
            with ProviderDataSet.Fields[i] as TFMTBCDField do
            begin
              TFMTBCDField(AField).currency := currency;
              TFMTBCDField(AField).MaxValue := MaxValue;
              TFMTBCDField(AField).MinValue := MinValue;
              TFMTBCDField(AField).Precision := Precision;
            end;
{$ENDIF}
        end
        else if (AField is TBooleanField) and (ProviderDataSet.Fields[i] is TBooleanField) then
        begin
          with ProviderDataSet.Fields[i] as TBooleanField do
            TBooleanField(AField).DisplayValues := DisplayValues;
        end
        else if (AField is TDateTimeField) and (ProviderDataSet.Fields[i] is TDateTimeField) then
        begin
          with ProviderDataSet.Fields[i] as TDateTimeField do
            TDateTimeField(AField).DisplayFormat := DisplayFormat;
{$IFDEF EH_LIB_6}
        end
        else if (AField is TSQLTimeStampField) and (ProviderDataSet.Fields[i] is TSQLTimeStampField) then
        begin
          with ProviderDataSet.Fields[i] as TSQLTimeStampField do
            TSQLTimeStampField(AField).DisplayFormat := DisplayFormat;
{$ENDIF}
        end;

        AField.DataSet := Self;
      end;
    end;
    FieldDefs.Clear;
    InitFieldDefsFromFields;
  end;
*)
begin
{  if ProviderDataSet = nil
    then inherited CreateFields
    else CreateFieldsFromProvider;}
  inherited CreateFields;
end;

procedure TCustomMemTableEh.OpenCursor(InfoQuery: Boolean);
begin
  if not InfoQuery then
  begin
    if (ProviderDataSet <> nil) then
    begin
      if MasterSource <> nil then SetParamsFromCursor;
      if FParams.Count > 0 then
        IProviderSupport(ProviderDataSet).PSSetParams(FParams);
      ProviderDataSet.Active := True;
      ProviderDataSet.First;
      FProviderEOF := False;
    end;
    if {(FieldCount = 0) and} (ProviderDataSet <> nil) then
      if (FieldCount > 0) then
        FRecordsView.MemTableData.DataStruct.BuildStructFromFields(Fields)
      else
        FRecordsView.MemTableData.DataStruct.BuildStructFromFields(ProviderDataSet.Fields)
    else
    begin
      {if FieldCount > 0 then
        FieldDefs.Clear;
      InitFieldDefsFromFields;}
      if FRecordsView.MemTableData.IsEmpty then
        DatabaseError('MemTable have not data.',Self);
    end;
  end;
  FActive := True;
  inherited OpenCursor(InfoQuery);
end;

procedure TCustomMemTableEh.InternalOpen;
begin
  BookmarkSize := SizeOf(Integer);
  FieldDefs.Updated := False;
  FieldDefs.Update;
  if DefaultFields then
    CreateFields;
  BindFields(True);
  if FieldCount = 0 then
    DatabaseError('No fields defined. Cannot create dataset');
  InitBufferPointers(True);
  InternalFirst;
//  FRecordsView.RecValCount := DataFieldsCount;
  FInstantBuffer := AllocRecordBuffer;
  PRecBuf(FInstantBuffer).RecInfo.RecordNumber := -1;
  UpdateDetailMode(False);
  FRecordsView.Aggregates.Reset;
end;

procedure TCustomMemTableEh.InternalClose;
begin
  FActive := False;
  DestroyFilterExpr;
  FAutoInc := 1;
  FRecordsView.Aggregates.Reset;
  BindFields(False);
  if DefaultFields then
    DestroyFields;
  if FInstantBuffer <> nil then
  begin
    FreeRecordBuffer(FInstantBuffer);
    FInstantBuffer := nil;
  end;
  if (ProviderDataSet <> nil) and ProviderDataSet.Active then
  begin
    ClearRecords;
    ProviderDataSet.Close;
  end;
end;

procedure TCustomMemTableEh.InternalHandleException;
begin
  Application.HandleException(Self);
end;

procedure TCustomMemTableEh.InternalInitFieldDefs;
begin
  FRecordsView.MemTableData.DataStruct.BuildFieldDefsFromStruct(FieldDefs);
//  if FRecordsView.MemTableData.DataStruct.Count > 0 then
//   FRecordsView.MemTableData.DataStruct.BuildStructFromFields(ProviderDataSet.Fields)

{  if (ProviderDataSet <> nil) then
  begin
    ProviderDataSet.Active := True;
    FieldDefs.Assign(ProviderDataSet.FieldDefs);
  end;
}
end;

function TCustomMemTableEh.IsCursorOpen: Boolean;
begin
  Result := FActive;
end;

{ Informational }

function TCustomMemTableEh.GetRecordCount: Integer;
begin
  CheckActive;
  Result := FRecordsView.Count;
end;

function TCustomMemTableEh.GetRecNo: Integer;
var
  RecBuf: PRecBuf;
begin
  CheckActive;
//  UpdateCursorPos;
  Result := -1;
  if not GetActiveRecBuf(PChar(RecBuf))
    then Exit
    else Result := PRecBuf(RecBuf)^.RecInfo.RecordNumber + 1;
//  if (FRecordPos = -1) and (RecordCount > 0)
//    then Result := 1
//    else Result := FRecordPos + 1;
end;

procedure TCustomMemTableEh.SetRecNo(Value: Integer);
begin
  if (Value > 0) and (Value <= FRecordsView.Count) then
  begin
    FRecordPos := Value - 1;
    Resync([]);
  end;
end;

function TCustomMemTableEh.IsSequenced: Boolean;
begin
  Result := True;
end;

function TCustomMemTableEh.FindRec(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Integer;

var
  Fields: TList;
  I: Integer;

  function CompareField(Field: TField; Value: Variant): Boolean;
  var
    S: string;
  begin
    if Field.DataType = ftString then
    begin
      S := Field.AsString;
      if (loPartialKey in Options) then
        System.Delete(S, Length(Value) + 1, MaxInt);
      if (loCaseInsensitive in Options) then
        Result := AnsiCompareText(S, Value) = 0
      else
        Result := AnsiCompareStr(S, Value) = 0;
    end
    else
      Result := (Field.Value = Value);
  end;

  function CompareRecord: Boolean;
  var
    I: Integer;
  begin
    if Fields.Count = 1 then
      Result := CompareField(TField(Fields.First), KeyValues)
    else begin
      Result := True;
      for I := 0 to Fields.Count - 1 do
        Result := Result and CompareField(TField(Fields[I]), KeyValues[I]);
    end;
  end;

begin
  Result := -1;
  Fields := TList.Create;
  try
    GetFieldList(Fields, KeyFields);

    for I := 0 to RecordCount-1 do
    begin
      InstantReadEnter(I);
      try
        if CompareRecord then
        begin
          Result := I;
          Break;
        end;
      finally
        InstantReadLeave;