sctdata.pas

suite component ace report

unit SctData;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}
uses
  classes, sysutils;

{$ifdef WIN32}
{$WARNINGS OFF}
{$endif}

type

{ TSctDataTypes }
  TSctDataTypes = (dtypeUnknown, dtypeString, dtypeFloat, dtypeInteger,
                   dtypeBoolean, dtypeDateTime, dtypeBlob, dtypeMemo, dtypeGraphic);

{ TSctTextCase }
  TSctTextCase = (tcNone, tcUpper, tcLower);

{ TSctData }
  TSctData = class;

{ TSctTotalType }
  TSctTotalType = (ttSum, ttCount, ttMax, ttMin, ttAverage, ttValue);

{ TSctCalc }
  TSctCalc = class(TObject)
  private
    FValue, FSum, FMin, FMax: Double;
    FCount: LongInt;
  protected
    function GetAverage: Double;
    procedure NewVal(Val: Double);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Update; virtual;
    property Value: Double read FValue write NewVal;
    property Sum: Double read FSum write FSum;
    property Count: LongInt read FCount write FCount;
    property Min: Double read FMin write FMin;
    property Max: Double read FMax write FMax;
    property Average: Double read GetAverage;
    procedure Reset;
  end;


{ TSctRootformat }
  TSctRootFormat = class(TPersistent)
  private
    FDisplayFormat: String;
    FTextCase: TsctTextCase;
    FFloatFormat: TFloatFormat;
    FWidth, FDigits: Integer;
    FSctLabel: TComponent;
    FReturnStream: TStream;
    FSuppressNulls: Boolean;
    FUseCurrencyDecimals: Boolean;
  protected
    procedure SetDisplayFormat(DF: String);
    procedure SetTextCase(TC: TSctTextCase);
    procedure SetFloatFormat( FF: TFloatFormat);
    procedure SetWidth(W: Integer);
    procedure SetDigits(D: Integer);
    procedure SetCurrencyDecimals(C: Boolean);

    function GetReturnStream: TStream;
    property ReturnStream: TStream read GetReturnStream write FReturnStream;
    procedure SetSuppressNulls(sn: Boolean);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function FormatAsString(Data: TSctData): String;
    function FormatAsStream(Data: TSctData): TStream;
    property SctLabel: TComponent read FSctLabel write FSctLabel;

    property FloatFormat: TFloatFormat read FFloatFormat write SetFloatFormat default ffGeneral;
    property Digits: Integer read FDigits write SetDigits default 0;
  published
    property DisplayFormat: String read FDisplayFormat write SetDisplayFormat;
    property Width: Integer read FWidth write SetWidth default 15;
    property TextCase: TsctTextCase read FTextCase write SetTextCase default tcNone;
    property SuppressNulls: Boolean read FSuppressNulls write SetSuppressNulls default False;
    property UseCurrencyDecimals: Boolean read FUseCurrencyDecimals write SetCurrencyDecimals default False;
  end;

{ TSctFormat }
  TSctFormat = class(TSctRootFormat)
  published
    property FloatFormat;
    property Digits;
  end;

{ TSctFloatFormat }
  TSctFloatFormat = class(TSctRootFormat)
  public
    constructor Create; override;
  published
    property FloatFormat default ffNumber;
    property Digits default 2;
  end;

