dxmdaset.pas

在Dephi中用于文件的输出

  AData: Pointer;
begin
  AData := GetDataFromBuffer(AActiveBuffer);
  if ABuffer <> nil then
  begin
    WriteByte(AData, 1);
    Shift(AData, SizeOf(Byte));
    if FDataType in ftStrings then
      CopyChars(GetDataBuffer(ABuffer), AData, Field.Size, FDataType)
    else
      CopyData(ABuffer, AData, FDataSize);
  end
  else
    WriteByte(AData, 0);
end;

procedure TdxMemField.SetAutoIncValue(const Buffer : TRecordBuffer; Value : TRecordBuffer);
var
  AMaxValue: Integer;
begin
  if (Buffer <> nil) then
    AMaxValue := ReadInteger(Buffer)
  else
    AMaxValue := -1;
  if (Buffer <> nil) and  (FMaxIncValue < AMaxValue) then
    FMaxIncValue := AMaxValue
  else
  begin
    if (not DataSet.IsLoading) or (Buffer = nil) then
    begin
      Inc(FMaxIncValue);
      WriteByte(Value, 1);
      WriteInteger(Value, FMaxIncValue, 1);
    end;
  end;
end;

procedure TdxMemField.AddValue(const Buffer : TRecordBuffer);
begin
  if FIndex = 0 then
    InsertValue(FOwner.FValues.Count, Buffer)
  else
    InsertValue(FOwner.FValues.Count - 1, Buffer);
end;

procedure TdxMemField.InsertValue(AIndex : Integer; const Buffer : TRecordBuffer);
var
  AData: Pointer;
begin
  if AIndex = FOwner.FValues.Count then
  begin
    AData := AllocMem(FOwner.FValuesSize);
    FOwner.Values.Insert(AIndex, AData);
  end
  else
    AData := GetDataFromBuffer(FOwner.Values.Last);
  if Buffer = nil then
    WriteByte(AData, 0)
  else
  begin
    WriteByte(AData, 1);
    CopyData(Buffer, AData, 0, SizeOf(Byte), FDataSize);
  end;
  if FIsNeedAutoInc then
    SetAutoIncValue(Buffer, AData);
end;

function TdxMemField.GetDataFromBuffer(const ABuffer: TRecordBuffer): TRecordBuffer;
begin
  Result := TRecordBuffer(Integer(ABuffer) + FOffSet);
end;

function TdxMemField.GetHasValueFromBuffer(const ABuffer: TRecordBuffer): Char;
begin
  Result := Char(ReadByte(ABuffer, FOffSet));
end;

function TdxMemField.GetValueFromBuffer(const ABuffer: TRecordBuffer): TRecordBuffer;
begin
  if GetHasValueFromBuffer(ABuffer) <> #0 then
    Result := TRecordBuffer(Integer(ABuffer) + FValueOffSet)
  else
    Result := nil;
end;

function TdxMemField.DataPointer(AIndex, AOffset: Integer): TRecordBuffer;
begin
  Result := TRecordBuffer(Integer(Pointer(FOwner.FValues[AIndex])) + AOffset);
end;

function TdxMemField.GetValues(AIndex: Integer): TRecordBuffer;
begin
  if HasValue[AIndex] then
    Result := DataPointer(AIndex, FValueOffSet)
  else
    Result := nil;
end;

function TdxMemField.GetHasValue(AIndex: Integer): Boolean;
begin
  Result := HasValues[AIndex] <> #0;
end;

function TdxMemField.GetHasValues(AIndex: Integer): Char;
begin
  Result := Char(ReadByte(DataPointer(AIndex, FOffSet)));
end;

