memtableeh.pas

最新的 DBGRIDEH4.0

        if NativeFormat then
        begin
          TimeStamp := DateTimeToTimeStamp(TDateTime(Value));
          case Field.DataType of
            ftDate:
              Marshal.WriteInt32(Buffer, TimeStamp.Date);
           ftTime:
             Marshal.WriteInt32(Buffer, TimeStamp.Time);
           ftDateTime:
             begin
               D := TimeStampToMSecs(TimeStamp);
               Marshal.WriteInt64(Buffer, BitConverter.DoubleToInt64Bits(D));
             end;
          end;
        end
        else
          Marshal.WriteInt64(Buffer, BitConverter.DoubleToInt64Bits(Double(Value)));
      ftBytes:
        Marshal.Copy(TBytes(TObject(Value)), 0, Buffer,
          Length(TBytes(TObject(Value))));
      ftVarBytes:
        begin
          Len := Length(TBytes(TObject(Value)));
          if NativeFormat then
          begin
            Marshal.WriteInt16(Buffer, Len);
            Marshal.Copy(TBytes(TObject(Value)), 0, IntPtr(Integer(Buffer.ToInt32 + 2)), Len);
          end else
            Marshal.Copy(TBytes(TObject(Value)), 0, Buffer, Len);
        end;
      ftTimeStamp:
        Marshal.StructureToPtr(TObject(Value), Buffer, False);
      ftFMTBCD:
        Marshal.Copy(TBcd.ToBytes(Value), 0, Buffer, SizeOfTBCD);
      else
        DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[Field.DataType], Field.DisplayName]);
    end;
  end;
{$ELSE}
  procedure VarToBuffer(var Value: Variant);
  begin
    case Field.DataType of
      ftGuid, ftFixedChar, ftString:
        begin
          PChar(Buffer)[Field.Size] := #0;
          StrLCopy(PChar(Buffer), PChar(VarToStr(Value)), Field.Size);
        end;
      ftWideString:
{$IFDEF EH_LIB_10}
        WStrCopy(PWideChar(Buffer), PWideChar(VarToWideStr(Value)));
{$ELSE}
        WideString(Buffer^) := Value;
{$ENDIF}
      ftSmallint:
          SmallInt(Buffer^) := Value;
      ftWord:
          Word(Buffer^) := Value;
      ftAutoInc, ftInteger:
        Integer(Buffer^) := Value;
      ftFloat, ftCurrency:
          Double(Buffer^) := Value;
      ftBCD:
        if NativeFormat
          then DataConvert(Field, @Value, Buffer, True)
          else Currency(Buffer^) := Value;
      ftBoolean:
        WordBool(Buffer^) := Value;
      ftDate, ftTime, ftDateTime:
        if NativeFormat
          then DataConvert(Field, @TVarData(Value).VDate, Buffer, True)
          else TDateTime(Buffer^) := Value;
      ftBytes, ftVarBytes:
        if NativeFormat
          then DataConvert(Field, @Value, Buffer, True)
          else Variant(Buffer^) := Value;
      ftInterface: IUnknown(Buffer^) := Value;
      ftIDispatch: IDispatch(Buffer^) := Value;
{$IFDEF EH_LIB_6}
      ftLargeInt: LargeInt(Buffer^) := Value;
      ftTimeStamp:
        if NativeFormat
          then DataConvert(Field, @Value, Buffer, True)
          else TSQLTimeStamp(Buffer^) := VarToSQLTimeStamp(Value);
      ftFMTBcd:
        if NativeFormat
          then DataConvert(Field, @Value, Buffer, True)
          else TBcd(Buffer^) := VarToBcd(Value);
{$ENDIF}
      ftBlob..ftTypedBinary, ftVariant: Variant(Buffer^) := Value;
{$IFDEF EH_LIB_10}
      ftWideMemo: Variant(Buffer^) := Value;
{$ENDIF}
    else
      DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[Field.DataType],
        Field.DisplayName]);
    end;
  end;
{$ENDIF}

var
  OutValue: Variant;
begin
  Result := GetActiveRecBuf(RecBuf);
  if not Result then Exit;
//  if Field.FieldNo > 0
//    then FieldBufNo := Field.Index //???Field.FieldNo - 1
//    else FieldBufNo := {Field.Offset}FCalcFieldIndexes[Field.Index] + DataFieldsCount;

  if Field.FieldKind = fkAggregate then
    OutValue := GetAggregateValue(Field)
  else
  begin
