sctrep.pas

suite component ace report

  property PercentDone: Single read FPercentDone write FPercentDone;
  property AceViewer: TAceViewer read FAceViewer write FAceViewer;
  procedure AbortGeneration( Sender: TObject);

  property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
  property PageCount: Integer read FPageCount write FPageCount;


  property LastPagePos: Integer read FLastPagePos write FLastPagePos;
  procedure AddUpdateBand(Band: TSctBand); virtual;
  procedure UpdatePageManager;
  procedure UpdateDataLists;
  property InUpdateDataLists: Boolean read FInUpdateDataLists write FInUpdateDataLists;

  procedure PrintPageFoot;
  procedure PrintNewPageRepeats;
  procedure PrintRepeats( Band: TSctBand);
  procedure RepeatPrintBand(Band: TSctBand);
  procedure RepeatPrintBandList(Band: TSctBand);

  procedure AddMainBands;
  procedure InsertOverLayBand(o: TSctOverLayBand);
  procedure RemoveOverLayBand(o: TSctOverLayBand);
  procedure InsertSubBand(oSB: TSctSubBand);
  procedure RemoveSubBand(oSB: TSctSubBand);
  procedure InsertSubDataBand(oSDB: TSctSubDataBand);
  procedure RemoveSubDataBand(oSDB: TSctSubDataBand);
  procedure InsertDataHFBand(oHF: TSctDataHeadBand);
  procedure RemoveDataHFBand(oHF: TSctDataHeadBand);
  property SubBands: TList read FSubbands write FSubBands;
  property SubDataBands: TList read FSubDataBands write FSubDataBands;
  property DataHFBands: TList read FDataHFBands write FDataHFBands;
  property PrintDataList: TList read FPrintDataList write FPrintDataList;
  property PrintList: TList read FPrintList write FPrintList;

  property OverLayBands: TList read FOverLayBands write FOverLayBands;
  procedure PrintOverLays(First: Boolean); virtual;

{$ifdef AceBDE}
  procedure InsertDataSourceGuide(dsg: TSctDataSourceGuide);
  procedure RemoveDataSourceGuide(dsg: TSctDataSourceGuide);
  procedure AddDataSource(ds: TDataSource); virtual;
{$endif}
  procedure VarChanged;

  property DataSourceList: TList read FDataSourceList write FDataSourceList;



  procedure AddBand(bd: TSctBand; myBands, myHeads: TList);
  procedure AddSubBand(bd: TSctBand; myBands, myHeads: TList);

  procedure DeleteAllGroups;

  procedure ResetTotalLevel(Level: TSctLevel);
  procedure ReverseUpdateDataLevel(Level: TSctLevel);
  procedure UpdateDataLevel(Level: TSctLevel);
  procedure PrintBand(Band: TSctBand; PageFootBand: boolean);
  procedure PrintBorder;
  function GetBandListHeight( bd: TSctBand ): Integer;
  function GetPageFootHeight: Integer;

  procedure PrintBandList(Band: TSctBand; PageFootBand: Boolean );

  procedure PrintGroupHeads( GroupLevel: Integer );
  procedure PrintGroupFeet( GroupLevel: Integer );
  procedure CheckHeight( nH: Integer );
  procedure CheckBandHeight(Band: TSctBand);
  procedure MakeList;
  procedure MakeBandList(Band: TSctBand);

  procedure InsertGroup(oGroup: TSctGroup); virtual;
  procedure RemoveGroup(oGroup: TSctGroup); virtual;
  property Groups: TList read FGroups write FGroups;
  property AtGroupLevel: Integer read FAtGroupLevel write FAtGroupLevel;

  property DataIsFinished: Boolean read FDataIsFinished write FDataIsFinished;

  property OverLayList: TList read FOverLayList write FOverLayList;
  property PageList: TList read FPageList write FPageList;
  property MainList: TList read FMainList write FMainList;
  property Grouplist: TList read FGrouplist write FGrouplist;
  property PFHeight: Integer read FPFHeight write FPFHeight;

  property GroupPageState: TSctGroupPageState read FGroupPageState write FGroupPageState;
  property UpdateBandLevelList: TList read FUpdateBandLevelList write FUpdateBandLevelList;

  property Pen: TPen read FPen write FPen;
  property Rtf: TSctRtfFile read FRtf write FRtf;

  property Continuous: Boolean read FContinuous write FContinuous;
  property FullDSList: TList read FFullDSList write FFullDSList;
  property FullDSNames: TStringList read FFullDSNames write FFullDSNames;
  property NoDsgList: TStringList read FNoDsgList write FNoDsgList;
{$ifdef AceBDE}
  property DataLink: TDataLink read FDataLink write FDataLink;
{$endif}
  procedure PostUpdateVarlist;

  property Records: LongInt read FRecords write FRecords;
  property Skipped: LongInt read FSkipped write FSkipped;
  property LetUpdateDataList: Boolean read FLetUpdateDataList write FLetUpdateDataList;
  property Printing: Boolean read FPrinting write FPrinting;

  function InitReport: Boolean;
  procedure UnInitReport;

  procedure StartReport;
  procedure Process;
  procedure EndReport;

  procedure ResetDataLevel(level: TSctLevel);
{$ifdef AceBDE}
  property DataSourceManager: TAceDataSourceManager read FDataSourceManager write FDataSourceManager;
  property DataSet: TDataSet read GetDataSet write FDataSet;
{$endif}
  property  Report: TSctReport read FReport write FReport;