procedure TdxMemField.SetHasValue(AIndex: Integer; AValue: Boolean);
const
  AValues: array [Boolean] of Char = (#0, #1);
begin
  HasValues[AIndex] := AValues[AValue];
end;

procedure TdxMemField.SetHasValues(AIndex: Integer; AValue: Char);
begin
  WriteByte(DataPointer(AIndex, FOffSet), Byte(AValue));
end;

function TdxMemField.GetDataSet : TdxMemData;
begin
  Result := MemFields.DataSet;
end;

function TdxMemField.GetMemFields : TdxMemFields;
begin
  Result := FOwner;
end;

{TdxMemFields}
constructor TdxMemFields.Create(ADataSet : TdxMemData);
begin
  inherited Create;
  FDataSet := ADataSet;
  FItems := TList.Create;
  FCalcFields := TList.Create;
  FIsNeedAutoIncList := TList.Create;
end;

destructor TdxMemFields.Destroy;
begin
  Clear;
  FItems.Free;
  FCalcFields.Free;
  FIsNeedAutoIncList.Free;

  inherited Destroy;
end;

procedure TdxMemFields.Clear;
var
  i : Integer;
begin
  if FValues <> nil then
  begin
    for i := FValues.Count - 1 downto 0 do
      DeleteRecord(i);
    FreeAndNil(FValues);
  end;
  for i := 0 to FItems.Count - 1 do
    TdxMemField(FItems[i]).Free;
  FItems.Clear;
  FCalcFields.Clear;
  FIsNeedAutoIncList.Clear;
end;

procedure TdxMemFields.DeleteRecord(AIndex : Integer);
begin
  FreeMem(Pointer(FValues[AIndex]));
  FValues.Delete(AIndex);
end;

function TdxMemFields.Add(AField : TField) : TdxMemField;
begin
  Result := TdxMemField.Create(self);
  FItems.Add(Result);
  TdxMemField(Result).CreateField(AField);
end;

function TdxMemFields.GetItem(Index : Integer)  : TdxMemField;
begin
  Result := TdxMemField(FItems[Index]);
end;

function TdxMemFields.IndexOf(Field : TField) : TdxMemField;
var
  i : Integer;
begin
  Result := Nil;
  for i := 0 to FItems.Count - 1 do
    if(TdxMemField(FItems.List[i]).Field = Field) then
    begin
      Result := TdxMemField(FItems.List[i]);
      break;
    end;
end;

function TdxMemFields.GetValue(mField : TdxMemField; Index : Integer) : TRecordBuffer;
begin
  Result := mField.Values[Index];
end;

function TdxMemFields.GetHasValue(mField : TdxMemField; Index : Integer) : char;
begin
  Result := mField.GetHasValues(Index);
end;

procedure TdxMemFields.SetValue(mField : TdxMemField; Index : Integer; Buffer : TRecordBuffer);
const
  HasValueArr : Array[False..True] of Char = (char(0), char(1));
begin
  SetHasValue(mField, Index, HasValueArr[Buffer <> nil]);
  if (Buffer = nil) then exit;
  CopyData(Buffer, mField.Values[Index], mField.FDataSize);
end;

procedure TdxMemFields.SetHasValue(mField : TdxMemField; Index : Integer; Value : char);
begin
  mField.SetHasValues(Index, Value);
end;

function TdxMemFields.GetCount : Integer;
begin
  Result := FItems.Count;
end;

procedure TdxMemFields.GetBuffer(Buffer : TRecordBuffer; AIndex : Integer);
begin
  CopyData(Pointer(FValues[AIndex]), Buffer, FValuesSize);
end;

procedure TdxMemFields.SetBuffer(Buffer : TRecordBuffer; AIndex : Integer);
begin
  if AIndex = -1 then exit;
  CopyData(Buffer, Pointer(FValues[AIndex]), FValuesSize);
end;

function TdxMemFields.GetActiveBuffer(ActiveBuffer, Buffer : TRecordBuffer; Field : TField) : Boolean;
var
  mField : TdxMemField;
begin
  mField := IndexOf(Field);
  Result := (mField <> nil) and mField.GetActiveBuffer(ActiveBuffer, Buffer);
end;

procedure TdxMemFields.SetActiveBuffer(ActiveBuffer, Buffer : TRecordBuffer; Field : TField);
var
  mField : TdxMemField;
begin
  if Field.Calculated and (DataSet.State = dsCalcFields) then  exit;
  mField := IndexOf(Field);
  if mField <> nil then
    mField.SetActiveBuffer(ActiveBuffer, Buffer);
end;

function TdxMemFields.GetRecordCount : Integer;
begin
  if(FValues = nil) then
    Result := 0
  else Result := FValues.Count;
end;

procedure TdxMemFields.InsertRecord(const Buffer: TRecordBuffer; AIndex : Integer; Append: Boolean);
var
  I: Integer;
  AData: Pointer;
  mField : TdxMemField;
begin
  AIndex := Max(AIndex, 0);
  AData := AllocMem(FValuesSize);
  CopyData(Buffer, AData, FValuesSize);
  if Append then
    FValues.Add(AData)
  else
    FValues.Insert(AIndex, AData);
  for I := 0 to FIsNeedAutoIncList.Count - 1 do
  begin
    mField := TdxMemField(FIsNeedAutoIncList[I]);
    mField.SetAutoIncValue(mField.GetValueFromBuffer(Buffer), mField.GetDataFromBuffer(AData));
  end;
end;

procedure TdxMemFields.AddField(Field : TField);
var
  mField : TdxMemField;
begin
  mField := IndexOf(Field);
  if(mField = Nil) then
    Add(Field);
end;

procedure TdxMemFields.RemoveField(Field : TField);
var
  mField : TdxMemField;
begin
  mField := IndexOf(Field);
  if(mField <> Nil) then
    mField.Free;
end;

{TdxMemIndex}
constructor TdxMemIndex.Create(Collection: TCollection);
begin
  inherited Create(Collection);

  fIsDirty := True;
  FValueList := TList.Create;
  FIndexList := TList.Create;
end;

destructor TdxMemIndex.Destroy;
begin
  FreeAndNil(FValueList);
  FreeAndNil(FIndexList);

  inherited Destroy;
end;

procedure TdxMemIndex.Assign(Source: TPersistent);
begin
  if Source is TdxMemIndex then
  begin
    FieldName := TdxMemIndex(Source).FieldName;
    SortOptions := TdxMemIndex(Source).SortOptions;
  end
  else
    inherited Assign(Source);
end;

procedure TdxMemIndex.Prepare;
var
  I: Integer;
  mField: TdxMemField;
  tempList: TList;
begin
  if not IsDirty or (fField = nil) then exit;

  FIndexList.Clear;
  mField := GetMemData.fData.IndexOf(fField);
  if (mField <> nil) then
  begin
    GetMemData.FillValueList(FValueList);
    FIndexList.Capacity := FValueList.Capacity;
    for i := 0 to FValueList.Count - 1 do
      FIndexList.Add(TValueBuffer(i));
    tempList := TList.Create;
    try
      tempList.Add(FIndexList);
      GetMemData.DoSort(FValueList, mField, SortOptions, tempList);
    finally
      tempList.Free;
    end;
    IsDirty := False;
  end;
end;

function TdxMemIndex.GotoNearest(const Buffer : TRecordBuffer; out Index : Integer) : Boolean;
begin
  Result := False;
  Prepare;
  if IsDirty then exit;
  Result := GetMemData.InternalGotoNearest(FValueList, fField, Buffer, SortOptions, Index);
  if Result then
    Index := Integer(TValueBuffer(FIndexList.List[Index]));
end;

procedure TdxMemIndex.SetIsDirty(Value: Boolean);
begin
  if not Value and (fField = nil) then
    Value := True;
  if (fIsDirty <> Value) then
  begin
    fIsDirty := Value;
    if (Value) then
      FValueList.Clear;
  end;
end;

procedure TdxMemIndex.DeleteRecord(pRecord: TRecordBuffer);
begin
  IsDirty := True;
end;

procedure TdxMemIndex.UpdateRecord(pRecord: TRecordBuffer);
var
  i, Index: Integer;
  mField: TdxMemField;
begin
  if fIsDirty then
    exit;
  i := FValueList.IndexOf(pRecord);
  if i > -1 then
  begin
    Index := GetMemData.Data.FValues.IndexOf(FValueList[i]);
    if Index > - 1 then
    begin
      mField := GetMemData.Data.IndexOf(fField);
      if ((Index = 0)
        or (GetMemData.InternalCompareValues(mField.Values[Index - 1],
          mField.Values[Index], mField, soCaseinsensitive in SortOptions) <= 0))
      and ((Index = GetMemData.RecordCount - 1)
         or (GetMemData.InternalCompareValues(mField.Values[Index],
            mField.Values[Index + 1], mField, soCaseinsensitive in SortOptions) <= 0)) then
        exit;
    end;
  end;
  fIsDirty := True;
end;

procedure TdxMemIndex.SetFieldName(Value: String);
var
  AField : TField;
begin
  if (GetMemdata <> nil) and (csLoading in GetMemdata.ComponentState) then
  begin
    fLoadedFieldName := Value;
    exit;
  end;
  if (CompareText(fFieldName, Value) <> 0) then
  begin
    AField := GetMemData.FieldByName(Value);
    if AField <> nil then
    begin
      fFieldName := AField.FieldName;
      fField := AField;
      IsDirty := True;
    end;
  end;
end;

procedure TdxMemIndex.SetSortOptions(Value: TdxSortOptions);
begin