memtableeh.pas

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

    if Fields[i].FieldNo > 0 then
      Rec.Value[Fields[i].FieldNo-1, dvvValueEh] :=
        BufferToRecBuf(Buffer).Values[Fields[i].Index];
//        FieldValueToVarValue(@PRecBuf(Buffer)^.Values[Fields[i].Index{FieldNo-1}], Fields[i]);
end;

procedure TCustomMemTableEh.CopyBuffer(FromBuf, ToBuf: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
var
  i: Integer;
  FromRecBuf, ToRecBuf: TRecBuf;
begin
  FromRecBuf := BufferToRecBuf(FromBuf);
  ToRecBuf := BufferToRecBuf(ToBuf);
//  BufferToRecBuf(Buffer).RecInfo := BufferToRecBuf(Buffer).RecInfo;
  ToRecBuf.Bookmark := FromRecBuf.Bookmark;
  ToRecBuf.BookmarkFlag := FromRecBuf.BookmarkFlag;
  ToRecBuf.RecordStatus := FromRecBuf.RecordStatus;
  ToRecBuf.RecordNumber := FromRecBuf.RecordNumber;
  ToRecBuf.NewTreeNodeExpanded := FromRecBuf.NewTreeNodeExpanded;
  ToRecBuf.NewTreeNodeHasChildren := FromRecBuf.NewTreeNodeHasChildren;
  ToRecBuf.TreeNode := FromRecBuf.TreeNode;

  SetLength(ToRecBuf.Values, Length(FromRecBuf.Values));
  for i := 0 to Length(ToRecBuf.Values)-1 do
    ToRecBuf.Values[i] := FromRecBuf.Values[i];
end;

procedure TCustomMemTableEh.VarValueToFieldValue(VarValue: Variant;
  FieldBuffer: {$IFDEF CIL}TObject{$ELSE}Pointer{$ENDIF}; Field: TField);
//var
//  FieldValBuf: PFieldValBuf;
begin
//  FieldValBuf := PFieldValBuf(FieldBuffer);
//  FieldValBuf.VarValue := VarValue;
end;

function TCustomMemTableEh.FieldValueToVarValue(
  FieldBuffer: {$IFDEF CIL}TObject{$ELSE}Pointer{$ENDIF}; Field: TField): Variant;
//var
//  FieldValBuf: PFieldValBuf;
begin
//  FieldValBuf := PFieldValBuf(FieldBuffer);
//  Result := FieldValBuf^.VarValue;
  Result := Unassigned;
end;

function TCustomMemTableEh.GetRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
  GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
  Result := grOk;
  case GetMode of
    gmPrior:
      if FRecordPos <= 0 then
      begin
        Result := grBOF;
        FRecordPos := -1;
        FInstantReadCurRow := 0;
      end else
        Dec(FRecordPos);
    gmCurrent:
      if (FRecordPos < 0) or (FRecordPos >= RecordsView.ViewItemsCount) then
        Result := grError;
    gmNext:
      begin
        if FRecordPos >= FRecordsView.ViewItemsCount - 1 then
          if FetchAllOnOpen
            then DoFetchRecords(-1)
            else DoFetchRecords(1);
        if FRecordPos >= FRecordsView.ViewItemsCount - 1 then
        begin
          FRecordPos := FRecordsView.ViewItemsCount;
          Result := grEOF
        end else
          Inc(FRecordPos);
      end;
  end;
  if FRecordPos >= 0 then
    FInstantReadCurRow := FRecordPos;
  if Result = grOk then
  begin
    RecordToBuffer(FRecordsView.ViewRecord[FRecordPos], dvvValueEh, Buffer);
    BufferToRecBuf(Buffer).Bookmark := FRecordsView.ViewRecord[FRecordPos].ID;
    BufferToRecBuf(Buffer).RecordNumber := FRecordPos;
    if FRecordsView.ViewAsTreeList
      then BufferToRecBuf(Buffer).TreeNode := FRecordsView.MemoryTreeList.VisibleItems[FRecordPos]
      else BufferToRecBuf(Buffer).TreeNode := nil;
  end else if (Result = grError) and DoCheck then
    Error(SMemNoRecords);
end;

procedure TCustomMemTableEh.Resync(Mode: TResyncMode);
begin
  inherited Resync(Mode);
end;

function TCustomMemTableEh.GetRecordSize: Word;
begin
  Result := FRecBufSize;
end;

function TCustomMemTableEh.GetActiveRecBuf(var RecBuf: TRecBuf): Boolean;

  function GetOldValuesBuffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
  begin
    UpdateCursorPos;
    if FRecordsView.ViewRecord[FRecordPos].OldData <> nil then
    begin
      Result := TempBuffer;
      RecordToBuffer(FRecordsView.ViewRecord[FRecordPos], dvvOldValueEh, Result);
    end else
      Result := nil;
  end;

begin
  if FInstantReadMode then
    RecBuf := BufferToRecBuf(FInstantBuffer)
  else
    case State of
      dsBrowse:
        if IsEmpty
          then RecBuf := nil
          else RecBuf := BufferToRecBuf(ActiveBuffer);
      dsOldValue:
        begin
          RecBuf := BufferToRecBuf(GetOldValuesBuffer);
          if RecBuf = nil then
            RecBuf := BufferToRecBuf(ActiveBuffer);
        end;
      dsEdit, dsInsert, dsNewValue: RecBuf := BufferToRecBuf(ActiveBuffer);
      dsCalcFields: RecBuf := BufferToRecBuf(CalcBuffer);
      dsFilter: RecBuf := BufferToRecBuf(TempBuffer);
      else RecBuf := nil;
    end;
  Result := RecBuf <> nil;
end;

{ Field Data }

function TCustomMemTableEh.GetFieldData(Field: TField;
  Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}Pointer{$ENDIF}; NativeFormat: Boolean): Boolean;