//    FieldBufNo := Field.Index;
//    OutValue := RecBuf.Values[FieldBufNo];
    OutValue := RecBuf.Value[Field];
    if Assigned(FOnGetFieldValue) then
      FOnGetFieldValue(Self, Field, OutValue);
  end;

  if VarIsNull(OutValue) then
    Result := False
  else if Buffer <> nil then
    VarToBuffer(OutValue);
end;

function TCustomMemTableEh.GetFieldData(Field: TField; Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}Pointer{$ENDIF}): Boolean;
begin
  Result := GetFieldData(Field, Buffer, True);
end;

function TCustomMemTableEh.GetFieldData(FieldNo: Integer; Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}Pointer{$ENDIF}): Boolean;
begin
  Result := GetFieldData(FieldByNumber(FieldNo), Buffer);
end;

function TCustomMemTableEh.GetFieldDataAsObject(Field: TField; var Value: TObject): Boolean;
var
  RecBuf: TRecBuf;
//  FieldBufNo: Integer;
  OutValue: Variant;
begin
  Value := nil;
  Result := GetActiveRecBuf(RecBuf);
  if not Result then Exit;
//  FieldBufNo := Field.Index;

//  OutValue := RecBuf.Values[FieldBufNo];
  OutValue := RecBuf.Value[Field];
  if Assigned(FOnGetFieldValue) then
    FOnGetFieldValue(Self, Field, OutValue);

  if VarIsNull(OutValue)
    then Result := False
    else Value := VariantToRefObject(OutValue);
end;

procedure TCustomMemTableEh.SetFieldData(Field: TField;
  Buffer: {$IFDEF CIL}TValueBuffer{$ELSE}Pointer{$ENDIF}; NativeFormat: Boolean);
var
  RecBuf: TRecBuf;
//  FieldBufNo: Integer;
  v: Variant;

{$IFDEF CIL}
  procedure BufferToVar(var Data: Variant);
  var
    B: TBytes;
    Len: Smallint;
  begin
    case Field.DataType of
      ftWideString:
        Data := Variant(Marshal.PtrToStringUni(Buffer));
      ftString, ftGuid, ftFixedChar:
        Data := Variant(Marshal.PtrToStringAnsi(Buffer));
      ftSmallint, ftWord:
        Data := Variant(Marshal.ReadInt16(Buffer));
      ftAutoInc, ftInteger:
        Data := Variant(Marshal.ReadInt32(Buffer));
      ftLargeInt:
        Data := Variant(Marshal.ReadInt64(Buffer));
      ftBoolean:
        if Marshal.ReadInt16(Buffer) <> 0 then
          Data := Variant(True)
        else
          Data := Variant(False);
      ftFloat, ftCurrency:
        Data := Variant(BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Buffer)));
      ftBCD:
        if NativeFormat then
        begin
          SetLength(B, SizeOfTBCD);
          Marshal.Copy(Buffer, B, 0, SizeOfTBCD);
          Data := Variant(TBcd.FromBytes(B));
        end
        else
          Data := System.Decimal.FromOACurrency(Marshal.ReadInt64(Buffer));
      ftDate, ftTime, ftDateTime:
        if NativeFormat then
        begin
          case Field.DataType of
            ftDate:
              Data := System.DateTime.Create(0).AddDays(Marshal.ReadInt32(Buffer));
            ftTime:
              Data := System.DateTime.Create(0).AddMilliseconds(
                Marshal.ReadInt32(Buffer));
            ftDateTime:
              Data := System.DateTime.Create(0).AddMilliseconds(
                BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Buffer)));
          end;
        end
        else // data is TDateTime
          Data := System.DateTime.FromOADate(BitConverter.Int64BitsToDouble(
            Marshal.ReadInt64(Buffer)));
      ftBytes:
      begin
        SetLength(B, Field.Size);
        Marshal.Copy(Buffer, B, 0, Field.Size);
        Data := Variant(B);
      end;
      ftTimeStamp:
        Data := Variant(Marshal.PtrToStructure(Buffer, TypeOf(TSQLTimeStamp)));
      ftFMTBCD:
      begin
        SetLength(B, SizeOfTBCD);
        Marshal.Copy(Buffer, B, 0, SizeOfTBCD);
        Data := Variant(TBcd.FromBytes(B));
      end;
      ftVarBytes:
        if NativeFormat then
        begin
          Len := Marshal.ReadInt16(Buffer);
          SetLength(B, Len);
          Marshal.Copy(IntPtr(Integer(Buffer.ToInt32 + 2)), B, 0, Len);
          Data := Variant(B);
        end else
        begin
          {note, we cant support VarBytes if not length prefixed}
          DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[ftVarBytes],
              Field.DisplayName]);
          Data := nil; // never gets called but this makes the compiler happy
        end
      else
      begin
        {note, we cant support blob types in this way}
        DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[Field.DataType],
            Field.DisplayName]);
        Data := nil; // never gets called but this makes the compiler happy
      end;
    end;
  end;
{$ELSE}
  procedure BufferToVar(var Data: Variant);
  begin
    case Field.DataType of
      ftString, ftFixedChar, ftGuid:
        Data := String(PChar(Buffer));
