{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressDataController                                        }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSDATACONTROLLER AND ALL         }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxDataStorage;                   

{$I cxVer.inc}

interface

uses
  SysUtils, Classes{$IFDEF DELPHI6},Variants
  {$IFNDEF NONDB},FMTBcd, SqlTimSt{$ENDIF}{$ENDIF};

type
{$IFNDEF DELPHI6}
  PPointer = ^Pointer;
  PSmallInt = ^SmallInt;
  PInteger = ^Integer;
  PWord = ^Word;
  PBoolean = ^Boolean;
  PDouble =^Double;
  PByte = ^Byte;
{$ELSE}
  LargeInt = Int64;
  PLargeInt = ^LargeInt;
{$ENDIF}

  { Value Types }

  
  PStringValue = PString;
  PWideStringValue = PWideString;

  TcxValueType = class
  protected
    class function Compare(P1, P2: Pointer): Integer; virtual;
    class procedure FreeBuffer(PBuffer: PChar); virtual;
    class procedure FreeTextBuffer(PBuffer: PChar); virtual;
    class function GetDataSize: Integer; virtual;
    class function GetDataValue(PBuffer: PChar): Variant; virtual;
    class function GetDefaultDisplayText(PBuffer: PChar): string; virtual;
    class function GetDisplayText(PBuffer: PChar): string; virtual;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); virtual;
    class procedure ReadDisplayText(PBuffer: PChar; AStream: TStream); virtual;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); virtual;
    class procedure SetDisplayText(PBuffer: PChar; const DisplayText: string); virtual;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); virtual;
    class procedure WriteDisplayText(PBuffer: PChar; AStream: TStream); virtual;
  public
    class function Caption: string; virtual;
    class function CompareValues(P1, P2: Pointer): Integer; virtual;
    class function GetValue(PBuffer: PChar): Variant; virtual;
    class function GetVarType: Integer; virtual;
    class function IsValueValid(var{const }Value: Variant): Boolean; virtual;
    class function IsString: Boolean; virtual;
    class procedure PrepareValueBuffer(var PBuffer: PChar); virtual;
  end;

  TcxValueTypeClass = class of TcxValueType;

  TcxStringValueType = class(TcxValueType)
  protected
    class function Compare(P1, P2: Pointer): Integer; override;
    class procedure FreeBuffer(PBuffer: PChar); override;
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetValue(PBuffer: PChar): Variant; override;
    class function GetVarType: Integer; override;
    class function IsString: Boolean; override;
    class procedure PrepareValueBuffer(var PBuffer: PChar); override;
  end;

  TcxWideStringValueType = class(TcxStringValueType)
  protected
    class function Compare(P1, P2: Pointer): Integer; override;
    class procedure FreeBuffer(PBuffer: PChar); override;
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetValue(PBuffer: PChar): Variant; override;
    class function GetVarType: Integer; override;
    class function IsString: Boolean; override;
    class procedure PrepareValueBuffer(var PBuffer: PChar); override;
  end;

  TcxSmallintValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxIntegerValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxWordValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxBooleanValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class function GetDefaultDisplayText(PBuffer: PChar): string; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxFloatValueType = class(TcxValueType) // TODO: Double or Extended?
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxCurrencyValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxDateTimeValueType = class(TcxValueType)
  private
    class function GetDateTime(PBuffer: PChar): TDateTime; 
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class function GetDefaultDisplayText(PBuffer: PChar): string; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

