memtableeh.pas

bcb/delphi 数据库控件源码,包括DBgrid等控件

          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;
    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;
  FieldBufNo := Field.Index;

//  PVarValue := @(PRecBuf(RecBuf)^.Values[FieldBufNo]);

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

  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];
  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;

{$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:
        Data := WideString(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_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 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 RecBuf.Values[FieldBufNo] := Null
    else BufferToVar(RecBuf.Values[FieldBufNo]);

  if Assigned(FOnSetFieldValue) then
    FOnSetFieldValue(Self, Field, RecBuf.Values[FieldBufNo]);

  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;
begin
  if not GetActiveRecBuf(RecBuf, True) then Exit;

  FieldBufNo := Field.Index;

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

  if Assigned(FOnSetFieldValue) then
    FOnSetFieldValue(Self, Field, RecBuf.Values[FieldBufNo]);

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

{ Filter }

procedure TCustomMemTableEh.RecreateFilterExpr;
begin
  if Filtered
    then FFilterExpr.ParseExpression(Filter)
    else FFilterExpr.ParseExpression('');
end;

procedure TCustomMemTableEh.DestroyFilterExpr;
begin
  FFilterExpr.ParseExpression('');
end;

procedure TCustomMemTableEh.SetFilterText(const Value: string);
begin
  if Active then
  begin
    if Value <> Filter then
    begin
      inherited SetFilterText(Value);
      RecreateFilterExpr;
      Refresh;
    end;
  end else
    inherited SetFilterText(Value);
end;

procedure TCustomMemTableEh.SetFiltered(Value: Boolean);
begin
  if Active then
  begin
    CheckBrowseMode;
    if Filtered <> Value then
    begin
      inherited SetFiltered(Value);
      RecreateFilterExpr;
//      First;
      Refresh;
    end;
  end
  else inherited SetFiltered(Value);
end;

procedure TCustomMemTableEh.SetOnFilterRecord(const Value: TFilterRecordEvent);
begin
  if Active then
  begin
    CheckBrowseMode;
    inherited SetOnFilterRecord(Value);
    if Filtered then
      Refresh;
  end
  else inherited SetOnFilterRecord(Value);
end;

function TCustomMemTableEh.IsRecordInFilter(Rec: TMemoryRecordEh): Boolean;
var
  SaveState: TDataSetState;
  DetV, MasV: Variant;
begin
  Result := True;
  SaveState := dsInactive;
  if not IsCursorOpen then Exit;
  if (Filtered and (Assigned(OnFilterRecord) or (Filter <> '')) ) or FDetailMode then
  begin
    try
      if Assigned(OnFilterRecord) then
      begin
        SaveState := SetTempState(dsFilter);
        RecordToBuffer(Rec, dvvValueEh, TempBuffer, -1);
      end;

      if FFilterExpr.HasData then
        Result := FFilterExpr.IsCurRecordInFilter(Rec);

      if Filtered and Assigned(OnFilterRecord) then
        OnFilterRecord(Self, Result);

      if Result and FDetailMode and (MasterDetailSide in [mdsOnSelfEh, mdsOnSelfAfterProviderEh]) then
      begin
        if FDetailRecListActive then
          Result := (FDetailRecList.IndexOf(Rec) >= 0)
        else begin
          { TODO : Use FDetailFieldList for fast}
//          DetV := FieldValues[FDetailFields];
          DetV := Rec.DataV