published
  property TwoPass: Boolean read FTwoPass write FTwoPass default False;
  property ClipLabels: Boolean read FClipLabels write FClipLabels;
  property PageSetup: TSctPageSetup read FPageSetup write FPageSetup;
  property BorderType: TSctBorderType read FBorderType write FBorderType;

  property Color;
  property Font;
  property ParentColor;
  property ParentFont;

  property OutputType: TSctOutputType read FOutputType write FOutputType default otNormal;
  property OnPreview: TNotifyEvent read FOnPreview write FOnPreview;
  property OnUpdateStatus: TSctOnUpdateStatus read FOnUpdateStatus write FOnUpdateStatus;

  property AceFileName: String read FAceFileName write FAceFileName;
  property Description: String read FDescription write FDescription;

  property CloseDataSet: Boolean read FCloseDataset write FCloseDataset;
  property DataRange: TSctDataRange read FDataRange write FDataRange;

  property OnDataStart: TNotifyEvent read FOnDataStart write FOnDataStart;
  property OnDataSkip: TNotifyEvent read FOnDataSkip write FOnDataSkip;
  property OnDataFinish: TNotifyEvent read FOnDataFinish write FOnDataFinish;
  property OnDataFilter: TSctDataFilterEvent read FOnDataFilter write FOnDataFilter;
  property OmitLastPgFt: Boolean read FOmitLastPgFt write FOmitLastPgFt;

  property Head: TSctBand read FHead write FHead;
  property Detail: TSctBand read FDetail write FDetail;
  property Foot: TSctBand read FFoot write FFoot;
  property PageHead: TSctBand read FPageHead write FPageHead;
  property PageFoot: TSctBand read FPageFoot write FPageFoot;

  property RtfFile: String read FRtfFile write FRtfFile;
{$ifdef AceBDE}
  property DataSource: TDataSource read GetDataSource write SetDataSource;
  property CloseDataSources: Boolean read FCloseDataSources write FCloseDataSources default True;
{$endif}
  property NoDataQuit: Boolean read FNoDataQuit write FNoDataQuit default False;
  property OnNoData: TNotifyEvent read FOnNoData write FOnNoData;
  property NoRecordCount: Boolean read FNoRecordCount write FNoRecordCount default False;

  property OnNewPage: TSctOnNewPage read FOnNewPage write FOnNewPage;
  property OnBeforeNewPage: TSctOnBeforeNewPage read FOnBeforeNewPage write FOnBeforeNewPage;
  property OnAfterDataSkip: TSctPageAfterSkipEvent read FOnAfterDataSkip write FOnAfterDataSkip;

  property GroupPageBreaks: Boolean read FGroupPageBreaks write FGroupPageBreaks default False;
