sctreg.pas

suite component ace report

unit SctReg;

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

{$I ace.inc}

{$ifdef WIN32}
  {$R sctreg32.dcr}
{$else}
  {$R sctreg16.dcr}
{$endif}

{ ----------------------------------------------------------------
  Ace Reporter Version 1.0
  Copyright 1995 SCT Accociates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface

uses AceAlign, classes, dsgnintf, sctrep;

{ TSctGrouppageEditor }
type
TSctGrouppageEditor = class(TComponentEditor)
private
  FFirst: Boolean;
public
{$ifdef VCL120PLUS}
  constructor Create(AComponent: TComponent; ADesigner: IFormDesigner); override;
{$else}
  constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); override;
{$endif}
  destructor Destroy; override;
  procedure Edit; override;
  procedure ExecuteVerb(Index: Integer); override;
  function GetVerb(Index: Integer): string; override;
  function GetVerbCount: Integer; override;

end;

{ TSctLabelEditor }
TSctLabelEditor = class(TComponentEditor)
private
public
{$ifdef VCL120PLUS}
  constructor Create(AComponent: TComponent; ADesigner: IFormDesigner); override;
{$else}
  constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); override;
{$endif}
  destructor Destroy; override;
end;


{ TSctVarProperty }
TSctVarProperty = class(TComponentProperty)
public
  procedure SetValue(const Value: string); override;
  procedure GetValues(Proc: TGetStrProc); override;
  function GetValue: string; override;
  function GetPage: TSctPage;
{$ifdef AceBDE}
  procedure SetDataLists;
  {$ifdef WIN32}
  procedure AddDataLists(const S: String);
  {$endif}
{$endif}
end;

{ TSctTotalVarProperty }
TSctTotalVarProperty = class(TComponentProperty)
public
  procedure SetValue(const Value: string); override;
  procedure GetValues(Proc: TGetStrProc); override;
  function GetValue: string; override;
end;

{ TSctLevelProperty }
TSctLevelProperty = class(TComponentProperty)
public
  function GetValue: string; override;
  procedure SetValue(const Value: string); override;
  procedure GetValues(Proc: TGetStrProc); override;
end;

{ TSctTotalLevelProperty }
TSctTotalLevelProperty = class(TComponentProperty)
public
  function GetValue: string; override;
  procedure SetValue(const Value: string); override;
  procedure GetValues(Proc: TGetStrProc); override;
end;

{ TSctReadOnlySubProperty }
TSctReadOnlySubProperty = class(TClassProperty)
public
  function GetAttributes: TPropertyAttributes; override;
end;

{ TSctDataSetProperty }
{$ifdef AceBDE}
TSctDataSetProperty = class(TComponentProperty)
public
  procedure SetValue(const Value: string); override;
  procedure GetValues(Proc: TGetStrProc); override;
  function GetValue: string; override;
end;
{$endif}

{$ifdef AceBDE}
{ TSctDataSourceDSGProperty }
TSctDataSourceDSGProperty = class(TClassProperty)
public
  function GetValue: string; override;
  function GetAttributes: TPropertyAttributes; override;
end;
{$endif}

{ TSctReserveBandProperty }
{TSctReserveBandProperty = class(TComponentProperty)
public
  function GetValue: string; override;
  procedure SetValue(const Value: string); override;
  procedure GetValues(Proc: TGetStrProc); override;
end;
}

procedure Register;

implementation

uses dialogs, sysutils, forms,
    sctctrl, sctvar, exptintf, pageman
    , sctbtn, ACEMETER, ACEPREV, typinfo, controls
  {$ifdef WIN32}
  ,acertfc
  {$endif}
{$ifdef AceBDE}
  ,db
{$endif}
    ;


{ TSctGrouppageEditor }

{$ifdef VCL120PLUS}
constructor TSctGrouppageEditor.Create(AComponent: TComponent; ADesigner: IFormDesigner);
{$else}
constructor TSctGrouppageEditor.Create(AComponent: TComponent; ADesigner: TFormDesigner);
{$endif}
begin
  inherited Create(AComponent, ADesigner);

  if TSctPage(Component).pagemanager = nil Then
  begin
    FFirst := True;
    TSctPage(AComponent).pagemanager := TsctPageManager.Create(Application);
    TSctPageManager(TSctPage(AComponent).pagemanager).page := TSctPage(AComponent);
    TSctPage(AComponent).pagemanager.Hide;
    TSctPageManager(TSctPage(Component).pagemanager).PageDesigner := Designer;
  end;

end;

destructor TSctGrouppageEditor.destroy;
begin
  { page manager get destroyed by the form because this object
    get destroyed and created very often }

  inherited destroy;
end;

procedure TSctGrouppageEditor.Edit;
begin
  if TSctPage(Component).pagemanager <> nil Then
  begin
    TSctPageManager(TSctPage(Component).pagemanager).PageDesigner := Designer;
    if FFirst then FFirst := False
    else TSctPage(Component).pagemanager.Show;
  end;
end;

procedure TSctGrouppageEditor.ExecuteVerb(Index: Integer);
begin
  if Index = 0 then Edit;
end;

function TSctGrouppageEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Page Mananger';
  end;
end;

function TSctGrouppageEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TSctLabelEditor }
{$ifdef VCL120PLUS}
constructor TSctLabelEditor.Create(AComponent: TComponent; ADesigner: IFormDesigner);
{$else}
constructor TSctLabelEditor.Create(AComponent: TComponent; ADesigner: TFormDesigner);
{$endif}
begin
  inherited Create(AComponent, ADesigner);
  AceAlign.AceAlignLabels.AddControl(TControl(AComponent));
end;
destructor TSctLabelEditor.Destroy;
begin
  AceAlign.AceAlignLabels.DeleteControl(TControl(Component));
  inherited Destroy;
end;


{ TSctVarProperty }
function TSctVarProperty.GetValue: string;
var
  Component: TComponent;
begin
  Component := TComponent(GetOrdValue);
  if Component = nil then Result := ''
  else Result := TSctvar(Component).Name;
end;


procedure TSctVarProperty.GetValues(Proc: TGetStrProc);
var
  J: Integer;
  pg: TSctPage;
  list: TList;
begin
  pg := GetPage;
{$ifdef AceBDE}
  SetDataLists;
{$endif}
  TSctGroupPage(pg).LetUpdateDataList := False;
  pg.UpdateVarList;
  TSctGroupPage(pg).LetUpdateDataList := True;
  list := pg.varlist;
  if list <> nil then
  begin
    for J := 0 to (list.Count - 1) do
    begin
      if Not (TSctvar(list.Items[J]) is TSctTotalvar) Then
      begin
        if Not (TSctvar(list.Items[J]) is TSctTotalvar) Then
          Proc( TSctvar(list.Items[J]).Name);
      end;
    end;

  end;
end;

procedure TSctVarProperty.SetValue(const Value: string);
var
  J: Integer;
  Comp: TComponent;
  pg:TSctPage;
  list: TList;
  myVal: String;
begin
  if Value = '' then Comp := nil else
  begin
    pg := GetPage;

    myVal := UpperCase(Value);
    Comp := nil;
    list := pg.varlist;
    if list <> nil then
    begin
      for J := 0 to (list.Count - 1) do
      begin
        if uppercase(TSctvar(list.Items[J]).Name) = myVal Then
        begin
          if (TSctvar(list.Items[J]) is TSctTotalvar) Then
             raise Exception.Create('You cannot assign a Total Variable to a Variable Property')
          else Comp := list.Items[J];
        end;
      end;
    end;

    if Comp = nil Then
      raise EPropertyError.Create('Invalid Property');
  end;

  SetOrdValue(Longint(Comp));

end;
function TSctVarProperty.GetPage: TSctPage;
var
  comp: TPersistent;
begin
  comp := GetComponent(0);
  if Comp is TSctGroup Then result := TSctPage(TSctGroup(Comp).Page)
  else if Comp is TSctLabel Then result := TSctPage(TSctLabel(Comp).page)
  else if Comp is TSctvar Then result := TSctPage(TSctvar(Comp).parent)
  else raise Exception.Create('variable property editor can not find page');
end;
{$ifdef AceBDE}
procedure TSctVarProperty.SetDataLists;
var
  pg: TSctGroupPage;
  {$ifndef WIN32}
  pos: Integer;
  {$endif}
begin
  pg := TSctGroupPage(GetPage);
  pg.FullDSList.Clear;
  pg.FullDSNames.Clear;
  {$ifdef WIN32}
  Designer.GetComponentNames(GetTypeData(TDataSource.ClassInfo), AddDataLists);
  {$else}
  with Designer.Form do
  begin
    for pos := 0 to ComponentCount - 1 do
    begin
      if Components[pos] is TDataSource then
      begin
        pg.FullDSNames.Add(Components[pos].name);
        pg.FullDSList.Add(Components[pos]);
      end;
    end;
  end;
  {$endif}
end;

{$ifdef WIN32}
procedure TSctVarProperty.AddDataLists(const S: String);
var
  pg: TSctGroupPage;
begin
  if Designer.GetComponent(S) is TDataSource then
  begin
    pg := TSctGroupPage(GetPage);
    pg.FullDSNames.Add(S);
    pg.FullDSList.Add(Designer.GetComponent(S));
  end;
end;
{$endif}
{$endif}




{ TSctTotalVarProperty }
function TSctTotalVarProperty.GetValue: string;
var
  Component: TComponent;
begin
  Component := TComponent(GetOrdValue);
  if Component = nil then Result := ''
  else Result := TSctvar(Component).Name;
end;


procedure TSctTotalVarProperty.GetValues(Proc: TGetStrProc);
var
  J: Integer;
  pg: TSctPage;
  list: TList;
begin
  if GetComponent(0) is TSctGroup Then pg := TSctPage(TSctGroup(GetComponent(0)).Page)
  else if GetComponent(0) is TSctLabel Then pg := TSctPage(TSctLabel(GetComponent(0)).page)
  else if GetComponent(0) is TSctvar Then pg := TSctPage(TSctvar(GetComponent(0)).parent)
  else raise Exception.Create('variable property editor can not find page');

  pg.UpdateVarList;
  list := pg.varlist;
  if list <> nil then
  begin
    for J := 0 to (list.Count - 1) do
    begin
      if (TSctvar(list.Items[J]) is TSctTotalvar) Then
         Proc( TSctvar(list.Items[J]).Name)
    end;
  end;
end;