cxdatastorage.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,304 行 · 第 1/5 页

  Result := TcxInternalValueDef;
end;

{ TcxValueDefReader }

constructor TcxValueDefReader.Create;
begin
  inherited Create;
end;

function TcxValueDefReader.GetDisplayText(AValueDef: TcxValueDef): string;
begin
  Result := '';
end;

function TcxValueDefReader.GetValue(AValueDef: TcxValueDef): Variant;
begin
  Result := Null;
end;

function TcxValueDefReader.IsInternal(AValueDef: TcxValueDef): Boolean;
begin
  Result := False;
end;

{ TcxDataStorage }

constructor TcxDataStorage.Create;
begin
  inherited Create;
  FRecordIDCounter := 1; // TODO: reset
  FInternalValueDefs := TcxInternalValueDefs.Create(Self);
  FValueDefs := TcxValueDefs.Create(Self);
  FInternalRecordBuffers := TList.Create;
  FRecordBuffers := TList.Create;
end;

destructor TcxDataStorage.Destroy;
begin
  Clear(False);
  FValueDefs.Free;
  FInternalValueDefs.Free;
  FRecordBuffers.Free;
  FInternalRecordBuffers.Free;
  inherited Destroy;
end;

function TcxDataStorage.AddInternalRecord: Integer;
var
  I: Integer;
  P: PChar;
begin
  Result := 0;
  for I := -1 downto -FInternalRecordBuffers.Count do
  begin
    if not IsRecordFlag(RecordBuffers[I], RecordFlag_Busy) then
    begin
      Result := I;
      Break;
    end;
  end;
  if Result = 0 then
    Result := -FInternalRecordBuffers.Add(nil) - 1;
  P := AllocRecordBuffer(Result);
  ChangeRecordFlag(P, RecordFlag_Busy, True);
end;

function TcxDataStorage.AppendRecord: Integer;
begin
  Result := FRecordBuffers.Add(nil);
  CheckRecordID(Result);
end;

procedure TcxDataStorage.BeforeDestruction;
begin
  FDestroying := True;
  inherited BeforeDestruction;
end;

procedure TcxDataStorage.BeginLoad;
begin
  CheckStructure;
end;

procedure TcxDataStorage.CheckStructure;
begin
(*
  if FValueDefsChanged then
  begin
    InitStructure(ValueDefs);
    // !
    ClearInternalRecords;
    InitStructure(InternalValueDefs);
    // !
    FValueDefsChanged := False;
  end;
  *)
end;

procedure TcxDataStorage.Clear(AWithoutInternal: Boolean);
begin
  if not AWithoutInternal then
    ClearInternalRecords;
  ClearRecords(True);
end;

procedure TcxDataStorage.ClearInternalRecords;
var
  I: Integer;
begin
  for I := -FInternalRecordBuffers.Count to -1 do
    FreeAndNilRecordBuffer(I);
  FInternalRecordBuffers.Clear;
  if Assigned(FOnClearInternalRecords) then
    FOnClearInternalRecords(Self);
end;

procedure TcxDataStorage.ClearRecords(AClearList: Boolean);
var
  I: Integer;
begin
  for I := 0 to FRecordBuffers.Count - 1 do
    FreeAndNilRecordBuffer(I);
  if AClearList then                                      
    FRecordBuffers.Clear;
  CheckRecordIDCounter;  
  CheckRecordID(-1); // all   
end;

function TcxDataStorage.CompareRecords(ARecordIndex1, ARecordIndex2: Integer;
  AValueDef: TcxValueDef): Integer;
var
  P1, P2: PChar;
begin
  P1 := RecordBuffers[ARecordIndex1];
  P2 := RecordBuffers[ARecordIndex2];
  Result := AValueDef.Compare(P1, P2);
end;

procedure TcxDataStorage.DeleteRecord(ARecordIndex: Integer);
begin
  if ARecordIndex < 0 then
    DeleteInternalRecord(ARecordIndex)
  else
  begin
    FreeAndNilRecordBuffer(ARecordIndex);
    FRecordBuffers.Delete(ARecordIndex);
    CheckRecordIDCounter;
  end;
end;

procedure TcxDataStorage.EndLoad;
begin
end;

function TcxDataStorage.GetDisplayText(ARecordIndex: Integer; AValueDef: TcxValueDef): string;
var
  P: PChar;
begin
  Result := '';
  P := RecordBuffers[ARecordIndex];
  if (P <> nil) and CheckValueDef(ARecordIndex, AValueDef) then
    Result := AValueDef.GetDisplayText(P);
end;

function TcxDataStorage.GetCompareInfo(ARecordIndex: Integer; AValueDef: TcxValueDef;
  var P: PChar): Boolean;
begin
  P := RecordBuffers[ARecordIndex];
  IncPChar(P, AValueDef.Offset);
  Result := AValueDef.IsNullValue(P);
  if not Result then
  begin
    IncPChar(P, ValueFlagSize);
    AValueDef.ValueTypeClass.PrepareValueBuffer(P);
  end;
end;

function TcxDataStorage.GetRecordID(ARecordIndex: Integer): Integer;
var
  P: PChar;
begin
  P := AllocRecordBuffer(ARecordIndex);
  P := IncPChar(P, RecordFlagSize);
  Result := PInteger(P)^;
end;

function TcxDataStorage.GetValue(ARecordIndex: Integer; AValueDef: TcxValueDef): Variant;
var
  P: PChar;
begin
  Result := Null;
  P := RecordBuffers[ARecordIndex];
  if (P <> nil) and CheckValueDef(ARecordIndex, AValueDef) then
    Result := AValueDef.GetDataValue(P);
end;

procedure TcxDataStorage.InsertRecord(ARecordIndex: Integer);
begin
  FRecordBuffers.Insert(ARecordIndex, nil);
  CheckRecordID(ARecordIndex);
end;

procedure TcxDataStorage.ReadData(ARecordIndex: Integer; AStream: TStream);

  function ReadNilFlag: Boolean;
  begin
    Result := ReadBooleanFunc(AStream);
  end;

var
  P: PChar;
  I, AID: Integer;
  AValueDef: TcxValueDef;
begin
  if ReadNilFlag then
    FreeAndNilRecordBuffer(ARecordIndex)
  else
  begin
    P := AllocRecordBuffer(ARecordIndex);
    if UseRecordID then
    begin
      AID := ReadIntegerFunc(AStream);
      SetRecordID(ARecordIndex, AID);
      CheckRecordIDCounterAfterLoad(AID);
    end;  
    for I := 0 to ValueDefs.Count - 1 do
    begin
      AValueDef := ValueDefs[I];
      if AValueDef.StreamStored then
      begin
        AValueDef.ReadDataValue(P, AStream);
        if AValueDef.TextStored then
          AValueDef.ReadDisplayText(P, AStream);
      end;
    end;
  end;
end;

procedure TcxDataStorage.ReadRecord(ARecordIndex: Integer; AValueDefReader: TcxValueDefReader);
var
  P: PChar;
  I: Integer;
  AValueDef: TcxValueDef;
  AValueDefs: TcxValueDefs;
begin
  P := AllocRecordBuffer(ARecordIndex);
  AValueDefs := ValueDefsByRecordIndex(ARecordIndex);
  for I := 0 to AValueDefs.Count - 1 do
  begin
    AValueDef := AValueDefs[I];
    if not AValueDefReader.IsInternal(AValueDef) then
    begin
      AValueDef.SetDataValue(P, AValueDefReader.GetValue(AValueDef));
      if AValueDef.TextStored then
        AValueDef.SetDisplayText(P, AValueDefReader.GetDisplayText(AValueDef));
    end;
  end;
end;

procedure TcxDataStorage.ReadRecordFrom(AFromRecordIndex, AToRecordIndex: Integer;
  AValueDefReader: TcxValueDefReader; ASetProc: TcxValueDefSetProc);
var
  I: Integer;
  AValueDefs: TcxValueDefs;
begin
  AValueDefs := ValueDefsByRecordIndex(AFromRecordIndex);
  for I := 0 to AValueDefs.Count - 1 do
    ASetProc(AValueDefs[I], AFromRecordIndex, AToRecordIndex, AValueDefReader);
end;

procedure TcxDataStorage.SetDisplayText(ARecordIndex: Integer; AValueDef: TcxValueDef;
  const Value: string);
var
  P: PChar;
begin
  P := AllocRecordBuffer(ARecordIndex);
  if CheckValueDef(ARecordIndex, AValueDef) and AValueDef.TextStored then
    AValueDef.SetDisplayText(P, Value);
end;

procedure TcxDataStorage.SetRecordID(ARecordIndex, AID: Integer);
var
  P: PChar;
begin
  P := AllocRecordBuffer(ARecordIndex);
  P := IncPChar(P, RecordFlagSize);
  PInteger(P)^ := AID;
end;

procedure TcxDataStorage.SetValue(ARecordIndex: Integer; AValueDef: TcxValueDef;
  const Value: Variant);
var
  P: PChar;
begin
  P := AllocRecordBuffer(ARecordIndex);
  if CheckValueDef(ARecordIndex, AValueDef) then
    AValueDef.SetDataValue(P, Value);
end;

procedure TcxDataStorage.WriteData(ARecordIndex: Integer; AStream: TStream);

  procedure WriteRecordInfo(PBuffer: PChar);
  var
    AID: Integer;
  begin
    WriteBooleanProc(AStream, PBuffer = nil);
    if (PBuffer <> nil) and UseRecordID then
    begin
      AID := 0;
      if PBuffer <> nil then
      begin
        PBuffer := IncPChar(PBuffer, RecordFlagSize);
        AID := PInteger(PBuffer)^;
      end;
      WriteIntegerProc(AStream, AID);
    end;
  end;

var
  P: PChar;
  I: Integer;
  AValueDef: TcxValueDef;
begin
  P := PChar(FRecordBuffers[ARecordIndex]);
  WriteRecordInfo(P);
  if P <> nil then
    for I := 0 to ValueDefs.Count - 1 do
    begin
      AValueDef := ValueDefs[I];
      if AValueDef.StreamStored then
      begin
        AValueDef.WriteDataValue(P, AStream);
        if AValueDef.TextStored then
          AValueDef.WriteDisplayText(P, AStream);
      end;
    end;
end;

procedure TcxDataStorage.BeginStreaming(ACompare: TListSortCompare);
var
  I: Integer;
  AList: TList;
begin
  AList := TList.Create;
  for I := 0 to ValueDefs.Count - 1 do
    AList.Add(ValueDefs[I]);
  AList.Sort(ACompare);
  FValueDefsList := AList; 
end;

procedure TcxDataStorage.EndStreaming;
begin
  FValueDefsList.Free;
  FValueDefsList := nil;
end;

function TcxDataStorage.AllocRecordBuffer(Index: Integer): PChar;
var
  AValueDefs: TcxValueDefs;
begin
  Result := RecordBuffers[Index];
  if Result = nil then
  begin
    AValueDefs := ValueDefsByRecordIndex(Index);
    Result := AllocMem(AValueDefs.RecordSize);
    RecordBuffers[Index] := Result;
  end;
end;

function TcxDataStorage.CalcRecordOffset: Integer;
begin
  Result := RecordFlagSize;
  if UseRecordID then
    Inc(Result, RecordIDSize);
end;

procedure TcxDataStorage.ChangeRecordFlag(PBuffer: PChar; AFlag: Byte; ATurnOn: Boolean);
begin
  if PBuffer <> nil then
    if ATurnOn then
      PByte(PBuffer)^ := PByte(PBuffer)^ or AFlag
    else
      PByte(PBuffer)^ := PByte(PBuffer)^ and not AFlag;
end;

procedure TcxDataStorage.CheckRecordID(ARecordIndex: Integer);

  procedure CheckID(AIndex: Integer);
  begin
    if GetRecordID(AIndex) = 0 then
    begin
      SetRecordID(AIndex, FRecordIDCounter);
      Inc(FRecordIDCounter);
    end;
  end;

var
  I: Integer;  
begin
  if not UseRecordID then Exit;
  if ARecordIndex <> -1 then
    CheckID(ARecordIndex)
  else
    for I := 0 to RecordCount - 1 do
      CheckID(I);
end;

procedure TcxDataStorage.CheckRecordIDCounter;
begin
  if FRecordBuffers.Count = 0 then FRecordIDCounter := 1; // TODO: reset
end;

procedure TcxDataStorage.CheckRecordIDCounterAfterLoad(ALoadedID: Integer);
begin
  if FRecordIDCounter <= ALoadedID then
    FRecordIDCounter := ALoadedID + 1;
end;

function TcxDataStorage.CheckValueDef(ARecordIndex: Integer; var AValueDef: TcxValueDef): Boolean;
begin
  if not (AValueDef is TcxInternalValueDef) and
    (ValueDefsByRecordIndex(ARecordIndex) = InternalValueDefs) then
    AValueDef := InternalValueDefs.FindByLinkObject(AValueDef);
  Result := AValueDef <> nil;
end;

procedure TcxDataStorage.DeleteInternalRecord(ARecordIndex: Integer);
//var
//  P: PChar;
begin
  if ARecordIndex >= 0 then Exit;
//  P := RecordBuffers[ARecordIndex];
//  ChangeRecordFlag(P, RecordFlag_Busy, False);
  FreeAndNilRecordBuffer(ARecordIndex);
end;

procedure TcxDataStorage.FreeAndNilRecordBuffer(AIndex: Integer);
var
  P: PChar;
  I: Integer;
  AValueDefs: TcxValueDefs;
begin
  P := RecordBuffers[AIndex];
  if P <> nil then
  begin
    AValueDefs := ValueDefsByRecordIndex(AIndex);
    RecordBuffers[AIndex] := nil;
    for I := 0 to AValueDefs.Count - 1 do
      AValueDefs[I].FreeBuffer(P);
    FreeMem(P);
  end;
end;

procedure TcxDataStorage.InitStructure(AValueDefs: TcxValueDefs);
begin
  AValueDefs.Prepare(CalcRecordOffset);
end;

procedure TcxDataStorage.InsertValueDef(AIndex: Integer; AVa