{$IFDEF DELPHI6}
  TcxLargeIntValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  {$IFNDEF NONDB}
  TcxFMTBcdValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class function GetDefaultDisplayText(PBuffer: PChar): string; override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxSQLTimeStampValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;
  {$ENDIF}
  {$ENDIF}

  TcxVariantValueType = class(TcxValueType)
  protected
    class function Compare(P1, P2: Pointer): Integer; override;
    class procedure FreeBuffer(PBuffer: PChar); override;
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetValue(PBuffer: PChar): Variant; override;
    class procedure PrepareValueBuffer(var PBuffer: PChar); override;
  end;

  TcxObjectValueType = class(TcxIntegerValueType)
  protected
    class procedure FreeBuffer(PBuffer: PChar); override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  end;

  { TcxDataStorage }

  TcxDataStorage = class;
  TcxValueDefs = class;

  TcxValueDef = class
  private
    FBufferSize: Integer;
    FDataSize: Integer;
    FStored: Boolean;
    FLinkObject: TObject;
    FOffset: Integer;
    FStreamStored: Boolean;
    FTextStored: Boolean;
    FValueDefs: TcxValueDefs;
    FValueTypeClass: TcxValueTypeClass;
    function GetIsNeedConversion: Boolean;
    function GetTextStored: Boolean;
    procedure SetStored(Value: Boolean);
    procedure SetTextStored(Value: Boolean);
    procedure SetValueTypeClass(Value: TcxValueTypeClass);
  protected
    procedure Changed(AResyncNeeded: Boolean);
    function Compare(P1, P2: PChar): Integer;
    procedure FreeBuffer(PBuffer: PChar);
    procedure FreeTextBuffer(PBuffer: PChar);
    function GetDataValue(PBuffer: PChar): Variant;
    function GetDisplayText(PBuffer: PChar): string;
    function GetLinkObject: TObject; virtual;
    function GetStored: Boolean; virtual;
    procedure Init(var AOffset: Integer);
    function IsNullValue(PBuffer: PChar): Boolean;
    function IsNullValueEx(PBuffer: PChar; AOffset: Integer): Boolean;
    procedure ReadDataValue(PBuffer: PChar; AStream: TStream);
    procedure ReadDisplayText(PBuffer: PChar; AStream: TStream);
    procedure SetDataValue(PBuffer: PChar; const Value: Variant);
    procedure SetDisplayText(PBuffer: PChar; const DisplayText: string);
    procedure SetLinkObject(Value: TObject); virtual;
    procedure SetNull(PBuffer: PChar; IsNull: Boolean);
    procedure WriteDataValue(PBuffer: PChar; AStream: TStream);
    procedure WriteDisplayText(PBuffer: PChar; AStream: TStream);
    property BufferSize: Integer read FBufferSize;
    property DataSize: Integer read FDataSize;
    property Offset: Integer read FOffset;
    property ValueDefs: TcxValueDefs read FValueDefs;
  public
    constructor Create(AValueDefs: TcxValueDefs; AValueTypeClass: TcxValueTypeClass); virtual;
    destructor Destroy; override;
    procedure Assign(ASource: TcxValueDef); virtual;
    function CompareValues(AIsNull1, AIsNull2: Boolean; P1, P2: PChar): Integer;
    property IsNeedConversion: Boolean read GetIsNeedConversion;
    property LinkObject: TObject read GetLinkObject write SetLinkObject;
    property Stored: Boolean read GetStored write SetStored default True;
    property TextStored: Boolean read GetTextStored write SetTextStored default False;
    property ValueTypeClass: TcxValueTypeClass read FValueTypeClass write SetValueTypeClass;
    property StreamStored: Boolean read FStreamStored write FStreamStored default True;
  end;

  TcxValueDefClass = class of TcxValueDef;

  TcxValueDefs = class
  private
    FDataStorage: TcxDataStorage;
    FItems: TList;
    FRecordOffset: Integer;
    FRecordSize: Integer;
    function GetStoredCount: Integer;
    function GetCount: Integer;
    function GetItem(Index: Integer): TcxValueDef;
  protected
    procedure Changed(AValueDef: TcxValueDef; AResyncNeeded: Boolean); virtual;
    function GetValueDefClass: TcxValueDefClass; virtual;
    procedure Prepare(AStartOffset: Integer); virtual;
    procedure Remove(AItem: TcxValueDef);
    property DataStorage: TcxDataStorage read FDataStorage;
  public
    constructor Create(ADataStorage: TcxDataStorage); virtual;
    destructor Destroy; override;
    function Add(AValueTypeClass: TcxValueTypeClass; AStored, ATextStored: Boolean; ALinkObject: TObject): TcxValueDef;
    procedure Clear;
    property StoredCount: Integer read GetStoredCount;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TcxValueDef read GetItem; default;
    property RecordSize: Integer read FRecordSize;
  end;

  { internal value defs }

  TcxInternalValueDef = class(TcxValueDef)
  protected
    function GetLinkObject: TObject; override;
    function GetStored: Boolean; override;
  public
    function GetValueDef: TcxValueDef;
  end;

  TcxInternalValueDefs = class(TcxValueDefs)
  protected
    function GetValueDefClass: TcxValueDefClass; override;
  public
    function FindByLinkObject(ALinkObject: TObject): TcxValueDef;
    procedure RemoveByLinkObject(ALinkObject: TObject);
  end;

  TcxValueDefReader = class
  public
    constructor Create; virtual;
    function GetDisplayText(AValueDef: TcxValueDef): string; virtual;
    function GetValue(AValueDef: TcxValueDef): Variant; virtual;
    function IsInternal(AValueDef: TcxValueDef): Boolean; virtual;
  end;

  TcxValueDefReaderClass = class of TcxValueDefReader;

  TcxValueDefSetProc = procedure (AValueDef: TcxValueDef; AFromRecordIndex, AToRecordIndex: Integer;
    AValueDefReader: TcxValueDefReader) of object;

  TcxDataStorage = class
  private
    FDestroying: Boolean;
    FInternalRecordBuffers: TList;
    FInternalValueDefs: TcxInternalValueDefs;
    FStoredValuesOnly: Boolean;
    FRecordBuffers: TList;
    FRecordIDCounter: Integer;
    FUseRecordID: Boolean;
    FValueDefs: TcxValueDefs;
    FValueDefsList: TList;
