cxdatastorage.pas

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

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;