end;

{ TSctGroupPage }
TSctGroupPage = class(TSctPage)
end;

TSctOverrideEvent = procedure (Page: TSctPage);
{$ifdef SCT_OLDEVENT}
TSctOverridePromptEvent = function (Page: TSctPage): Boolean;
{$else}
TSctOverridePromptEvent = procedure (Page: TSctPage; var Result: Boolean);
{$endif}
var
  CustomPreview: TSctOverrideEvent;
  CustomPrompt: TSctOverridePromptEvent;
  CustomStatus: TSctOverrideEvent;


implementation

uses sctdest, sctdata, sctbtn, sctconst, clipbrd, sctstat,
     acealign, {$ifdef AceDesignTime} AceDrop,{$endif} AcePSet;

procedure ClipBoardToStrings(Strings: TStringList);
var
  Data: THandle;
begin
  with ClipBoard do
  begin
    Open;
    Data := GetClipboardData(CF_TEXT);
    if Data > 0 then
    begin
      Strings.SetText(GlobalLock(Data));
      GlobalUnlock(Data);
    end;
    Close;
  end;
end;

{$ifdef VCL130PLUS}
 function isquery( dataset: tobject): boolean;
 var
   currentclass: tclass;
 begin
   result := false;
   currentclass := dataset.classtype;
   while assigned(currentclass) and not result do
   begin
     result := uppercase(currentclass.classname) = 'tquery';
     currentclass := currentclass.classparent;
   end;
 end;
{$endif}

