memtableeh.pas

Ehlib 4.14 full source for bds2006

procedure TCustomMemTableEh.InitRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
begin
  inherited InitRecord(Buffer);

  with BufferToRecBuf(Buffer) do
  begin
    Bookmark := Low(Integer);
    BookmarkFlag := bfInserted;
//    RecordStatus := 0;
    RecordNumber := -1;
  end;
end;

function TCustomMemTableEh.GetCurrentRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): 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(MemRec: TMemoryRecordEh;
  DataValueVersion: TDataValueVersionEh;
  Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}; RecIndex: Integer);
var
  i: Integer;
begin

  with BufferToRecBuf(Buffer) do
  begin
    Bookmark := RecIndex + 1; //FRecordsView.ViewRecord[FRecordPos].ID;
    RecordNumber := RecIndex;
    BookmarkFlag := bfCurrent;
//    RecordStatus := 0; //Recordset.Status;
  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
      BufferToRecBuf(Buffer).Values[Fields[i].Index] := MemRec.Value[Fields[i].FieldNo-1, dvvValueEh];
//      VarValueToFieldValue(MemRec.Value[Fields[i].FieldNo-1, dvvValueEh],
//        @(PRecBuf(Buffer)^.Values[Fields[i].Index]), Fields[i]);

  GetCalcFields(Buffer);
end;

procedure TCustomMemTableEh.SetMemoryRecordData(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
  Rec: TMemoryRecordEh);
var
  i: Integer;
begin
  if State = dsFilter then
    Error(SNotEditing);
  for i := 0 to FieldCount-1 do
    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.RecView := FromRecBuf.RecView;
  ToRecBuf.MemRec := FromRecBuf.MemRec;
//  ToRecBuf.RecordsView := FromRecBuf.RecordsView;

  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;
//  if (BufferToRecBuf(Buffer).BookmarkFlag = bfCurrent) and (State in dsEditModes) then
//    Exit;
  case GetMode of
    gmPrior:
      if FRecordPos <= 0 then
      begin
        Result := grBOF;
        FRecordPos := -1;
        FInstantReadCurRowNum := 0;
      end else
        Dec(FRecordPos);
    gmCurrent:
      if (FRecordPos < 0) or (FRecordPos >= RecordsView.ViewItemsCount) then
        Result := grError;
    gmNext:
      begin
        if FRecordPos >= FRecordsView.ViewItemsCount - 1 then
        begin
          BeginRecordsViewUpdate;
          try
            if FetchAllOnOpen
              then DoFetchRecords(-1)
              else DoFetchRecords(1);
          finally
            EndRecordsViewUpdate(False);
          end;
        end;
        if FRecordPos >= FRecordsView.ViewItemsCount - 1 then
        begin
          FRecordPos := FRecordsView.ViewItemsCount;
          Result := grEOF
        end else
          Inc(FRecordPos);
      end;
  end;
  if FRecordPos >= 0 then
    FInstantReadCurRowNum := FRecordPos;
  if Result = grOk then
  begin
    RecordToBuffer(FRecordsView.ViewRecord[FRecordPos], dvvValueEh, Buffer, FRecordPos);
//    BufferToRecBuf(Buffer).Bookmark := FRecordPos + 1;//FRecordsView.ViewRecord[FRecordPos].ID;
//    BufferToRecBuf(Buffer).RecordNumber := FRecordPos;
    BufferToRecBuf(Buffer).MemRec := FRecordsView.ViewRecord[FRecordPos];
//    BufferToRecBuf(Buffer).RecordsView := FRecordsView;
    if FRecordsView.ViewAsTreeList
      then BufferToRecBuf(Buffer).RecView := FRecordsView.MemoryTreeList.VisibleItem[FRecordPos]
      else BufferToRecBuf(Buffer).RecView := nil;
  end else if (Result = grError) and DoCheck then
    Error(SMemNoRecords);
end;

procedure TCustomMemTableEh.Resync(Mode: TResyncMode);
begin
  if FRecordsViewUpdating = 0
    then inherited Resync(Mode)
    else FRecordsViewUpdated := True;
end;

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

function TCustomMemTableEh.GetActiveRecBuf(var RecBuf: TRecBuf; IsForWrite: Boolean): 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, FRecordPos);
    end else
      Result := nil;
  end;

var
  Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
begin
  if FInstantReadMode and not IsForWrite then
    RecBuf := BufferToRecBuf(InstantBuffer)
  else
    case State of
      dsBrowse:
        if IsEmpty
          then RecBuf := nil
          else RecBuf := BufferToRecBuf(ActiveBuffer);
      dsOldValue:
        begin
          Buffer := GetOldValuesBuffer;
          if Buffer <> nil then
          begin
            RecBuf := BufferToRecBuf(Buffer);
            if RecBuf = nil then
              RecBuf := BufferToRecBuf(ActiveBuffer)
          end else
            RecBuf := nil;
        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