//    FValueDefsChanged: Boolean;
    FOnClearInternalRecords: TNotifyEvent;
    function GetRecordBuffer(Index: Integer): PChar;
    function GetRecordCount: Integer;
    procedure SetStoredValuesOnly(Value: Boolean);
    procedure SetRecordBuffer(Index: Integer; Value: PChar);
    procedure SetRecordCount(Value: Integer);
    procedure SetUseRecordID(Value: Boolean);
  protected
    function AllocRecordBuffer(Index: Integer): PChar;
    function CalcRecordOffset: Integer;
    procedure ChangeRecordFlag(PBuffer: PChar; AFlag: Byte; ATurnOn: Boolean);
    procedure CheckRecordID(ARecordIndex: Integer);
    procedure CheckRecordIDCounter;
    procedure CheckRecordIDCounterAfterLoad(ALoadedID: Integer);
    function CheckValueDef(ARecordIndex: Integer; var AValueDef: TcxValueDef): Boolean;
    procedure DeleteInternalRecord(ARecordIndex: Integer);
    procedure FreeAndNilRecordBuffer(AIndex: Integer);
    procedure InitStructure(AValueDefs: TcxValueDefs); virtual;
    procedure InsertValueDef(AIndex: Integer; AValueDef: TcxValueDef);
    function IsRecordFlag(PBuffer: PChar; AFlag: Byte): Boolean;
    procedure RemoveValueDef(AValueDef: TcxValueDef);
    procedure ValueDefsChanged(AValueDef: TcxValueDef; AResyncNeeded: Boolean); virtual;
    function ValueDefsByRecordIndex(Index: Integer): TcxValueDefs; virtual;
    property InternalValueDefs: TcxInternalValueDefs read FInternalValueDefs;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function AddInternalRecord: Integer;
    function AppendRecord: Integer;
    procedure BeforeDestruction; override;
    procedure BeginLoad;
    procedure CheckStructure;
    procedure Clear(AWithoutInternal: Boolean);
    procedure ClearInternalRecords;
    procedure ClearRecords(AClearList: Boolean);
    function CompareRecords(ARecordIndex1, ARecordIndex2: Integer; AValueDef: TcxValueDef): Integer;
    procedure DeleteRecord(ARecordIndex: Integer);
    procedure EndLoad;
    function GetDisplayText(ARecordIndex: Integer; AValueDef: TcxValueDef): string;
    function GetCompareInfo(ARecordIndex: Integer; AValueDef: TcxValueDef; var P: PChar): Boolean;
    function GetRecordID(ARecordIndex: Integer): Integer;
    function GetValue(ARecordIndex: Integer; AValueDef: TcxValueDef): Variant;
    procedure InsertRecord(ARecordIndex: Integer);
    procedure ReadData(ARecordIndex: Integer; AStream: TStream);
    procedure ReadRecord(ARecordIndex: Integer; AValueDefReader: TcxValueDefReader);
    procedure ReadRecordFrom(AFromRecordIndex, AToRecordIndex: Integer; AValueDefReader: TcxValueDefReader; ASetProc: TcxValueDefSetProc);
    procedure SetDisplayText(ARecordIndex: Integer; AValueDef: TcxValueDef; const Value: string);
    procedure SetRecordID(ARecordIndex, AID: Integer);
    procedure SetValue(ARecordIndex: Integer; AValueDef: TcxValueDef; const Value: Variant);
    procedure WriteData(ARecordIndex: Integer; AStream: TStream);

    procedure BeginStreaming(ACompare: TListSortCompare);
    procedure EndStreaming;
    
    property StoredValuesOnly: Boolean read FStoredValuesOnly write SetStoredValuesOnly;
    property UseRecordID: Boolean read FUseRecordID write SetUseRecordID;
    property RecordBuffers[Index: Integer]: PChar read GetRecordBuffer write SetRecordBuffer;
    property RecordCount: Integer read GetRecordCount write SetRecordCount;
    property ValueDefs: TcxValueDefs read FValueDefs;
    property OnClearInternalRecords: TNotifyEvent read FOnClearInternalRecords write FOnClearInternalRecords;
  end;

  { TcxLookupList }

  TcxLookupListItem = record
    KeyValue: Variant;
    DisplayText: string;
  end;
  PcxLookupListItem = ^TcxLookupListItem;

  TcxLookupList = class
  private
    FItems: TList;
    function GetCount: Integer;
    function GetItem(Index: Integer): PcxLookupListItem;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Find(const AKeyValue: Variant; var AIndex: Integer): Boolean;
    procedure Insert(AIndex: Integer; const AKeyValue: Variant; const ADisplayText: string);
    property Count: Integer read GetCount;
    property Items[Index: Integer]: PcxLookupListItem read GetItem; default;
  end;

  { TcxValueTypeClassList }

  TcxValueTypeClassList = class
  private
    FItems: TList;
    function GetCount: Integer;
    function GetItem(Index: Integer): TcxValueTypeClass;
  public
    constructor Create;
    destructor Destroy; override;
    function ItemByCaption(const ACaption: string): TcxValueTypeClass;
    procedure RegisterItem(AValueTypeClass: TcxValueTypeClass);
    procedure UnregisterItem(AValueTypeClass: TcxValueTypeClass);
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TcxValueTypeClass read GetItem; default;
  end;

function cxValueTypeClassList: TcxValueTypeClassList;

function IsDateTimeValueTypeClass(AValueTypeClass: TcxValueTypeClass): Boolean;

implementation

uses
  cxVariants;

const
  RecordFlagSize = SizeOf(Byte);
  ValueFlagSize  = SizeOf(Byte);
  PointerSize    = SizeOf(Pointer);
  RecordIDSize   = SizeOf(Integer);
  // RecordFlag Bit Masks
  RecordFlag_Busy = $01;

var
  FValueTypeClassList: TcxValueTypeClassList;

function cxValueTypeClassList: TcxValueTypeClassList;
begin
  if FValueTypeClassList = nil then
    FValueTypeClassList := TcxValueTypeClassList.Create;
  Result := FValueTypeClassList;
end;

function IsDateTimeValueTypeClass(AValueTypeClass: TcxValueTypeClass): Boolean;
begin
  Result := (AValueTypeClass = TcxDateTimeValueType)
    {$IFDEF DELPHI6}{$IFNDEF NONDB} or (AValueTypeClass = TcxSQLTimeStampValueType){$ENDIF}{$ENDIF};
end;

function IncPChar(P: PChar; AOffset: Integer): PChar;
begin
  Result := P + AOffset;
end;

{ TcxValueType }

class function TcxValueType.Caption: string;
var
  I: Integer;
begin
  Result := ClassName;
  if Result <> '' then
  begin
    if Copy(Result, 1, 3) = 'Tcx' then
      Delete(Result, 1, 3);
    I := Pos('ValueType', Result);
    if I <> 0 then
      Delete(Result, I, Length('ValueType'));
  end;
end;

class function TcxValueType.CompareValues(P1, P2: Pointer): Integer;
begin
  Result := VarCompare(GetDataValue(P1), GetDataValue(P2));
end;

class function TcxValueType.GetValue(PBuffer: PChar): Variant;
begin
  Result := GetDataValue(PBuffer);
end;