function Record_Count(DataSet: TObject): LongInt;
begin
  Result := 0;
{$ifdef AceBDE}
  if DataSet is TDataSet then
  begin
    if DataSet <> nil then
    begin
     {$ifdef WIN32}{----- This is Delphi 2 and higher -----}
        {$ifdef VCL130PLUS} {starting in Delphi 5, remove dbtables references}
            {Don't get record count if it is Query and Not Active}
           if not (IsQuery(DataSet) and not TDataSet(DataSet).Active) then
               Result := TDataSet(DataSet).RecordCount;
        {$else}
           if TDataSet(DataSet).InheritsFrom(TQuery) then
           begin
              if TDataSet(DataSet).Active then
                 dbiGetRecordCount(TQuery(DataSet).Handle, Result);
           end else Result := TDataSet(DataSet).RecordCount;
        {$endif}
     {$else} {-----This section is Delphi 1 code------}
        {Don't get record count if it is Query and Not Active}
        if not ((DataSet is TQuery) and not TDataSet(DataSet).Active) then
            Result := TDataSet(DataSet).RecordCount;
     {$endif}
    end;
  end;
{$endif}
end;


procedure ListAdd(var List: TList; Item: Pointer);
begin
  if List = nil then List := TList.Create;
  if List.IndexOf(Item) = -1 Then List.Add(Item);
end;

procedure ListRemove(var List: TList; Item: Pointer);
begin
  if List <> nil then
  begin
    List.Remove(Item);
    if List.Count = 0 then
    begin
      List.Free;
      List := nil;
    end;
  end;
end;

{TSctGroup}
constructor TSctGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowHead := true;
  FShowFoot := true;
  FBroken := false;
  FGroupName := '';
  FAllowDelete := False;
  FLevel := 0;
end;

destructor TSctGroup.destroy;
begin
  if Not OkDelete Then raise Exception.Create(LoadStr(SCT_EDeleteGroup));
  if AllowDelete Then DeleteBands;
  inherited Destroy;
end;

function TSctGroup.GetAllowDelete: Boolean;
begin
  Result := True;
{$ifdef AceDesignTime}
  if (csDesigning in ComponentState) Then
    if (Not AllowDelete) Then
      if Not (csDestroying in ComponentState)Then
      begin
        if Parent <> nil Then
        begin
          Result := False;
          {$ifdef WIN32}
          if (csAncestor in ComponentState) then Result := True;
          {$endif}
        end;
      end;
 {$endif}
end;

procedure TSctGroup.SafeDelete;
begin
  try
    AllowDelete := True;
    Free;
  except
    AllowDelete := False;
  end;
end;

procedure TSctGroup.Notification(AComponent: TComponent;
      Operation: TOperation);
begin
  Inherited Notification(AComponent, Operation);
  if (AComponent is TSctvar) Then
  begin
    if (Operation = opRemove) And (TSctvar(AComponent) = Variable) Then
      FVariable := nil;
  end;
  if (AComponent is TSctBand) then
  begin
    if (Operation = opRemove) then
    begin
      if AComponent = FHeader then FHeader := nil;
      if AComponent = FFooter then FFooter := nil;
    end;
  end;
end;

procedure TSctGroup.SetParent(AParent: TWinControl);
begin
  if AParent <> Parent then
  begin
    if AParent <> nil Then
    begin
      if AParent is TSctGrouppage Then
      begin
        TSctGrouppage(AParent).InsertGroup(self);
        inherited SetParent(AParent);
      end else sysutils.Abort;
    end else
    begin
      if Parent <> nil Then TSctGrouppage(Parent).RemoveGroup(self);
      inherited SetParent(AParent);
    end;
  end;
end;

procedure TSctGroup.SetVariable(MyVar: TSctVar);
begin
  if MyVar <> FVariable then
  begin
    FVariable := MyVar;
    if Parent <> nil then
    begin
      TSctGroupPage(Parent).UpdatePageManager;
    end;
  end;
end;

procedure TSctGroup.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(0,0,0,0);
end;

procedure TSctGroup.SetGroupName(name: String);
begin
  FGroupName := name;
end;

function TSctGroup.getpage: TWinControl;
begin
  { temporary }
  result := Parent;
end;

procedure TSctGroup.SetName(const NewName: TComponentName);
begin
  inherited SetName(NewName);
  if Header <> nil Then Header.Bandname := (name + ' Header');
  if Footer <> nil Then Footer.Bandname := (name + ' Footer');

  if Parent <> nil then
  begin
    TSctGroupPage(Parent).UpdatePageManager;
  end;
end;

procedure TSctGroup.SetLevel(pos: Integer);
begin
  { don't reorder the bands here because this should happen
    in the pagemanager }
  Flevel := pos;
  groupname := ('Group: ' + IntToStr(pos));
end;

procedure TSctGroup.AddBands(BandParent: TWinControl);
var
  ht: integer;
begin
  ht := 20;

  Header := TSctBand.Create(Owner);
  Header.Parent := BandParent;
  Header.height := ht;
  SctAutoSetComponentName(Header, name + 'Header', False);
  Header.Caption := '';

  with header do
  begin
    UpdateLevel := TSctLevel.Create(Owner);
    UpdateLevel.Parent := BandParent;
    SctAutoSetComponentName(UpdateLevel, name + 'Level', False);
    UpdateLevel.IsHeader := True;
  end;

  Footer := TSctBand.Create(Owner);
  Footer.Parent := BandParent;
  Footer.height := ht;
  SctAutoSetComponentName(Footer, name + 'Footer', False);
  Footer.Caption := '';

  with footer do
  begin
    UpdateLevel := TSctLevel.Create(Owner);
    UpdateLevel.Parent := BandParent;
    SctAutoSetComponentName(UpdateLevel, name + 'Level', False);
    UpdateLevel.IsHeader := False;
  end;

  name := name;
end;