var
//  PVarValue: PVariant;

  RecBuf: TRecBuf;
  FieldBufNo: Integer;


{$IFDEF CIL}
  procedure VarToBuffer(var Value: Variant);
  var
    B: TBytes;
    Len: Integer;
    TimeStamp: TTimeStamp;
    D: Double;
  begin
    case Field.DataType of
      ftWideString:
      begin
        B := WideBytesOf(Value.ToString);
        Len := Length(B);
        if Len > Field.Size * 2 then
        begin
          SetLength(B, Field.Size * 2);
          Len := Field.Size * 2;
        end;
        SetLength(B, Len + 2);
        B[Len - 1] := 0;
        B[Len] := 0; // add null terminator
        Marshal.Copy(B, 0, Buffer, Len + 2);
      end;
      ftString, ftGuid:
      begin
        B := BytesOf(Value.ToString);
        Len := Length(B);
        if Len > Field.Size then
        begin
          SetLength(B, Field.Size);
          Len := Field.Size;
        end;
        SetLength(B, Len + 1);
        B[Len] := 0; // add null terminator
        Marshal.Copy(B, 0, Buffer, Len + 1);
      end;
      ftFixedChar:
      begin
        B := BytesOf(System.String.Create(CharArray(Value)));
        Len := Length(B);
        if Len > Field.Size then
        begin
          SetLength(B, Field.Size);
          Len := Field.Size;
        end;
        SetLength(B, Len + 1);
        B[Len] := 0; // add null terminator
        Marshal.Copy(B, 0, Buffer, Len + 1);
      end;
      ftSmallint, ftWord:
        Marshal.WriteInt16(Buffer, SmallInt(Value));
      ftAutoInc, ftInteger:
        Marshal.WriteInt32(Buffer, Integer(Value));
      ftLargeInt:
        Marshal.WriteInt64(Buffer, Int64(Value));
      ftBoolean:
        if Boolean(Value) then
          Marshal.WriteInt16(Buffer, 1)
        else
          Marshal.WriteInt16(Buffer, 0);
      ftFloat, ftCurrency:
        Marshal.WriteInt64(Buffer, BitConverter.DoubleToInt64Bits(Value));
      ftBCD:
        if NativeFormat then
          Marshal.Copy(TBcd.ToBytes(Value), 0, Buffer, SizeOfTBCD)
        else
          Marshal.WriteInt64(Buffer, System.Decimal.ToOACurrency(System.Decimal(Value)));
      ftDate, ftTime, ftDateTime:
        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:
        WideString(Buffer^) := Value;
      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;
    else
      DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[Field.DataType],
        Field.DisplayName]);
    end;
  end;
{$ENDIF}

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

  if VarIsNull(RecBuf.Values[FieldBufNo]) then
    Result := False
  else if Buffer <> nil then
    VarToBuffer(RecBuf.Values[FieldBufNo]);
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)