class function TcxValueType.GetVarType: Integer;
begin
  Result := varVariant;
end;

class function TcxValueType.IsValueValid(var{const }Value: Variant): Boolean;
//var
//  V: Variant;
begin
  if VarIsNull(Value) or (GetVarType = varVariant) then  // not Empty?
    Result := True
  else
  begin
    Result := False;
    try
      VarCast(Value{V}, Value, GetVarType);
      Result := True;
    except
      on E: EVariantError do;
    end;
  end;
end;

class function TcxValueType.IsString: Boolean;
begin
  Result := False;
end;

class procedure TcxValueType.PrepareValueBuffer(var PBuffer: PChar);
begin
end;

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

class procedure TcxValueType.FreeBuffer(PBuffer: PChar);
begin
end;

class procedure TcxValueType.FreeTextBuffer(PBuffer: PChar);
var
  P: PStringValue;
begin
  P := PPointer(PBuffer)^;
  if P <> nil then
    Dispose(P);
end;

class function TcxValueType.GetDataSize: Integer;
begin
  Result := 0;
end;

class function TcxValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := Null;
end;

class function TcxValueType.GetDefaultDisplayText(PBuffer: PChar): string;
begin
  try
    Result := VarToStr(GetDataValue(PBuffer));
  except
    on EVariantError do
      Result := '';
  end;
end;

class function TcxValueType.GetDisplayText(PBuffer: PChar): string;
var
  P: PStringValue;
begin
  P := PPointer(PBuffer)^;
  if P <> nil then
    Result := P^
  else
    Result := '';
end;

class procedure TcxValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadVariantFunc(AStream));
end;

class procedure TcxValueType.ReadDisplayText(PBuffer: PChar; AStream: TStream);
begin
  SetDisplayText(PBuffer, ReadStringFunc(AStream));
end;

class procedure TcxValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
end;

class procedure TcxValueType.SetDisplayText(PBuffer: PChar; const DisplayText: string);
var
  P: PStringValue;
begin
  P := PPointer(PBuffer)^;
  if P = nil then
  begin
    New(P);
    PPointer(PBuffer)^ := P;
  end;
  P^ := DisplayText;
end;

class procedure TcxValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteVariantProc(AStream, GetDataValue(PBuffer));
end;

class procedure TcxValueType.WriteDisplayText(PBuffer: PChar; AStream: TStream);
begin
  WriteStringProc(AStream, GetDisplayText(PBuffer));
end;

{ TcxStringValueType }

class function TcxStringValueType.CompareValues(P1, P2: Pointer): Integer;
var
  S1, S2: string;
begin
  if Assigned(P1) then
  begin
    if Assigned(P2) then
    begin
      S1 := PStringValue(P1)^;
      S2 := PStringValue(P2)^;
      if S1 = S2 then
        Result := 0
      else
        if S1 < S2 then
          Result := -1
        else
          Result := 1;
    end
    else
      Result := 1;
  end
  else
  begin
    if Assigned(P2) then
      Result := -1
    else
      Result := 0;
  end;
end;

class function TcxStringValueType.GetValue(PBuffer: PChar): Variant;
begin
  Result := GetDataValue(@PBuffer);
end;

class function TcxStringValueType.GetVarType: Integer;
begin
  Result := varString;
end;

class function TcxStringValueType.IsString: Boolean;
begin
  Result := True;
end;

class procedure TcxStringValueType.PrepareValueBuffer(var PBuffer: PChar);
begin
  PBuffer := PPointer(PBuffer)^;
end;

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

class procedure TcxStringValueType.FreeBuffer(PBuffer: PChar);
begin
  Dispose(PStringValue(PPointer(PBuffer)^));
end;

class function TcxStringValueType.GetDataSize: Integer;
begin
  Result := SizeOf(PStringValue);
end;

class function TcxStringValueType.GetDataValue(PBuffer: PChar): Variant;
var
  P: PStringValue;
begin
  P := PPointer(PBuffer)^;
  if P <> nil then
    Result := P^
  else
    Result := inherited GetDataValue(PBuffer);
end;

class procedure TcxStringValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadStringFunc(AStream));
end;

class procedure TcxStringValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  SetDisplayText(PBuffer, Value);
end;

class procedure TcxStringValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteStringProc(AStream, GetDisplayText(PBuffer));
end;

{ TcxWideStringValueType }

class function TcxWideStringValueType.CompareValues(P1, P2: Pointer): Integer;
var
  WS1, WS2: WideString;
begin
  if Assigned(P1) then
  begin
    if Assigned(P2) then
    begin
      WS1 := PWideStringValue(P1)^;
      WS2 := PWideStringValue(P2)^;
      if WS1 = WS2 then
        Result := 0
      else
        if WS1 < WS2 then
          Result := -1
        else
          Result := 1;
    end
    else
      Result := 1;
  end
  else
  begin
    if Assigned(P2) then
      Result := -1
    else
      Result := 0;
  end;
end;

class function TcxWideStringValueType.GetValue(PBuffer: PChar): Variant;
begin
  Result := GetDataValue(@PBuffer);
end;

class function TcxWideStringValueType.GetVarType: Integer;
begin
  Result := varOleStr;
end;

class function TcxWideStringValueType.IsString: Boolean;
begin
  Result := True;
end;

class procedure TcxWideStringValueType.PrepareValueBuffer(var PBuffer: PChar);
begin
  PBuffer := PPointer(PBuffer)^;
end;

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

class procedure TcxWideStringValueType.FreeBuffer(PBuffer: PChar);
begin
  Dispose(PWideStringValue(PPointer(PBuffer)^));
end;

class function TcxWideStringValueType.GetDataSize: Integer;
begin
  Result := SizeOf(PWideStringValue);
