sctvar.pas

suite component ace report

unit SctVar;

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

interface
{$I ace.inc}

uses  {$IFDEF WIN32} windows, {$ELSE} wintypes, winprocs, {$ENDIF}
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, sctdata
  {$ifdef AceBDE} ,db,dbCtrls
     {$ifndef VCL130PLUS} ,dbtables {$endif}
  {$endif}
  ;

type

TSctVar = class;

{ TGetDataEvent }
  TGetDataEvent = procedure (oVar: TSctvar) of object;

{ TSctUpdateMode }
  TSctUpdateMode = (umNeedUpdate, umUpdating, umNoUpdate);

{ TSctVarId }
  TSctVarId = (vidAbstract, vidDBVar, vidExprVar, vidTotalVar, vidAutoDataVar
                 , vidDateTimeVar, vidPageVar);

{ TSctLevel }
TSctLevel = class(TControl)
private
  FLevel: Integer;
  FIsHeader: Boolean;
protected
  procedure SetParent(AParent: TWinControl); override;
  function GetPage: TComponent; virtual;

  procedure DefineProperties(Filer: TFiler); override;
  procedure ReadIsHeader(Reader: TReader);
  procedure WriteIsHeader( Writer: TWriter);
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property Level: Integer read FLevel write FLevel;
  property Page: TComponent read GetPage;

  property IsHeader: Boolean read FIsHeader write FIsHeader default False;

published
end;


{ TSctvar }
TSctVar = class(TControl)
private
  FDataLast, FDataNow: TSctData;
  FAutovar: Boolean;

  FDataType: TSctDataTypes;
  FUpdateMode: TSctUpdateMode;
  FUpdateLevel: TSctLevel;
  FId: TSctVarId;
  FActive: Boolean;
  FInitialized: Boolean;
  FRunning: Boolean;
protected
  procedure SetName(const NewName: TComponentName); override;
  procedure SetParent(AParent: TWinControl); override;
  procedure Loaded; override;
  procedure SetRunning(lRun: Boolean);

  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;

  function GetIsNull: Boolean;
  procedure SetIsNull(n: Boolean);

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

  procedure SetAsString( value: String); virtual;
  procedure SetAsInteger( value: Integer); virtual;
  procedure SetAsFloat( value: Double); virtual;
  procedure SetAsDateTime( value: TDateTime); virtual;
  procedure SetAsBoolean( value: Boolean); virtual;
  procedure SetAsStream( value: TStream); virtual;
  procedure SetAsStrings( Value: TStrings); virtual;

  function GetDataType: TSctDataTypes; virtual;
  function getdatanow: TSctData; virtual;
  function getdata: TSctData; virtual;
  function getactive: Boolean; virtual;

  procedure DefineProperties(Filer: TFiler); override;
  procedure ReadAutoVar(Reader: TReader);
  procedure WriteAutoVar( Writer: TWriter);
  procedure ReadID(Reader: TReader);
  procedure WriteID( Writer: TWriter);

  procedure SetUpdateLevel(ul: TSctLevel);

  procedure SetDataType(dt: TSctDataTypes);
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure UpdateData; virtual;
  procedure UpdateLast; virtual;
  procedure ReverseUpdate; virtual;
  procedure Initialize; virtual;
  property Initialized: Boolean read FInitialized write FInitialized;
  property Running: Boolean read FRunning write SetRunning;
  property DataNow: TSctData read getdatanow write FDataNow;
  property DataLast: TSctData read FDataLast write FDataLast;
  property Data: TSctData read getdata;

  property AsString: String read GetAsString write SetAsString;
  property AsInteger: Integer 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;
  property AsStrings: TStrings read GetAsStrings write SetAsStrings;

  property IsNull: Boolean read GetIsNull write SetIsNull;

  property DataType: TSctDataTypes read GetDataType write SetDataType;
  property UpdateMode: TSctUpdateMode read FUpdateMode write FUpdateMode;
  property Active: Boolean read getactive write FActive;

  property Cursor;

  property AutoVar: Boolean read FAutoVar write FAutoVar;
  property Id: TSctVarId read FId write FId;
  property UpdateLevel: TSctLevel read FUpdateLevel write SetUpdateLevel;
  procedure Reset; virtual;
  procedure ResetData; virtual;
published
end;

{$ifdef AceBDE}

{ TSctdbvar }
  TSctDBVar = class(TSctvar)
  private
    FFieldNo: Integer;
    FDataField: String;
    FDataLink: TFieldDataLink;
{    FField: TField;}
    procedure ActiveChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);

  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    function GetDataType: TSctDataTypes; override;
    function GetFieldDataType: TFieldType; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateData; override;
    property Field: TField read GetField;
    procedure Initialize; override;
    property FieldDataType: TFieldType read GetFieldDataType;
  published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property UpdateLevel;
  end;
{$endif}

{ TSctExprvar }
  TSctExprVar = class(TSctvar)
  private
    FOnGetData: TGetDataEvent;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateData; override;
  published
    property DataType;
    property OnGetData: TGetDataEvent read FOnGetData write FOnGetData;
    property UpdateLevel;
  end;

{ TSctDateTimeVar }
  TSctDateTimeVar = class(TSctVar)
  private
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Initialize; override;
  published
    property UpdateLevel;
  end;

{ TSctPageVar }
  TSctPageVar = class(TSctVar)
  private
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure UpdateData; override;
  published
    property UpdateLevel;
  end;

