memtableeh.pas

增加了条件求和功能

    case FieldType of
      ftString: Inc(Result);
      ftSmallint: Result := SizeOf(SmallInt);
      ftInteger: Result := SizeOf(Longint);
      ftWord: Result := SizeOf(Word);
      ftBoolean: Result := SizeOf(WordBool);
      ftFloat: Result := SizeOf(Double);
      ftCurrency: Result := SizeOf(Double);
      ftBCD: Result := 34;
      ftDate, ftTime: Result := SizeOf(Longint);
      ftDateTime: Result := SizeOf(TDateTime);
      ftBytes: Result := Size;
      ftVarBytes: Result := Size + 2;
      ftAutoInc: Result := SizeOf(Longint);
      ftADT: Result := 0;
      ftFixedChar: Inc(Result);
      ftWideString: Result := (Result + 1) * 2;
      ftLargeint: Result := SizeOf(Int64);
{$IFDEF EH_LIB_5}
      ftVariant: Result := SizeOf(Variant);
      ftGuid: Result := GuidSize + 1;
{$ENDIF}
    end;
  end;
end;

procedure CalcDataSize(FieldDef: TFieldDef; var DataSize: Integer);
var
  I: Integer;
begin
  with FieldDef do
  begin
    if (DataType in ftSupported - ftBlobTypes) then
      Inc(DataSize, CalcFieldLen(DataType, Size) + 1);
    for I := 0 to ChildDefs.Count - 1 do
      CalcDataSize(ChildDefs[I], DataSize);
  end;
end;

procedure Error(const Msg: string);
begin
  DatabaseError(Msg);
end;

procedure ErrorFmt(const Msg: string; const Args: array of const);
begin
  DatabaseErrorFmt(Msg, Args);
end;

//{$DEBUGINFO OFF}
function VarEquals(const V1, V2: Variant): Boolean;
var i: Integer;
begin
  Result := not (VarIsArray(V1) xor VarIsArray(V2));
  if not Result then Exit;
  Result := False;
  try
    if VarIsArray(V1) and VarIsArray(V2) and
      (VarArrayDimCount(V1) = VarArrayDimCount(V2)) and
      (VarArrayLowBound(V1, 1) = VarArrayLowBound(V2, 1)) and
      (VarArrayHighBound(V1, 1) = VarArrayHighBound(V2, 1))
      then
      for i := VarArrayLowBound(V1, 1) to VarArrayHighBound(V1, 1) do
      begin
        Result := V1[i] = V2[i];
        if not Result then Exit;
      end
    else
      Result := V1 = V2;
  except
  end;
end;
//{$DEBUGINFO ON}

function GetOldFieldValue(DataSet: TDataSet; const FieldName: string): Variant;
var
  I: Integer;
  Fields: TList;
begin
  if Pos(';', FieldName) <> 0 then
  begin
    Fields := TList.Create;
    try
      DataSet.GetFieldList(Fields, FieldName);
      Result := VarArrayCreate([0, Fields.Count - 1], varVariant);
      for I := 0 to Fields.Count - 1 do
        Result[I] := TField(Fields[I]).OldValue;
    finally
      Fields.Free;
    end;
  end else
    Result := DataSet.FieldByName(FieldName).OldValue
end;

{ TMasterDataLinkEh }

constructor TMasterDataLinkEh.Create(DataSet: TDataSet);
begin
  inherited Create;
  FDataSet := DataSet;
  FFields := TList.Create;
end;

destructor TMasterDataLinkEh.Destroy;
begin
  FFields.Free;
  inherited Destroy;
end;

procedure TMasterDataLinkEh.ActiveChanged;
begin
  FFields.Clear;
  if Active then
    try
      DataSet.GetFieldList(FFields, FFieldNames);
    except
      FFields.Clear;
      raise;
    end;
  if FDataSet.Active and not (csDestroying in FDataSet.ComponentState) then
    if Active {and (FFields.Count > 0)} then
    begin
      if Assigned(FOnMasterChange) then FOnMasterChange(Self);
    end else
      if Assigned(FOnMasterDisable) then FOnMasterDisable(Self);
end;

procedure TMasterDataLinkEh.CheckBrowseMode;
begin
  if FDataSet.Active then FDataSet.CheckBrowseMode;
end;

function TMasterDataLinkEh.GetDetailDataSet: TDataSet;
begin
  Result := FDataSet;
end;

procedure TMasterDataLinkEh.LayoutChanged;
begin
  ActiveChanged;
end;

procedure TMasterDataLinkEh.RecordChanged(Field: TField);
begin
  if (DataSource.State <> dsSetKey) and FDataSet.Active and
    {(FFields.Count > 0) and }((Field = nil) or
    (FFields.IndexOf(Field) >= 0)) and
     Assigned(FOnMasterChange)
  then
    FOnMasterChange(Self);
end;