end;

class function TcxWideStringValueType.GetDataValue(PBuffer: PChar): Variant;
var
  P: PWideStringValue;
begin
  P := PPointer(PBuffer)^;
  if P <> nil then
    Result := P^
  else
    Result := inherited GetDataValue(PBuffer);
end;

class procedure TcxWideStringValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadWideStringFunc(AStream));
end;

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

class procedure TcxWideStringValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteWideStringProc(AStream, VarToStr(GetDataValue(PBuffer)));
end;

{ TcxSmallintValueType }

class function TcxSmallintValueType.CompareValues(P1, P2: Pointer): Integer;
begin
  Result := PSmallInt(P1)^ - PSmallInt(P2)^;
end;

class function TcxSmallintValueType.GetVarType: Integer;
begin
  Result := varSmallint;
end;

class function TcxSmallintValueType.GetDataSize: Integer;
begin
  Result := SizeOf(SmallInt);
end;

class function TcxSmallintValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PSmallInt(PBuffer)^;
end;

class procedure TcxSmallintValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadSmallIntFunc(AStream));
end;

class procedure TcxSmallintValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PSmallInt(PBuffer)^ := Value;
end;

class procedure TcxSmallintValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteSmallIntProc(AStream, SmallInt(GetDataValue(PBuffer)));
end;

{ TcxIntegerValueType }

class function TcxIntegerValueType.CompareValues(P1, P2: Pointer): Integer;
begin
  Result := PInteger(P1)^ - PInteger(P2)^;
end;

class function TcxIntegerValueType.GetVarType: Integer;
begin
  Result := varInteger;
end;

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

class function TcxIntegerValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PInteger(PBuffer)^;
end;

class procedure TcxIntegerValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadIntegerFunc(AStream));
end;

class procedure TcxIntegerValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PInteger(PBuffer)^ := Value;
end;

class procedure TcxIntegerValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteIntegerProc(AStream, Integer(GetDataValue(PBuffer)));
end;

{ TcxWordValueType }

class function TcxWordValueType.CompareValues(P1, P2: Pointer): Integer;
begin
  Result := PWord(P1)^ - PWord(P2)^;
end;

class function TcxWordValueType.GetVarType: Integer;
begin
  Result := {$IFDEF DELPHI6}varWord{$ELSE}$0012{$ENDIF};
end;

class function TcxWordValueType.GetDataSize: Integer;
begin
  Result := SizeOf(Word);
end;

class function TcxWordValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PWord(PBuffer)^;
end;

class procedure TcxWordValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadWordFunc(AStream));
end;

class procedure TcxWordValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PWord(PBuffer)^ := Value;
end;

class procedure TcxWordValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteWordProc(AStream, Word(GetDataValue(PBuffer)));
end;

{ TcxBooleanValueType }

class function TcxBooleanValueType.CompareValues(P1, P2: Pointer): Integer;
begin
  Result := Integer(PBoolean(P1)^) - Integer(PBoolean(P2)^);
end;

class function TcxBooleanValueType.GetVarType: Integer;
begin
  Result := varBoolean;
end;

class function TcxBooleanValueType.GetDataSize: Integer;
begin
  Result := SizeOf(Boolean);
end;

class function TcxBooleanValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PBoolean(PBuffer)^;
end;

class function TcxBooleanValueType.GetDefaultDisplayText(PBuffer: PChar): string;
begin
  try
  {$IFDEF DELPHI6}
    Result := BoolToStr(GetDataValue(PBuffer), True);
  {$ELSE}
    Result := GetDataValue(PBuffer);
  {$ENDIF}
  except
    on EVariantError do
      Result := '';
  end;
end;

class procedure TcxBooleanValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadBooleanFunc(AStream));
end;

class procedure TcxBooleanValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PBoolean(PBuffer)^ := Value;
end;

class procedure TcxBooleanValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteBooleanProc(AStream, Boolean(GetDataValue(PBuffer)));
end;

{ TcxFloatValueType }

class function TcxFloatValueType.CompareValues(P1, P2: Pointer): Integer;
var
  D1, D2: Double;
begin
  D1 := PDouble(P1)^;
  D2 := PDouble(P2)^;
  if D1 = D2 then
    Result := 0
  else
    if D1 < D2 then
      Result := -1
    else
      Result := 1;
end;

class function TcxFloatValueType.GetVarType: Integer;
begin
  Result := varDouble;
end;

class function TcxFloatValueType.GetDataSize: Integer;
begin
  Result := SizeOf(Double);
end;

class function TcxFloatValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PDouble(PBuffer)^;
end;

class procedure TcxFloatValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
var
  E: Extended;
begin
  ReadFloatProc(AStream, E);
  PDouble(PBuffer)^ := E;
end;

class procedure TcxFloatValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PDouble(PBuffer)^ := Value;
end;

class procedure TcxFloatValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteFloatProc(AStream, Double(GetDataValue(PBuffer)));
end;

{ TcxCurrencyValueType }

class function TcxCurrencyValueType.CompareValues(P1, P2: Pointer): Integer;
var
  C1, C2: Currency;
begin
  C1 := PCurrency(P1)^;
  C2 := PCurrency(P2)^;
  if C1 = C2 then
    Result := 0
  else
    if C1 < C2 then
      Result := -1
    else
      Result := 1;
end;

class function TcxCurrencyValueType.GetVarType: Integer;
begin
  Result := varCurrency;
end;

class function TcxCurrencyValueType.GetDataSize: Integer;
begin
  Result := SizeOf(Currency);
end;

class function TcxCurrencyValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PCurrency(PBuffer)^;
end;