{ TSctTotalvar }
  TSctTotalvar = class(TSctvar)
  private
    FVariable: TSctvar;
    FDataNowList, FDataLastList: TList;
    FResetNowList, FResetLastList: TList;
    FIgnoreNulls: Boolean;
  protected
    function GetDataNow: TSctData; override;
    procedure Notification(AComponent: TComponent;
            Operation: TOperation); override;
    function GetActive: Boolean; override;
    procedure SetVariable(V: TSctvar);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateData; override;
    function GetDataType: TSctDataTypes; override;
    procedure Initialize; override;

    procedure ResetLevel(Level: TSctLevel);
    procedure UpdateLast; override;
    procedure ReverseUpdate; override;
    procedure UpdateAtlevel(Level: TSctLevel);
    function Getlevel(level: TSctLevel; TotalType: TSctTotalType): TSctFloat;
    function GetLevelNow(Level: TSctLevel; TotalType: TSctTotalType): TSctFloat;
    function GetLevelLast(Level: TSctLevel; TotalType: TSctTotalType): TSctFloat;
    procedure AddLevels;
    procedure DeleteLevels;
    property DataNowList: TList read FDataNowList write FDataNowList;
    property DataLastList: TList read FDataLastList write FDataLastList;
    property ResetNowList: TList read FResetNowList write FResetNowList;
    property ResetLastList: TList read FResetLastList write FResetLastList;
    procedure Reset; override;
    procedure ResetAtlevel(Level: TSctLevel);
    procedure ResetData; override;
    procedure ResetMarkedLevel(Level: TSctLevel);
  published
    property Variable: TSctvar read FVariable write SetVariable;
    property UpdateLevel;
    property IgnoreNulls: Boolean read FIgnoreNulls write FIgnoreNulls default False;
  end;


implementation

uses sctrep, sctctrl, sctutil, sctconst, acememoU, typinfo;

{$IFDEF WIN32}
  {$WARNINGS OFF}
{$ENDIF}

{ TSctLevel }
constructor TSctLevel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLevel := 0;
  FIsHeader := False;
end;

destructor TSctLevel.destroy;
begin
  inherited Destroy;
end;

function TSctLevel.GetPage: TComponent;
begin
  result := Parent;
end;

procedure TSctLevel.SetParent(AParent: TWinControl);
begin
  if AParent <> Parent then
  begin
    if AParent <> nil Then
    begin
      if AParent is TSctPage Then
      begin
        TSctPage(AParent).InsertLevel(self);
        inherited SetParent(AParent);
      end else Abort;
    end else
    begin
      if Parent <> nil Then TSctPage(Parent).RemoveLevel(self);
      inherited SetParent(AParent);
    end;
  end;
end;

procedure TSctLevel.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('IsHeader', readisheader, writeisheader, FIsHeader);
end;
procedure TSctLevel.ReadIsHeader(Reader: TReader);
begin
  FIsHeader := Reader.ReadBoolean;
end;
procedure TSctLevel.WriteIsHeader( Writer: TWriter);
begin
  Writer.WriteBoolean(FIsHeader);
end;


{ TSctvar }
constructor TSctvar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataNow := nil;
  FDataLast := nil;
  visible := False;
  AutoVar := False;
  FDataType := dtypeUnknown;
{  UpdateMode := umNeedUpdate;}
  UpdateMode := umNoUpdate;
  FUpdateLevel := nil;
  FId := vidAbstract;
  FActive := True;
  FInitialized := False;
  FRunning := False;
end;

destructor TSctvar.Destroy;
begin
  if FDataNow <> nil Then FDataNow.Free;
  if FDataLast <> nil Then FDataLast.Free;
  FDataNow := nil;
  FDataLast := nil;
  inherited destroy;
end;

procedure TSctvar.Reset;
begin
  DataNow.Reset;
end;

procedure TSctVar.SetName(const NewName: TComponentName);
begin
  inherited SetName(NewName);
  if Parent <> nil then
  begin
    TSctGroupPage(Parent).UpdatePageManager;
  end;
end;

procedure TSctvar.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent is TSctLevel) Then
  begin
    if (Operation = opRemove) And (FUpdateLevel = TSctLevel(AComponent)) Then
      FUpdateLevel := nil;
  end;
end;

procedure TSctVar.SetUpdateLevel(ul: TSctLevel);
begin
  if ul <> FUpdateLevel then
  begin
    FUpdateLevel := ul;
    if Parent <> nil then TSctGroupPage(Parent).VarChanged;
  end;
end;

procedure TSctVar.SetDataType(dt: TSctDataTypes);
begin
  if dt <> FDataType then
  begin
    FDataType := dt;
    if Parent <> nil then TSctGroupPage(Parent).VarChanged;
  end;
end;



function TSctvar.getactive: Boolean;
begin
  result := FActive;
end;

procedure TSctVar.SetRunning(lRun: Boolean);
begin
  if lRun <> FRunning then
  begin
    FRunning := lRun;
    if Not FRunning then Initialize;
  end;
end;

procedure TSctvar.Loaded;
begin
  if updatelevel = nil Then
  begin
    if parent is TSctGrouppage Then
    begin
      updatelevel := TSctGrouppage(parent).detail.Updatelevel;
    end;
  end;
  inherited Loaded;
end;

procedure TSctvar.SetParent(AParent: TWinControl);
begin
  if AParent <> Parent then
  begin
    if AParent <> nil Then
    begin
      if AParent is TSctPage Then
      begin
        TSctPage(AParent).InsertVar(self);
      end;
      inherited SetParent(AParent);
    end else
    begin
      if Parent <> nil Then