sctdata.pas

suite component ace report

end;

destructor TSctData.Destroy;
begin
  if FReturnStream <> nil then FReturnStream.Free;
  if FStrings <> nil then FStrings.Free;
  inherited Destroy;
end;

function TSctData.GetReturnStream: TStream;
begin
  if FReturnStream = nil then FReturnStream := TMemoryStream.Create;
  result := FReturnStream;
end;

procedure TSctData.Reset;
begin
  FIsNull := False;
end;

procedure TSctData.SetValue( var Value );
begin

end;

procedure TSctData.SetData( data: TSctData );
begin

end;

function TSctData.AsFormat(format: TSctFormat): String;
begin
  result := Format.FormatAsString(self);
end;

function TSctData.GetAsBoolean: Boolean;
begin
  Result := False;
end;

function TSctData.GetAsFloat: Double;
begin
  Result := 0;
end;


function TSctData.GetAsStream: TStream;
var
  text: array[0..256] of Char;
begin
  TMemoryStream(ReturnStream).Clear;
  strPCopy(text, AsString);
  ReturnStream.Write(text, length(AsString));
  ReturnStream.Position := 0;
  result := ReturnStream;
end;

function TSctData.GetAsStrings: TStrings;
begin
  FStrings.Clear;
  FStrings.Add(AsString);
  Result := FStrings;
end;


{ TSctString }
constructor TSctString.Create;
begin
  inherited Create;
  DataType := dtypeString;
end;

procedure TSctString.Reset;
begin
  ValueString := '';
  FIsNull := False;
end;

procedure TSctString.SetValue( var Value );
begin
  ValueString := String(Value);
end;

procedure TSctString.SetData( data: TSctData );
begin
  ValueString := TSctString(data).AsString;
  FIsNull := data.IsNull;
end;

function TSctString.GetAsString: String;
begin
  result := ValueString;
end;
function TSctString.GetAsInteger: LongInt;
begin
  result := StrToInt(ValueString);
end;
function TSctString.GetAsFloat: Double;
begin
  try
    Result := StrToFloat(ValueString);
  except
    Result := 0;
  end;
end;
function TSctString.GetAsDateTime: TDateTime;
begin
  result := StrToDateTime(ValueString);
end;
function TSctString.GetAsBoolean: Boolean;
begin
  if Length(ValueString) > 0 then
  begin
    case ValueString[1] of
      'Y','y','T','t': Result := True;
    else Result := False;
    end;
  end else Result := False;
end;

procedure TSctString.SetAsString(Value: String);
begin
  ValueString := Value;
end;
procedure TSctString.SetAsInteger(Value: LongInt);
begin
  ValueString := IntToStr(Value);
end;
procedure TSctString.SetAsFloat(Value: Double);
begin
  ValueString := FloatToStr(Value);
end;
procedure TSctString.SetAsDateTime(Value: TDateTime);
begin
  ValueString := DateToStr(Value);
end;
procedure TSctString.SetAsBoolean(Value: Boolean);
begin
  if Value then ValueString := 'True'
  else ValueString := 'False';
end;


{ TSctInteger }
constructor TSctInteger.Create;
begin
  inherited Create;
  DataType := dtypeInteger;
end;

procedure TSctInteger.Reset;
begin
  ValueInteger := 0;
  FIsNull := False;
end;

procedure TSctInteger.SetValue( var Value );
begin
  ValueInteger :=  LongInt(Value);
end;

procedure TSctInteger.SetData( data: TSctData );
begin
  ValueInteger := TSctInteger(data).AsInteger;
  FIsNull := data.IsNull;
end;

function TSctInteger.GetAsString: String;
begin
  result := IntToStr(ValueInteger);
end;
function TSctInteger.GetAsInteger: LongInt;
begin
  result := ValueInteger;
end;
function TSctInteger.GetAsFloat: Double;
begin
  result := ValueInteger;
end;
function TSctInteger.GetAsBoolean: Boolean;
begin
  result := ValueInteger <> 0;
end;

procedure TSctInteger.SetAsString(Value: String);
begin
  ValueInteger := StrToInt(Value);
end;
procedure TSctInteger.SetAsInteger(Value: LongInt);
begin
  ValueInteger := Value;
end;
procedure TSctInteger.SetAsFloat(Value: Double);
begin
  ValueInteger := Trunc(Value);
end;
procedure TSctInteger.SetAsBoolean(Value: Boolean);
begin
  if Value then ValueInteger := 1
  else ValueInteger := 0;
end;


{ TSctFloat }
constructor TSctFloat.Create;
begin
  inherited Create;
  DataType := dtypeFloat;
  TotalType := ttValue;
  FCalc := TSctCalc.Create;
end;

destructor TSctFloat.destroy;
begin
  FCalc.Free;
  inherited destroy;
end;

procedure TSctFloat.Reset;
begin
  if Calc <> nil Then Calc.reset;
  FIsNull := False;
end;

procedure TSctFloat.SetValue( var Value );
begin
   Calc.Value := Double(Value);
end;

procedure TSctFloat.SetData( data: TSctData );
begin
  Calc.Value := TSctFloat(data).Calc.Value;
  Calc.Sum := TSctFloat(data).Calc.Sum;
  Calc.Count := TSctFloat(data).Calc.Count;
  Calc.Min := TSctFloat(data).Calc.Min;
  Calc.Max := TSctFloat(data).Calc.Max;
  FIsNull := data.IsNull;
end;

function TSctFloat.getValuefloat: Double;
begin
  case TotalType of
    ttSum: Result := Calc.Sum;
    ttCount: Result := Calc.Count;
    ttMax: Result := Calc.Max;
    ttMin: Result := Calc.Min;
    ttAverage: Result := Calc.Average;
    ttValue: Result := Calc.Value
  else Result := 0;
  end;
end;

procedure TSctFloat.SetValueFloat(Value: Double);
begin
  Calc.Value := Value;
end;


function TSctFloat.GetAsString: String;
begin
  result := FloatToStr(ValueFloat);
end;
function TSctFloat.GetAsInteger: LongInt;
begin
  result := Trunc(ValueFloat);
end;
function TSctFloat.GetAsFloat: Double;
begin
  result := ValueFloat;
end;
function TSctFloat.GetAsBoolean: Boolean;
begin
  result := ValueFloat <> 0;
end;

procedure TSctFloat.SetAsString(Value: String);
begin
  ValueFloat := StrToFloat(Value);
end;
procedure TSctFloat.SetAsInteger(Value: LongInt);
begin
  ValueFloat := Value;
end;
procedure TSctFloat.SetAsFloat(Value: Double);
begin
  ValueFloat := Value;
end;
procedure TSctFloat.SetAsBoolean(Value: Boolean);
begin
  if Value then ValueFloat := 1.0
  else ValueFloat := 0;
end;


{ TSctDateTime }
constructor TSctDateTime.Create;
begin
  inherited Create;
  DataType := dtypeDateTime;
end;

procedure TSctDateTime.Reset;
begin
  ValueDateTime := 0;
  FIsNull := False;
end;

procedure TSctDateTime.SetValue( var Value );
begin
  ValueDateTime := TDateTime(Value);
end;

procedure TSctDateTime.SetData( data: TSctData );
begin
  ValueDateTime := TSctDateTime(data).AsDateTime;
  FIsNull := data.IsNull;
end;

function TSctDateTime.GetAsString: String;
begin
  if (ValueDateTime = 0) or (FIsNull) then result := ''
  else result := DatetoStr(ValueDateTime);
end;
function TSctDateTime.GetAsDateTime: TDateTime;
begin
  result := ValueDateTime;
end;
function TSctDateTime.GetAsFloat: Double;
begin
  result := ValueDateTime;
end;

procedure TSctDateTime.SetAsString(Value: String);
begin
  ValueDateTime := StrToDateTime(Value);
end;
procedure TSctDateTime.SetAsDateTime( Value: TDateTime);
begin
  ValueDateTime := Value;
end;

procedure TSctDateTime.SetAsFloat( Value: Double );
begin
  ValueDateTime := TDateTime( Value );
end;


{ TSctBoolean }
constructor TSctBoolean.Create;
begin
  inherited Create;
  DataType := dtypeBoolean;
end;

procedure TSctBoolean.Reset;
begin
  ValueBoolean := False;
  FIsNull := False;
end;

procedure TSctBoolean.SetValue( var Value );
begin
  ValueBoolean := Boolean(Value);
end;

procedure TSctBoolean.SetData( data: TSctData );
begin
  ValueBoolean := TSctBoolean(data).AsBoolean;
  FIsNull := data.IsNull;
end;

function TSctBoolean.GetAsString: String;
begin
  if ValueBoolean Then result := 'True'
  else result := 'False';
end;
function TSctBoolean.GetAsInteger: LongInt;
begin
  if ValueBoolean then result := 1
  else result := 0;
end;
function TSctBoolean.GetAsFloat: Double;
begin
  if ValueBoolean then result := 1
  else result := 0;
end;
function TSctBoolean.GetAsBoolean: Boolean;
begin
  result := ValueBoolean;
end;

procedure TSctBoolean.SetAsString(Value: String);
begin
  if CompareText(Value, 'True') = 0 then ValueBoolean := True
  else ValueBoolean := False;
end;
procedure TSctBoolean.SetAsInteger(Value: LongInt);
begin
  ValueBoolean := Value <> 0;
end;
procedure TSctBoolean.SetAsFloat(Value: Double);
begin
  ValueBoolean := Value <> 0;
end;
procedure TSctBoolean.SetAsBoolean(Value: Boolean);
begin
  ValueBoolean := Value;
end;



{ TSctBlob }
constructor TSctBlob.Create;
begin
  inherited Create;
  DataType := dtypeBlob;
  ValueStream := TMemoryStream.Create;
end;

destructor TSctBlob.Destroy;
begin
  if ValueStream <> nil Then ValueStream.Free;
  inherited Destroy;
end;

procedure TSctBlob.Reset;
begin
  if ValueStream <> nil Then ValueStream.Clear;
  FIsNull := False;
end;

procedure TSctBlob.SetValue( var Value );
begin
  ValueStream.LoadFromStream( TStream(Value) );
end;

procedure TSctBlob.SetData( data: TSctData );
begin
  ValueStream.LoadFromStream(TSctBlob(data).ValueStream);
  FIsNull := data.IsNull;
end;

function TSctBlob.GetAsString: String;
begin
  Result := '';
  Raise Exception.Create('I am not allowing blob or graphic value AsString.');
end;

procedure TSctBlob.SetAsString(Value: String);
begin
  ValueStream.Clear;
  if Length(Value) > 0 then
  begin
    {$ifdef WIN32}
    ValueStream.WriteBuffer(Pointer(Value)^, Length(Value));
    {$else}
    ValueStream.WriteBuffer(Value[1], Length(Value));
    {$endif}
  end;
end;

function TSctBlob.GetAsStream: TStream;
begin
  ValueStream.Position := 0;
  result := ValueStream;
end;

procedure TSctBlob.SetAsStream(stream: TStream);
begin
  ValueStream.LoadFromStream( stream );
end;


{ TSctMemo }
constructor TSctMemo.Create;
begin
  inherited Create;
  DataType := dtypeMemo;
end;

function TSctMemo.GetAsString: String;
{$ifndef WIN32}
var
  len: Byte;
{$endif}
begin
  Result := '';
  if ValueStream.Size > 0 then
  begin
    ValueStream.Position := 0;
    {$ifdef WIN32}
    SetString(Result, PChar(nil), ValueStream.Size);
    ValueStream.Read(Pointer(Result)^, ValueStream.Size);
    {$else}
    if ValueStream.Size > 255 then len := 255
    else len := ValueStream.Size;
    Result[0] := Char(len);
    ValueStream.Read(Result[1], len);
    {$endif}
  end;
end;

function TSctMemo.GetAsStrings: TStrings;
begin
  FStrings.Clear;
  FStrings.LoadFromStream(AsStream);
  Result := FStrings;
end;

procedure TSctMemo.SetAsStrings(Strings: TStrings);
begin
  FStrings.Clear;
  ValueStream.Clear;
  Strings.SaveToStream(ValueStream);
end;

{ TSctGraphic }
constructor TSctGraphic.Create;
begin
  inherited Create;
  DataType := dtypeGraphic;
end;

{ TSctUnknown }
constructor TSctUnknown.Create;
begin
  inherited Create;
  DataType := dtypeUnknown;
end;

function TSctUnknown.GetAsString: String;
begin
  Result := 'Unknown type, check to see if field exists.';
end;


{$IFDEF WIN32}
  {$WARNINGS ON}
{$ENDIF}
end.