class procedure TcxCurrencyValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadCurrencyFunc(AStream));
end;

class procedure TcxCurrencyValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PCurrency(PBuffer)^ := Value;
end;

class procedure TcxCurrencyValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteCurrencyProc(AStream, Currency(GetDataValue(PBuffer)));
end;

{ TcxDateTimeValueType }

class function TcxDateTimeValueType.CompareValues(P1, P2: Pointer): Integer;
var
  D1, D2: Double;
begin
  D1 := PDateTime(P1)^;
  D2 := PDateTime(P2)^;
  if D1 = D2 then
    Result := 0
  else
    if D1 < D2 then
      Result := -1
    else
      Result := 1;
end;

class function TcxDateTimeValueType.GetVarType: Integer;
begin
  Result := varDate;
end;

class function TcxDateTimeValueType.GetDataSize: Integer;
begin
  Result := SizeOf(TDateTime);
end;

class function TcxDateTimeValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := GetDateTime(PBuffer);
end;

class function TcxDateTimeValueType.GetDefaultDisplayText(PBuffer: PChar): string;
var
  DT: TDateTime;
begin
  DT := GetDateTime(PBuffer);
  try
    Result := VarToStr(DT);
  except
    on EVariantError do
      Result := DateTimeToStr(DT);
  end;
end;

class procedure TcxDateTimeValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadDateTimeFunc(AStream));
end;

class procedure TcxDateTimeValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PDateTime(PBuffer)^ := VarToDateTime(Value);
end;

class procedure TcxDateTimeValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteDateTimeProc(AStream, TDateTime(GetDataValue(PBuffer)));
end;

class function TcxDateTimeValueType.GetDateTime(PBuffer: PChar): TDateTime;
begin
  Result := PDateTime(PBuffer)^;
end;
 
{$IFDEF DELPHI6}

{ TcxLargeIntValueType }

class function TcxLargeIntValueType.CompareValues(P1, P2: Pointer): Integer;
var
  L1, L2: LargeInt;
begin
  L1 := PLargeInt(P1)^;
  L2 := PLargeInt(P2)^;
  if L1 = L2 then
    Result := 0
  else
    if L1 < L2 then
      Result := -1
    else
      Result := 1;
end;

class function TcxLargeIntValueType.GetVarType: Integer;
begin
  Result := varInt64;
end;

class function TcxLargeIntValueType.GetDataSize: Integer;
begin
  Result := SizeOf(LargeInt);
end;

class function TcxLargeIntValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := PLargeInt(PBuffer)^;
end;

class procedure TcxLargeIntValueType.ReadDataValue(PBuffer: PChar; AStream: TStream);
begin
  SetDataValue(PBuffer, ReadLargeIntFunc(AStream));
end;

class procedure TcxLargeIntValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PLargeInt(PBuffer)^ := Value;
end;

class procedure TcxLargeIntValueType.WriteDataValue(PBuffer: PChar; AStream: TStream);
begin
  WriteLargeIntProc(AStream, PLargeInt(PBuffer)^);
end;

{$IFNDEF NONDB}
{ TcxFMTBcdValueType }

class function TcxFMTBcdValueType.CompareValues(P1, P2: Pointer): Integer;
var
  B1, B2: TBcd;
begin
  B1 := PBcd(P1)^;
  B2 := PBcd(P2)^;
  Result := BcdCompare(B1, B2);
end;

class function TcxFMTBcdValueType.GetVarType: Integer;
begin
  Result := VarFMTBcd;
end;

class function TcxFMTBcdValueType.GetDataSize: Integer;
begin
  Result := SizeOf(TBcd);
end;

class function TcxFMTBcdValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := VarFMTBcdCreate(PBcd(PBuffer)^);
//  Result := BcdToDouble(PBcd(PBuffer)^);
end;

class function TcxFMTBcdValueType.GetDefaultDisplayText(PBuffer: PChar): string;
var
  Bcd: TBcd;
begin
  Bcd := PBcd(PBuffer)^;
  Result := BcdToStrF(Bcd, ffGeneral, 0, 0); // P, D - ignored in BcdToStrF 
end;

class procedure TcxFMTBcdValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PBcd(PBuffer)^ := VarToBcd(Value);
end;

{ TcxSQLTimeStampValueType }

class function TcxSQLTimeStampValueType.CompareValues(P1, P2: Pointer): Integer;
var
  T1, T2: TSQLTimeStamp;
begin
  T1 := PSQLTimeStamp(P1)^;
  T2 := PSQLTimeStamp(P2)^;
  Result := T1.Year - T2.Year;
  if Result = 0 then
  begin
    Result := T1.Month - T2.Month;
    if Result = 0 then
    begin
      Result := T1.Day - T2.Day;
      if Result = 0 then
      begin
        Result := T1.Hour - T2.Hour;
        if Result = 0 then
        begin
          Result := T1.Minute - T2.Minute;
          if Result = 0 then
          begin
            Result := T1.Second - T2.Second;
            if Result = 0 then
              Result := T1.Fractions - T2.Fractions;
          end;
        end;
      end;
    end;
  end;
end;

class function TcxSQLTimeStampValueType.GetVarType: Integer;
begin
  Result := VarSQLTimeStamp;
end;

class function TcxSQLTimeStampValueType.GetDataSize: Integer;
begin
  Result := SizeOf(TSQLTimeStamp);
end;

class function TcxSQLTimeStampValueType.GetDataValue(PBuffer: PChar): Variant;
begin
  Result := SQLTimeStampToDateTime(PSQLTimeStamp(PBuffer)^);
end;

class procedure TcxSQLTimeStampValueType.SetDataValue(PBuffer: PChar; const Value: Variant);
begin
  PSQLTimeStamp(PBuffer)^ := VarToSQLTimeStamp(Value);