//        SetString(Data, PChar(Buffer), StrLen(PChar(Buffer)));
      ftWideString:
{$IFDEF EH_LIB_10}
        Data := WideString(PWideChar(Buffer));
{$ELSE}
        Data := WideString(Buffer^);
{$ENDIF}
//        WStrCopy(PWideChar(Data), PWideChar(VarToWideStr(Buffer)));
      ftAutoInc, ftInteger:
        Data := LongInt(Buffer^);
      ftSmallInt:
        Data := SmallInt(Buffer^);
      ftWord:
        Data := Word(Buffer^);
      ftBoolean:
        Data := WordBool(Buffer^);
      ftFloat, ftCurrency:
        Data := Double(Buffer^);
      ftBlob, ftMemo, ftGraphic, ftVariant:
        Data := Variant(Buffer^);
      ftInterface:
        Data := IUnknown(Buffer^);
      ftIDispatch:
        Data := IDispatch(Buffer^);
      ftDate, ftTime, ftDateTime:
        if NativeFormat
          then DataConvert(Field, Buffer, @TVarData(Data).VDate, False)
          else Data := TDateTime(Buffer^);
      ftBCD:
        if NativeFormat
          then DataConvert(Field, Buffer, @TVarData(Data).VCurrency, False)
          else Data := Currency(Buffer^);
      ftBytes, ftVarBytes:
        if NativeFormat
          then DataConvert(Field, Buffer, @Data, False)
          else Data := Variant(Buffer^);
{$IFDEF EH_LIB_10}
      ftWideMemo: Data := Variant(Buffer^);
{$ENDIF}
{$IFDEF EH_LIB_6}
      ftLargeInt:
          Data := Int64(Buffer^);
      ftTimeStamp:
        if NativeFormat
          then DataConvert(Field, Buffer, @Data, True)
          else Data :=  VarSQLTimeStampCreate(TSQLTimeStamp(Buffer^));
      ftFMTBcd:
        if NativeFormat
          then DataConvert(Field, Buffer, @Data, True)
          else Data := VarFMTBcdCreate(TBcd(Buffer^));
{$ENDIF}
      else
        DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[Field.DataType],
          Field.DisplayName]);
    end;
  end;
{$ENDIF}

begin
  if not (State in dsWriteModes) then DatabaseError(SNotEditing, Self);
  if not GetActiveRecBuf(RecBuf, True) then Exit;

//  if Field.FieldNo > 0
//    then FieldBufNo := Field.FieldNo - 1
//    else FieldBufNo := FCalcFieldIndexes[Field.Index] + DataFieldsCount;
//  FieldBufNo := Field.Index;

  Field.Validate(Buffer);

  if Buffer = nil
    then v := Null
    else BufferToVar(v);

  if Assigned(FOnSetFieldValue) then
    FOnSetFieldValue(Self, Field, v);

  RecBuf.Value[Field] := v;

  if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
{$IFDEF CIL}
    DataEvent(deFieldChange, Field);
{$ELSE}
    DataEvent(deFieldChange, Longint(Field));
{$ENDIF}
end;

procedure TCustomMemTableEh.SetFieldData(Field: TField;
  Buffer: {$IFDEF CIL}TValueBuffer{$ELSE}Pointer{$ENDIF});
begin
  SetFieldData(Field, Buffer, True);
end;

procedure TCustomMemTableEh.SetFieldDataAsObject(Field: TField; Value: TObject);
var
  RecBuf: TRecBuf;
//  FieldBufNo: Integer;
  v: Variant;
begin
  if not (State in dsWriteModes) then DatabaseError(SNotEditing, Self);
  if not GetActiveRecBuf(RecBuf, True) then Exit;

//  FieldBufNo := Field.Index;

  if Value = nil
    then v := Null
//    else BufferToVar(RecBuf.Values[FieldBufNo]);
    else v := RefObjectToVariant(Value);

  if Assigned(FOnSetFieldValue) then
    FOnSetFieldValue(Self, Field, v);

  RecBuf.Value[Fiel