{ TSctData }
  TSctData = class(TObject)
  private
    FDataType: TSctDataTypes;
    FReturnStream: TStream;
    FIsNull: Boolean;
    FStrings: TStrings;
  protected
    function GetReturnStream: TStream;

    function GetAsString: String; virtual; abstract;
    function GetAsInteger: LongInt; virtual; abstract;
    function GetAsFloat: Double; virtual;
    function GetAsDateTime: TDateTime; virtual; abstract;
    function GetAsBoolean: Boolean; virtual;
    function GetAsStream: TStream; virtual;
    function GetAsStrings: TStrings; virtual;

    procedure SetAsString(Value: String); virtual; abstract;
    procedure SetAsInteger(Value: LongInt); virtual; abstract;
    procedure SetAsFloat(Value: Double); virtual; abstract;
    procedure SetAsDateTime(Value: TDateTime); virtual; abstract;
    procedure SetAsBoolean(Value: Boolean); virtual; abstract;
    procedure SetAsStream(Stream: TStream); virtual; abstract;
    procedure SetAsStrings(Strings: TStrings); virtual; abstract;

    property ReturnStream: TStream read GetReturnStream write FReturnStream;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure SetValue( var Value ); virtual;
    procedure SetData( Data: TSctData ); virtual;
    procedure Reset; virtual;
    property DataType: TSctDataTypes read FDataType write FDataType;
    property AsString: String read GetAsString write SetAsString;
    property AsInteger: LongInt read GetAsInteger write SetAsInteger;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsStream: TStream read GetAsStream write SetAsStream;
    function AsFormat(format: TSctFormat): String; virtual;
    property IsNull: Boolean read FIsNull write FIsNull;
    property AsStrings: TStrings read GetAsStrings write SetAsStrings;
  end;

{ TSctString }
  TSctString = class(TSctData)
  private
    FValueString: String;
  protected
    function GetAsString: String; override;
    function GetAsInteger: LongInt; override;
    function GetAsFloat: Double; override;
    function GetAsDateTime: TDateTime; override;
    function GetAsBoolean: Boolean; override;

    procedure SetAsString(Value: String); override;
    procedure SetAsInteger(Value: LongInt); override;
    procedure SetAsFloat(Value: Double); override;
    procedure SetAsDateTime(Value: TDateTime); override;
    procedure SetAsBoolean(Value: Boolean); override;
  public
    constructor Create; override;
    procedure Reset; override;
    procedure SetValue( var Value); override;
    procedure SetData( Data: TSctData ); override;
    property ValueString: String read FValueString write FValueString;
  end;

{ TSctInteger }
  TSctInteger = class(TSctData)
  private
    FValueInteger: LongInt;
  protected
    function GetAsString: String; override;
    function GetAsInteger: LongInt; override;
    function GetAsFloat: Double; override;
    function GetAsBoolean: Boolean; override;

    procedure SetAsString(Value: String); override;
    procedure SetAsInteger(Value: LongInt); override;
    procedure SetAsFloat(Value: Double); override;
    procedure SetAsBoolean(Value: Boolean); override;
  public
    constructor Create; override;
    procedure Reset; override;
    procedure SetValue( var Value); override;
    procedure SetData( data: TSctData ); override;
    property ValueInteger: LongInt read FValueInteger write FValueInteger;
  end;

{ TSctFloat }
  TSctFloat = class(TSctData)
  private
    FCalc: TSctCalc;
    FTotalType: TSctTotalType;
  protected
    function GetValueFloat: Double; virtual;
    procedure SetValueFloat(Value: Double); virtual;

    function GetAsString: String; override;
    function GetAsInteger: LongInt; override;
    function GetAsFloat: Double; override;
    function GetAsBoolean: Boolean; override;

    procedure SetAsString(Value: String); override;
    procedure SetAsInteger(Value: LongInt); override;
    procedure SetAsFloat(Value: Double); override;
    procedure SetAsBoolean(Value: Boolean); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Reset; override;
    procedure SetValue( var Value); override;
    procedure SetData( data: TSctData ); override;
    property ValueFloat: Double read GetValueFloat write SetValueFloat;
    property Calc: TSctCalc read FCalc write FCalc;
    property TotalType: TSctTotalType read FTotalType write FTotalType;
  end;