end;
{$ENDIF}
{$ENDIF}

{ TcxVariantValueType }

class function TcxVariantValueType.CompareValues(P1, P2: Pointer): Integer;
begin
  if Assigned(P1) then
  begin
    if Assigned(P2) then
    begin
      Result := VarCompare(PVariant(P1)^, PVariant(P2)^);
    end
    else
      Result := 1;
  end
  else
  begin
    if Assigned(P2) then
      Result := -1
    else
      Result := 0;
  end;
end;

class function TcxVariantValueType.GetValue(PBuffer: PChar): Variant;
begin
  Result := GetDataValue(@PBuffer);
end;

class procedure TcxVariantValueType.PrepareValueBuffer(var PBuffer: PChar);
begin
  PBuffer := PPointer(PBuffer)^;
end;

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
  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; AValueDef: TcxValueDef);
var
  I, AStartIndex, AEndIndex: Integer;
  PBuffer, PSource, PDest: PChar;
  AValueDefs: TcxValueDefs;
begin
  AValueDefs := AValueDef.ValueDefs;
  if AValueDefs = ValueDefs then
  begin
    InternalValueDefs.Add(AValueDef.ValueTypeClass, True, AValueDef.FTextStored, AValueDef);
    AStartIndex := 0;
    AEndIndex := FRecordBuffers.Count - 1;
  end
  else
  begin
    AStartIndex := -FInternalRecordBuffers.Count;
    AEndIndex := -1;
  end;
  for I := AStartIndex to AEndIndex do
  begin
    PBuffer := RecordBuffers[I];
    if PBuffer <> nil then
    begin
      ReallocMem(PBuffer, AValueDefs.RecordSize + AValueDef.BufferSize);
      RecordBuffers[I] := PBuffer;
      if AIndex < AValueDefs.Count then
      begin
        PSource := IncPChar(PBuffer, AValueDefs[AIndex].Offset);
        PDest := IncPChar(PSource, AValueDef.BufferSize);
        System.Move(PSource^, PDest^, AValueDefs.RecordSize - (PSource - PBuffer));
      end
      else
      begin
        PSource := PBuffer;
        if AValueDefs.Count > 0 then
          PSource := IncPChar(PSource, AValueDefs[AValueDefs.Count - 1].Offset +
            AValueDefs[AValueDefs.Count - 1].BufferSize)
        else
          PSource := IncPChar(PSource, AValueDefs.RecordSize);
      end;
      FillChar(PSource^, AValueDef.BufferSize, 0);
    end;
  end;
end;

function TcxDataStorage.IsRecordFlag(PBuffer: PChar; AFlag: Byte): Boolean;
begin
  Result := (PBuffer <> nil) and ((PByte(PBuffer)^ and AFlag) = AFlag);
end;

procedure TcxDataStorage.RemoveValueDef(AValueDef: TcxValueDef);
var
  I, AStartIndex, AEndIndex: Integer;
  PBuffer, PSource, PDest: PChar;
  AValueDefs: TcxValueDefs;
  AFreeAndNil: Boolean;
begin
  AValueDefs := AValueDef.ValueDefs;
  if AValueDefs = ValueDefs then
  begin
    InternalValueDefs.RemoveByLinkObject(AValueDef);
    AStartIndex := 0;
    AEndIndex := FRecordBuffers.Count - 1;
  end
  else
  begin
    AStartIndex := -FInternalRecordBuffers.Count;
    AEndIndex := -1;
  end;
  AFreeAndNil := AValueDef.Stored and (AValueDefs.StoredCount <= 1);
  for I := AStartIndex to AEndIndex do
  begin
    PBuffer := RecordBuffers[I];
    if PBuffer <> nil then
      if AFreeAndNil then
        FreeAndNilRecordBuffer(I)
      else
        if AValueDef.Stored then
        begin
          AValueDef.FreeBuffer(PBuffer);
          PDest := IncPChar(PBuffer, AValueDef.Offset);
          PSource := IncPChar(PDest, AValueDef.BufferSize);
          System.Move(PSource^, PDest^, AValueDefs.RecordSize - (PSource - PBuffer));
          ReallocMem(PBuffer, AValueDefs.RecordSize - AValueDef.BufferSize); // existing data in the block is not affected!
          RecordBuffers[I] := PBuffer;
        end;
  end;
end;

procedure TcxDataStorage.ValueDefsChanged(AValueDef: TcxValueDef; AResyncNeeded: Boolean);
//var
//  AInternalValueDef: TcxValueDef;
begin
  (*
  if FDestroying then Exit;
  if not FValueDefsChanged then
  begin
    ClearRecords(False);
    FValueDefsChanged := True;
    if AResyncNeeded and (AValueDef.ValueDefs = ValueDefs) then
    begin
      AInternalValueDef := InternalValueDefs.FindByLinkObject(AValueDef);
      if AInternalValueDef <> nil then
        AInternalValueDef.Assign(AValueDef);
    end;
  end;
  *)
end;

function TcxDataStorage.ValueDefsByRecordIndex(Index: Integer): TcxValueDefs;
begin
  if Index < 0 then
    Result := FInternalValueDefs
  else
    Result := FValueDefs;
end;

function TcxDataStorage.GetRecordBuffer(Index: Integer): PChar;
begin
  if Index >= 0 then
    Result := PChar(FRecordBuffers[Index])
  else
    Result := PChar(FInternalRecordBuffers[-Index - 1]);
end;

function TcxDataStorage.GetRecordCount: Integer;
begin
  Result := FRecordBuffers.Count;
end;