procedure TMasterDataLinkEh.SetFieldNames(const Value: string);
begin
  if FFieldNames <> Value then
  begin
    FFieldNames := Value;
    ActiveChanged;
  end;
end;

{ TCustomMemTableEh }

constructor TCustomMemTableEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRecordPos := -1;
  FInstantReadCurRow := -1;
  FAutoInc := 1;
  FRecordsView := TRecordsViewEh.Create(Self);
  FRecordsView.OnFilterRecord := IsRecordInFilter;
  FMasterDataLink := TMasterDataLinkEh.Create(Self);
  FMasterDataLink.OnMasterChange := MasterChange;
  FDetailFieldList := TList.Create;
  FParams := TParams.Create(Self);
  FFilterExpr := TDataSetExprParserEh.Create(Self, dsptFilterEh);
end;

destructor TCustomMemTableEh.Destroy;
begin
  Close;
  FFilterExpr.Free;
  FParams.Free;
  FDetailFieldList.Clear;
  FDetailFieldList.Free;
  ClearRecords;
  FRecordsView.Free;
  FMasterDataLink.Free;
  inherited Destroy;
end;

{ Field Management }

{$IFNDEF EH_LIB_5}

function TCustomMemTableEh.BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
begin
  Move(BCD^, Curr, SizeOf(Currency));
  Result := True;
end;

function TCustomMemTableEh.CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  Decimals: Integer): Boolean;
begin
  Move(Curr, BCD^, SizeOf(Currency));
  Result := True;
end;

{$ENDIF EH_LIB_5}

procedure TCustomMemTableEh.InitFieldDefsFromFields;
var
  I: Integer;
begin
  if FieldDefs.Count = 0 then
  begin
    for I := 0 to FieldCount - 1 do
    begin
      with Fields[I] do
        if (FieldKind in fkStoredFields) and not (DataType in ftSupported) then
          ErrorFmt(SUnknownFieldType, [DisplayName]);
    end;
//    FreeIndexList;
  end;

  inherited InitFieldDefsFromFields;
end;