{ TSctDateTime }
  TSctDateTime = class(TSctData)
  private
    FValueDateTime: TDateTime;
  protected
    function GetAsString: String; override;
    function GetAsDateTime: TDateTime; override;
    function GetAsFloat: Double; override;

    procedure SetAsString(Value: String); override;
    procedure SetAsDateTime( Value: TDateTime); override;
    procedure SetAsFloat( Value: Double ); override;
  public
    constructor Create; override;
    procedure Reset; override;
    procedure SetValue( var Value); override;
    procedure SetData( Data: TSctData ); override;
    property ValueDateTime: TDateTime read FValueDateTime write FValueDateTime;
  end;

{ TSctBoolean }
  TSctBoolean = class(TSctData)
  private
    FValueBoolean: Boolean;
  protected
    function GetAsString: String; override;
    function GetAsInteger: LongInt; override;
    function GetAsFloat: Double; override;
    function GetAsBoolean: Boolean; override;

    procedure SetAsString(Value: String); override;
    procedure SetAsInteger(Value: LongInt); override;
    procedure SetAsFloat(Value: Double); override;
    procedure SetAsBoolean(Value: Boolean); override;
  public
    constructor Create; override;
    procedure Reset; override;
    procedure SetValue( var Value); override;
    procedure SetData( Data: TSctData ); override;
    property ValueBoolean: Boolean read FValueBoolean write FValueBoolean;
  end;

{ TSctBlob }
  TSctBlob = class(TSctData)
  private
    FValueStream: TMemoryStream;
  protected
    function GetAsString: String; override;
    function GetAsStream: TStream; override;

    procedure SetAsStream(Stream: TStream); override;
    procedure SetAsString(Value: String); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Reset; override;
    procedure SetValue( var Value); override;
    procedure SetData( Data: TSctData ); override;
    property ValueStream: TMemoryStream read FValueStream write FValueStream;
  end;

  { TSctMemo }
  TSctMemo = class(TSctBlob)
  private
  protected
    function GetAsString: String; override;

    function GetAsStrings: TStrings; override;
    procedure SetAsStrings(Strings: TStrings); override;
  public
    constructor Create; override;
  end;

{ TSctGraphic }
  TSctGraphic = class(TSctBlob)
  private
  protected
  public
    constructor Create; override;
  end;

{ TSctUnknown }
  TSctUnknown = class(TSctBlob)
  private
  protected
    function GetAsString: String; override;
  public
    constructor Create; override;
  end;

implementation

uses
  mask, sctutil, dialogs, sctctrl;

{ TSctCalc }
constructor TSctCalc.Create;
begin
  inherited Create;
  reset;
end;


destructor TSctCalc.Destroy;
begin

  inherited Destroy;
end;

function TSctCalc.GetAverage: Double;
begin
  if Count = 0 Then Result := 0
  else Result := (Sum / Count);
end;

procedure TSctCalc.NewVal(Val: Double);
begin
  FValue := Val;
  update;
end;

procedure TSctCalc.update;
begin
  Sum := Sum + Value;
  if (Count = 0) Then
  begin
    Max := Value;
    Min := Value;
  end;
  if Value > Max Then Max := Value;
  if Value < Min Then Min := Value;
  Count := Count + 1;
end;

procedure TSctCalc.Reset;
begin
  Sum := 0;
  Count := 0;
  Max := 0;
  Min := 0;
  FValue := 0;
end;


{ TsctFormat }
constructor TSctRootFormat.Create;
begin
  inherited Create;
  FDisplayFormat := '';
  FTextCase := tcNone;
  FFloatFormat := ffGeneral;
  FWidth := 15;
  FDigits := 0;
  FReturnStream := nil;
  FSuppressNulls := False;
  FUseCurrencyDecimals := False;
end;

destructor TSctRootFormat.Destroy;
begin
  if FReturnStream <> nil then FReturnStream.Free;

  inherited destroy;
end;

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

procedure TSctRootFormat.SetDisplayFormat(DF: String);
begin
  if FDisplayFormat <> DF Then
  begin
    FDisplayFormat := DF;
    if SctLabel <> nil Then TSctLabel(SctLabel).Invalidate;
  end;