procedure TcxDataStorage.SetStoredValuesOnly(Value: Boolean);
begin
  if FStoredValuesOnly <> Value then
  begin
    ClearRecords(False);
    FStoredValuesOnly := Value;
    InitStructure(ValueDefs);
  end;
end;

procedure TcxDataStorage.SetRecordBuffer(Index: Integer; Value: PChar);
begin
  if Index >= 0 then
    FRecordBuffers[Index] := Value
  else
    FInternalRecordBuffers[-Index - 1] := Value;
end;

procedure TcxDataStorage.SetRecordCount(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if RecordCount <> Value then
  begin
    // TODO: Capacity
    while RecordCount < Value do
      AppendRecord;
    while RecordCount > Value do
      DeleteRecord(RecordCount - 1);
  end;
end;

procedure TcxDataStorage.SetUseRecordID(Value: Boolean);
begin
  if FUseRecordID <> Value then
  begin
    ClearRecords(False);
    FUseRecordID := Value;
    InitStructure(ValueDefs);
  end;
end;

{ TcxLookupList }

constructor TcxLookupList.Create;
begin
  inherited Create;
  FItems := TList.Create;
end;

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

procedure TcxLookupList.Clear;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    Dispose(PcxLookupListItem(FItems[I]));
  FItems.Clear;
end;

function TcxLookupList.Find(const AKeyValue: Variant; var AIndex: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  AIndex := 0;
  Result := False;
  L := 0;
  H := FItems.Count - 1;
  if L <= H then
    repeat
      I := (L + H) div 2;
      C := VarCompare(PcxLookupListItem(FItems[I]).KeyValue, AKeyValue);
      if C = 0 then
      begin
        AIndex := I;
        Result := True;
        Break;
      end
      else
        if C < 0 then
          L := I + 1
        else
          H := I - 1;
      if L > H then
      begin
        AIndex := L;
        Break;
      end;
    until False;
end;

procedure TcxLookupList.Insert(AIndex: Integer; const AKeyValue: Variant;
  const ADisplayText: string);
var
  P: PcxLookupListItem;
begin
  New(P);
  P.KeyValue := AKeyValue;
  P.DisplayText := ADisplayText;
  FItems.Insert(AIndex, P);
end;

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

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

{ TcxValueTypeClassList }

constructor TcxValueTypeClassList.Create;
begin
  inherited Create;
  FItems := TList.Create;
end;

destructor TcxValueTypeClassList.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;

function TcxValueTypeClassList.ItemByCaption(const ACaption: string): TcxValueTypeClass;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FItems.Count - 1 do
    if TcxValueTypeClass(FItems[I]).Caption = ACaption then
    begin
      Result := TcxValueTypeClass(FItems[I]);
      Break;
    end;
end;

procedure TcxValueTypeClassList.RegisterItem(AValueTypeClass: TcxValueTypeClass);
begin
  if FItems.IndexOf(TObject(AValueTypeClass)) = -1 then
    FItems.Add(TObject(AValueTypeClass));
end;

procedure TcxValueTypeClassList.UnregisterItem(AValueTypeClass: TcxValueTypeClass);
begin
  FItems.Remove(TObject(AValueTypeClass));
end;

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

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

initialization
  cxValueTypeClassList.RegisterItem(TcxStringValueType);
  cxValueTypeClassList.RegisterItem(TcxWideStringValueType);
  cxValueTypeClassList.RegisterItem(TcxSmallintValueType);
  cxValueTypeClassList.RegisterItem(TcxIntegerValueType);
  cxValueTypeClassList.RegisterItem(TcxWordValueType);
  cxValueTypeClassList.RegisterItem(TcxBooleanValueType);
  cxValueTypeClassList.RegisterItem(TcxFloatValueType);
  cxValueTypeClassList.RegisterItem(TcxCurrencyValueType);
  cxValueTypeClassList.RegisterItem(TcxDateTimeValueType);
  {$IFDEF DELPHI6}
  cxValueTypeClassList.RegisterItem(TcxLargeIntValueType);
    {$IFNDEF NONDB}
  cxValueTypeClassList.RegisterItem(TcxFMTBcdValueType);
  cxValueTypeClassList.RegisterItem(TcxSQLTimeStampValueType);
    {$ENDIF}
  {$ENDIF}
  cxValueTypeClassList.RegisterItem(TcxVariantValueType);
  cxValueTypeClassList.RegisterItem(TcxObjectValueType);

finalization
  cxValueTypeClassList.UnregisterItem(TcxObjectValueType);
  cxValueTypeClassList.UnregisterItem(TcxVariantValueType);
  {$IFDEF DELPHI6}
    {$IFNDEF NONDB}
  cxValueTypeClassList.UnregisterItem(TcxSQLTimeStampValueType);
  cxValueTypeClassList.UnregisterItem(TcxFMTBcdValueType);
    {$ENDIF}
  cxValueTypeClassList.UnregisterItem(TcxLargeIntValueType);
  {$ENDIF}
  cxValueTypeClassList.UnregisterItem(TcxDateTimeValueType);
  cxValueTypeClassList.UnregisterItem(TcxCurrencyValueType);
  cxValueTypeClassList.UnregisterItem(TcxFloatValueType);
  cxValueTypeClassList.UnregisterItem(TcxBooleanValueType);
  cxValueTypeClassList.UnregisterItem(TcxWordValueType);
  cxValueTypeClassList.UnregisterItem(TcxIntegerValueType);
  cxValueTypeClassList.UnregisterItem(TcxSmallintValueType);
  cxValueTypeClassList.UnregisterItem(TcxWideStringValueType);
  cxValueTypeClassList.UnregisterItem(TcxStringValueType);

  FValueTypeClassList.Free;
  FValueTypeClassList := nil;

end.