function TCustomMemTableEh.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
//var
//  Index: Integer;
begin
{ddd  Index := FieldDefList.IndexOf(Field.FullName);
  if (Index >= 0) and (Buffer <> nil) and
    (FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then
    Result := (PChar(Buffer) + FOffsets[Index])
  else Result := nil;
}
{  if (Buffer <> nil)
    then Result := PRecValues(Buffer)^[Field.FieldNo]
    else Result := nil;}
  Result := nil;
end;

{ Buffer Manipulation }

procedure TCustomMemTableEh.InitBufferPointers(GetProps: Boolean);
begin
  if GetProps then
    FDataRecordSize := (Fields.Count * SizeOf(OleVariant));

  FRecBufSize := SizeOf(TRecInfo) + (Fields.Count * SizeOf(Pointer));
end;

procedure TCustomMemTableEh.ClearRecords;
begin
  RecordsView.MemTableData.RecordsList.Clear;
  FRecordPos := -1;
  FInstantReadCurRow := -1;
end;

function TCustomMemTableEh.AllocRecordBuffer: PChar;
var
  RecBuf: PRecBuf;
  I: Integer;
begin
  New(RecBuf);
  SetLength(RecBuf^.Values, FieldCount);
  for I := 0 to Fields.Count - 1 do
    RecBuf^.Values[I].IsNull := True;
  RecBuf^.RecInfo.RecordStatus := -1;
  Result := PChar(RecBuf);
end;

procedure TCustomMemTableEh.FreeRecordBuffer(var Buffer: PChar);
var
  RecBuf: PRecBuf;
begin
  RecBuf := PRecBuf(Buffer);
  SetLength(RecBuf^.Values, 0);
  Dispose(RecBuf);
  Buffer := nil;
end;

procedure TCustomMemTableEh.ClearCalcFields(Buffer: PChar);
var
  I: Integer;
begin
  if CalcFieldsSize > 0 then
    for I := 0 to Fields.Count - 1 do
      with Fields[I] do
        if FieldKind in [fkCalculated, fkLookup] then
          PRecBuf(Buffer)^.Values[Offset + DataFieldsCount].IsNull := True;
end;

procedure TCustomMemTableEh.InternalInitRecord(Buffer: PChar);
var
  I: Integer;
begin
  for I := 0 to Fields.Count - 1 do
    PRecBuf(Buffer)^.Values[I].IsNull := True;
end;

procedure TCustomMemTableEh.InitRecord(Buffer: PChar);
begin
  inherited InitRecord(Buffer);

  with PRecBuf(Buffer)^.RecInfo do
  begin
    Bookmark := Low(TRecIdEh);
    BookmarkFlag := bfInserted;
//    RecordStatus := 0;
    RecordNumber := FRecordPos;
  end;
end;

function TCustomMemTableEh.GetCurrentRecord(Buffer: PChar): Boolean;
begin
  Result := False;
{  if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  begin
    UpdateCursorPos;
    if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
    begin
      Move(FRecords[FRecordPos]^, Buffer^, FDataRecordSize);
      Result := True;
    end;
  end;
}
end;

procedure TCustomMemTableEh.RecordToBuffer(Rec: PRecValues; Buffer: PChar);
var
  i: Integer;
begin

  with PRecBuf(Buffer)^.RecInfo do
  begin
//    RecordStatus := 0; //Recordset.Status;
    BookmarkFlag := bfCurrent;
//    Bookmark := FRecordPos;
  end;

  // Don't need assign data values
  // Will do in on first SetFieldData
  for i := 0 to FieldCount-1 do
    if Fields[i].FieldNo > 0 then
//      VarValueToFieldValue(Rec^[Fields[i].FieldNo-1], @(PRecBuf(Buffer)^.Values[i]), Fields[i]);
      VarValueToFieldValue(Rec^[Fields[i].FieldNo-1], @(PRecBuf(Buffer)^.Values[Fields[i].FieldNo-1]), Fields[i]);


  GetCalcFields(Buffer);
end;

procedure TCustomMemTableEh.CopyBuffer(FromBuf, ToBuf: PChar);
var
  i:Integer;
begin
  PRecBuf(ToBuf)^.RecInfo := PRecBuf(FromBuf)^.RecInfo;
  SetLength(PRecBuf(ToBuf)^.Values, Length(PRecBuf(FromBuf)^.Values));
  for i := 0 to Length(PRecBuf(FromBuf)^.Values)-1 do
  begin
    PRecBuf(ToBuf)^.Values[i].IsNull := PRecBuf(FromBuf)^.Values[i].IsNull;
    SetString(PRecBuf(ToBuf)^.Values[i].DataValue,
      PChar(PRecBuf(FromBuf)^.Values[i].DataValue),
      Length(PRecBuf(FromBuf)^.Values[i].DataValue));
  end;
end;

procedure TCustomMemTableEh.VarValueToFieldValue(VarValue: Variant; FieldBuffer: Pointer; Field: TField);

var
  FieldValBuf: PFieldValBuf;
  DataValueBuf: Pointer;
  StrVal: String;

  procedure CurrToBuffer(const C: Currency);
  begin
    Currency(DataValueBuf^) := C;
  end;

begin
  FieldValBuf := PFieldValBuf(FieldBuffer);
  FieldValBuf.IsNull := False;
  if VarIsNull(VarValue) then
    FieldValBuf.IsNull := True
  else
  begin
    SetLength(FieldValBuf.DataValue, Field.DataSize);
//    SetString(FieldValBuf.DataValue, Field.DataSize);
    DataValueBuf := PChar(FieldValBuf.DataValue);
//    GetMem(FieldBuffer, Field.DataSize);
    case Field.DataType of
      ftGuid, ftFixedChar, ftString:
        StrPLCopy(PChar(DataValueBuf), VarToStr(VarValue), Field.Size);
//        SetString(FieldValBuf.DataValue, PChar(VarToStr(VarValue)), Field.Size);
      ftWideString:
        WideString(DataValueBuf^) := VarValue;
      ftSmallint:
        SmallInt(DataValueBuf^) := VarValue;
      ftWord:
        Word(DataValueBuf^) := VarValue;
      ftAutoInc, ftInteger:
        Integer(DataValueBuf^) := VarValue;
      ftFloat, ftCurrency:
        Double(DataValueBuf^) := VarValue;
      ftBCD:
        CurrToBuffer(VarValue);
      ftBoolean:
        WordBool(DataValueBuf^) := VarValue;
      ftDate, ftTime, ftDateTime:
        DataConvert(Field, @TVarData(VarValue).VDate, DataValueBuf, True);
      ftBytes, ftVarBytes:
        DataConvert(Field, @TVarData(VarValue).VDate, DataValueBuf, True);
      ftInterface: IUnknown(DataValueBuf^) := VarValue;
      ftIDispatch: IDispatch(DataValueBuf^) := VarValue;
{$IFDEF EH_LIB_6}
      ftLargeInt: LargeInt(DataValueBuf^) := VarValue;
{$ENDIF}
      ftBlob..ftTypedBinary, ftOraBlob, ftOraClob:
      begin
        StrVal := VarToStr(VarValue);
        SetString(FieldValBuf.DataValue, PChar(StrVal), Length(StrVal));
      end;
      {ftBlob..ftTypedBinary,} ftVariant: Variant(DataValueBuf^) := VarValue;
    else
      DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[Field.DataType],
        Field.DisplayName]);
    end;
  end;
end;

procedure TCustomMemTableEh.FieldValueToVarValue(FieldBuffer: Pointer; var VarValue: Variant; Field: TField);
var
  FieldValBuf: PFieldValBuf;
  DataValueBuf: Pointer;
  DateVal: TDateTime;
  CurrencyVal: Currency;