end;
procedure TSctRootFormat.SetTextCase(TC: TSctTextCase);
begin
  if FTextCase <> TC Then
  begin
    FTextCase := TC;
    if SctLabel <> nil Then TSctLabel(SctLabel).Invalidate;
  end;
end;
procedure TSctRootFormat.SetFloatFormat( FF: TFloatFormat);
begin
  if FFloatFormat <> FF Then
  begin
    FFloatFormat := FF;
    if SctLabel <> nil Then TSctLabel(SctLabel).Invalidate;
  end;
end;
procedure TSctRootFormat.SetWidth(W: Integer);
begin
  if FWidth <> W Then
  begin
    FWidth := W;
    if SctLabel <> nil Then TSctLabel(SctLabel).Invalidate;
  end;
end;
procedure TSctRootFormat.SetDigits(D: Integer);
begin
  if FDigits <> D Then
  begin
    FDigits := D;
    if SctLabel <> nil Then TSctLabel(SctLabel).Invalidate;
  end;
end;
procedure TSctRootFormat.SetSuppressNulls(sn: Boolean);
begin
  if FSuppressNulls <> sn Then
  begin
    FSuppressNulls := sn;
    if SctLabel <> nil Then TSctLabel(SctLabel).Invalidate;
  end;
end;
procedure TSctRootFormat.SetCurrencyDecimals(C: Boolean);
begin
  if FUseCurrencyDecimals <> C Then
  begin
    FUseCurrencyDecimals := C;
    if SctLabel <> nil Then TSctLabel(SctLabel).Invalidate;
  end;
end;



function TsctRootFormat.FormatAsString(data: TSctData): String;
var
  S: string;
  lDF: Boolean;
  bFalse, bTrue: String;
  spot: Integer;
begin
  lDF := Not sctEmpty(DisplayFormat);

  if FSuppressNulls And Data.IsNull then result := ''
  else
  begin
    case data.DataType of
      dtypeString:
        if lDF Then S := FormatMaskText(DisplayFormat, data.AsString )
        else S := data.AsString;
      dtypeInteger, dtypeFloat:
        if lDF Then S := FormatFloat(DisplayFormat, data.AsFloat)
        else
        begin
          if (FloatFormat = ffCurrency) And FUseCurrencyDecimals then
          begin
            S := FloatToStrF(data.AsFloat, FloatFormat, Width, CurrencyDecimals);
          end
          else
            S := FloatToStrF(data.AsFloat, FloatFormat, Width, Digits);
        end;
      dtypeDateTime:
        if lDF Then S := FormatDateTime(DisplayFormat, data.AsDateTime)
        else S := data.AsString;
      dtypeBoolean:
        if lDF then
        begin
          spot := Pos(';', DisplayFormat);
          if spot = 0 then spot := 256;
          bFalse := Copy(DisplayFormat, spot + 1, 255);
          bTrue := Copy(DisplayFormat, 1, spot - 1);
          if Data.AsBoolean then S := bTrue
          else S := bFalse;
        end else S := Data.AsString;
    else
      S := data.AsString;
    end;

    case TextCase of
      tcNone: result := S;
      tcUpper: result := UpperCase(S);
      tcLower: result := LowerCase(S);
    end;
  end;
end;

function TSctRootFormat.FormatAsStream(data: TSctData): TStream;
var
  text: array[0..256] of Char;
  str: String;
begin
  TMemoryStream(ReturnStream).Clear;
  str := FormatAsString(data);
  strPCopy(text, str);
  ReturnStream.Write(text, length(str));
  ReturnStream.Position := 0;
  result := ReturnStream;
end;

{ TSctFloatFormat }
constructor TSctFloatFormat.Create;
begin
  inherited Create;
  FDigits := 2;
  FFloatFormat := ffNumber;
end;

{ TSctData }
constructor TSctData.Create;
begin
  inherited Create;
  DataType := dtypeUnknown;
  FIsNull := False;
  Reset;
  FStrings := TStringList.Create;