memtableeh.pas

最新的 DBGRIDEH4.0

  RecBuf := TRecBuf.Create;
  ClearBuffer(RecBuf);
  RecBuf.RecordStatus := -2;
  RecBuf.RecView := nil;
  RecBuf.MemRec := nil;
//  RecBuf.RecordsView := nil;
  NewIndex := FRecordCache.Add(RecBuf);
  Result := InitializeBuffer(NewIndex);
end;

procedure TCustomMemTableEh.FreeRecordBuffer(var Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
var
//  RecBuf: TRecBuf;
  I{, J}: Integer;
begin

  I := BufferToIndex(Buffer);
  if (I = FRecordCache.Count - 1) and (BufferCount < FRecordCache.Count - 2) then
  begin
//    FRecordCache[FRecordCache.Count-1].Free;
    FRecordCache.Count := I;
  end else
  begin
    TRecBuf(FRecordCache[I]).InUse := False;
    TRecBuf(FRecordCache[I]).RecordNumber := -1;
//    for J := 0 to Length(TRecBuf(FRecordCache[I]).Values) - 1 do
//      TRecBuf(FRecordCache[I]).Values[J] := Null;
    TRecBuf(FRecordCache[I]).Clear;
    TRecBuf(FRecordCache[I]).RecView := nil;
    TRecBuf(FRecordCache[I]).MemRec := nil;
    TRecBuf(FRecordCache[I]).UseMemRec := False;
//    TRecBuf(FRecordCache[I]).RecordsView := nil;
  end;

{  RecBuf := PRecBuf(Buffer);
  SetLength(RecBuf^.Values, 0);
  Dispose(RecBuf);}
  Buffer := nil;
end;

procedure TCustomMemTableEh.ClearCalcFields(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
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
//          BufferToRecBuf(Buffer).Values[Index] := Null;
          BufferToRecBuf(Buffer).Value[Fields[I]] := Null;
end;

procedure TCustomMemTableEh.InternalInitRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
//var
//  I: Integer;
begin
//  for I := 0 to Fields.Count - 1 do
//    BufferToRecBuf(Buffer).Values[I] := Null;
  BufferToRecBuf(Buffer).Clear;
  BufferToRecBuf(Buffer).RecView := nil;
  BufferToRecBuf(Buffer).MemRec := nil;
  BufferToRecBuf(Buffer).UseMemRec := False;
//  BufferToRecBuf(Buffer).RecordsView := Nil;
end;

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;
  BufferToRecBuf(Buffer).MemRec := MemRec;

  // Don't need assign data values
  // Will do in on first SetFieldData
//  if GlobalUseMemRec then
    BufferToRecBuf(Buffer).UseMemRec := True;
//  else
//    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];

  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];
        BufferToRecBuf(Buffer).Value[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));
  ToRecBuf.SetLength(Length(FromRecBuf.Values));
  for i := 0 to Length(ToRecBuf.Values)-1 do
    ToRecBuf.Values[i] := FromRecBuf.Values[i];

  ToRecBuf.UseMemRec := FromRecBuf.UseMemRec;
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: