cxdatastorage.pas

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

class function TcxVariantValueType.Compare(P1, P2: Pointer): Integer;
begin
  Result := CompareValues(PPointer(P1)^, PPointer(P2)^);
end;

class procedure TcxVariantValueType.FreeBuffer(PBuffer: PChar);
begin
  Dispose(PVariant(PPointer(PBuffer)^));
end;

class function TcxVariantValueType.GetDataSize: Integer;
begin
  Result := SizeOf(PVariant);
end;

class function TcxVariantValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PVariant(PPointer(PBuffer)^)^;
end;

class procedure TcxVariantValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
var
  P: PVariant;
begin
  P := PPointer(PBuffer)^;
  if P = nil then
  begin
    New(P);
    PPointer(PBuffer)^ := P;
  end;
  P^ := Value;
end;

{ TcxObjectValueType }

class procedure TcxObjectValueType.FreeBuffer(PBuffer: PChar);
begin
  TObject(PPointer(PBuffer)^).Free;
end;

class procedure TcxObjectValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  // not supported
end;

class procedure TcxObjectValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  // TODO: if PInteger(PBuffer)^ <> 0 then FreeBuffer(PBuffer);
  inherited SetDataValue(PBuffer, Value);
end;

class procedure TcxObjectValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  // not supported
end;

{ TcxValueDef }

constructor TcxValueDef.Create(AValueDefs: TcxValueDefs; AValueTypeClass: TcxValueTypeClass);
begin
  inherited Create;
  FValueDefs := AValueDefs;
  FValueTypeClass := AValueTypeClass;
  FStored := True;
  FTextStored := False;
  FStreamStored := True;
end;

destructor TcxValueDef.Destroy;
begin
  FValueDefs.Remove(Self);
  inherited Destroy;
end;

procedure TcxValueDef.Assign(ASource: TcxValueDef);
begin
  Stored := ASource.Stored;
  TextStored := ASource.TextStored;
end;

function TcxValueDef.CompareValues(AIsNull1, AIsNull2: Boolean; P1, P2: PChar): Integer;
begin
  if AIsNull1 then
  begin
    if AIsNull2 then
      Result := 0
    else
      Result := -1
  end
  else
  begin
    if AIsNull2 then
      Result := 1
    else
      Result := ValueTypeClass.CompareValues(P1, P2);
  end;
end;

procedure TcxValueDef.Changed(AResyncNeeded: Boolean);
begin
  if Assigned(ValueDefs) then
    ValueDefs.Changed(Self, AResyncNeeded);
end;

function TcxValueDef.Compare(P1, P2: PChar): Integer;
begin
  if IsNullValueEx(P1, Offset) then
  begin
    if IsNullValueEx(P2, Offset) then
      Result := 0
    else
      Result := -1
  end
  else
  begin
    if IsNullValueEx(P2, Offset) then
      Result := 1
    else
      Result := ValueTypeClass.Compare(IncPChar(P1, Offset + ValueFlagSize),
        IncPChar(P2, Offset + ValueFlagSize));
  end;
end;

procedure TcxValueDef.FreeBuffer(PBuffer: PChar);
var
  PCurrent: PChar;
begin
  if not Stored then Exit;
  PCurrent := IncPChar(PBuffer, Offset);
  if not IsNullValue(PCurrent) then
    ValueTypeClass.FreeBuffer(IncPChar(PCurrent, ValueFlagSize));
  if TextStored then
    FreeTextBuffer(IncPChar(PCurrent, ValueFlagSize + DataSize));
end;

procedure TcxValueDef.FreeTextBuffer(PBuffer: PChar);
begin
  TcxValueType.FreeTextBuffer(PBuffer);
end;

function TcxValueDef.GetDataValue(PBuffer: PChar): Variant;
begin
  if IsNullValue(IncPChar(PBuffer, Offset)) then
    Result := Null
  else
    Result := ValueTypeClass.GetDataValue(IncPChar(PBuffer, Offset + ValueFlagSize));
end;

function TcxValueDef.GetDisplayText(PBuffer: PChar): string;
begin
  if TextStored then
    Result := ValueTypeClass.GetDisplayText(
      IncPChar(PBuffer, Offset + ValueFlagSize + DataSize))
  else
  begin
    if IsNullValue(IncPChar(PBuffer, Offset)) then
      Result := ''
    else
      Result := ValueTypeClass.GetDefaultDisplayText(
        IncPChar(PBuffer, Offset + ValueFlagSize));
  end;
end;

function TcxValueDef.GetLinkObject: TObject;
begin
  Result := FLinkObject;
end;

function TcxValueDef.GetStored: Boolean;
begin
  Result := FStored or not ValueDefs.DataStorage.StoredValuesOnly;
end;

procedure TcxValueDef.Init(var AOffset: Integer);
begin
  FDataSize := ValueTypeClass.GetDataSize;
  FOffset := AOffset;
  if Stored then
  begin
    Inc(AOffset, ValueFlagSize);
    Inc(AOffset, DataSize);
    if TextStored then
      Inc(AOffset, PointerSize);
    FBufferSize := AOffset - FOffset;
  end
  else
    FBufferSize := 0;
end;

function TcxValueDef.IsNullValue(PBuffer: PChar): Boolean;
begin
  Result := PByte(PBuffer)^ = 0;
end;

function TcxValueDef.IsNullValueEx(PBuffer: PChar; AOffset: Integer): Boolean;
begin
  Result := (PBuffer = nil) or IsNullValue(IncPChar(PBuffer, AOffset));
end;

procedure TcxValueDef.ReadDataValue(PBuffer: PChar; AStream: TStream);

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

begin
  if ReadNullFlag then
    SetNull(IncPChar(PBuffer, Offset), True)
  else
  begin
    SetNull(IncPChar(PBuffer, Offset), False);
    ValueTypeClass.ReadDataValue(
      IncPChar(PBuffer, Offset + ValueFlagSize), AStream);
  end;                                               
end;

procedure TcxValueDef.ReadDisplayText(PBuffer: PChar; AStream: TStream);
begin
  if TextStored then
    ValueTypeClass.ReadDisplayText(IncPChar(PBuffer, Offset + ValueFlagSize + DataSize), AStream);
end;

procedure TcxValueDef.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  if VarIsNull(Value) then
    SetNull(IncPChar(PBuffer, Offset), True)
  else
  begin
    SetNull(IncPChar(PBuffer, Offset), False);
    ValueTypeClass.SetDataValue(IncPChar(PBuffer, Offset + ValueFlagSize), Value);
  end;
end;

procedure TcxValueDef.SetDisplayText(PBuffer: PChar; const DisplayText: string);
begin
  if TextStored then
    ValueTypeClass.SetDisplayText(
      IncPChar(PBuffer, Offset + ValueFlagSize + DataSize), DisplayText);
end;

procedure TcxValueDef.SetLinkObject(Value: TObject);
begin
  FLinkObject := Value;
end;

procedure TcxValueDef.SetNull(PBuffer: PChar; IsNull: Boolean);
begin
  if IsNull then
  begin
    if not IsNullValue(PBuffer) then
    begin
      ValueTypeClass.FreeBuffer(IncPChar(PBuffer, ValueFlagSize));
      FillChar((PBuffer + ValueFlagSize)^, DataSize, 0);
    end;
    PByte(PBuffer)^ := 0 // see also IsNullValue
  end
  else
    PByte(PBuffer)^ := 1;
end;

procedure TcxValueDef.WriteDataValue(PBuffer: PChar; AStream: TStream);

  procedure WriteNullFlag(ANull: Boolean);
  begin
    WriteBooleanProc(AStream, ANull);
  end;

begin
  if IsNullValue(IncPChar(PBuffer, Offset)) then
    WriteNullFlag(True)
  else
  begin
    WriteNullFlag(False);
    ValueTypeClass.WriteDataValue(
      IncPChar(PBuffer, Offset + ValueFlagSize), AStream);
  end;
end;

procedure TcxValueDef.WriteDisplayText(PBuffer: PChar; AStream: TStream);
begin
  if TextStored then
    ValueTypeClass.WriteDisplayText(
      IncPChar(PBuffer, Offset + ValueFlagSize + DataSize), AStream);
end;

function TcxValueDef.GetIsNeedConversion: Boolean;
begin
  Result := ValueTypeClass.IsString;
end;

function TcxValueDef.GetTextStored: Boolean;
begin
  if not Stored then
    Result := False
  else
    Result := FTextStored;
end;

procedure TcxValueDef.SetStored(Value: Boolean);
begin
  if FStored <> Value then
  begin
    FStored := Value;
    Changed(False);
  end;
end;

procedure TcxValueDef.SetTextStored(Value: Boolean);
begin
  if FTextStored <> Value then
  begin
    FTextStored := Value;
    Changed(True);
  end;
end;

procedure TcxValueDef.SetValueTypeClass(Value: TcxValueTypeClass);
begin
  if FValueTypeClass <> Value then
  begin
    FValueTypeClass := Value; // TODO: clear?
    Changed(True);
  end;
end;

{ TcxValueDefs }

constructor TcxValueDefs.Create(ADataStorage: TcxDataStorage);
begin
  inherited Create;
  FDataStorage := ADataStorage;
  FItems := TList.Create;
  DataStorage.InitStructure(Self);
end;

destructor TcxValueDefs.Destroy;
begin
  Clear;
  FItems.Free;
  inherited Destroy;
end;

function TcxValueDefs.Add(AValueTypeClass: TcxValueTypeClass; AStored, ATextStored: Boolean; ALinkObject: TObject): TcxValueDef;
var
  I: Integer;
begin
  Result := GetValueDefClass.Create(Self, AValueTypeClass);
  Result.LinkObject := ALinkObject;
  Result.Stored := AStored;
  Result.TextStored := ATextStored;
  I := 0;
  Result.Init(I);
  DataStorage.InsertValueDef(FItems.Count, Result);
  FItems.Add(Result);
  DataStorage.InitStructure(Self);
end;

procedure TcxValueDefs.Clear;
begin
  while FItems.Count > 0 do
    TcxValueDef(FItems.Last).Free;
end;

procedure TcxValueDefs.Changed(AValueDef: TcxValueDef; AResyncNeeded: Boolean);
begin
  DataStorage.ValueDefsChanged(AValueDef, AResyncNeeded);
end;

function TcxValueDefs.GetValueDefClass: TcxValueDefClass;
begin
  Result := TcxValueDef;
end;

procedure TcxValueDefs.Prepare(AStartOffset: Integer);
var
  I, AOffset: Integer;
begin
  FRecordOffset := AStartOffset;
  AOffset := FRecordOffset;
  for I := 0 to Count - 1 do
    Items[I].Init(AOffset);
  FRecordSize := AOffset;
end;

procedure TcxValueDefs.Remove(AItem: TcxValueDef);
begin
  DataStorage.RemoveValueDef(AItem);
  FItems.Remove(AItem);
  DataStorage.InitStructure(Self);
end;

function TcxValueDefs.GetStoredCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    if Items[I].Stored then
      Inc(Result);
end;

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

function TcxValueDefs.GetItem(Index: Integer): TcxValueDef;
begin
  if DataStorage.FValueDefsList <> nil then
    Result := TcxValueDef(DataStorage.FValueDefsList[Index])
  else
    Result := TcxValueDef(FItems[Index]);
end;

{ TcxInternalValueDef }

function TcxInternalValueDef.GetLinkObject: TObject;
begin
  if Assigned(FLinkObject) then
    Result := TcxValueDef(FLinkObject).LinkObject
  else
    Result := nil;
end;

function TcxInternalValueDef.GetStored: Boolean;
begin
  Result := True;
end;

function TcxInternalValueDef.GetValueDef: TcxValueDef;
begin
  Result := TcxValueDef(FLinkObject);
end;

{ TcxInternalValueDefs }

function TcxInternalValueDefs.FindByLinkObject(ALinkObject: TObject): TcxValueDef;
var
  I: Integer;
begin
  Result := nil;
  for I := Count - 1 downto 0 do
    if Items[I].FLinkObject = ALinkObject then
    begin
      Result := Items[I] as TcxValueDef;
      Break;
    end;
end;

procedure TcxInternalValueDefs.RemoveByLinkObject(ALinkObject: TObject);
var
  AItem: TcxValueDef;
begin
  AItem := FindByLinkObject(ALinkObject);
  if AItem <> nil then
    AItem.Free;
end;

function TcxInternalValueDefs.GetValueDefClass: TcxValueDefClass;
begin