sctrep.pas

suite component ace report

unit SctRep;

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

{$ifdef WIN32}
  {$R sctres32.res}
{$else}
  {$R sctres16.res}
{$endif}


interface
{$I ace.inc}
{$K-}
{$S-}
uses
{$IFDEF WIN32} windows
{$ELSE} wintypes, winprocs
{$ENDIF}
  ,forms, classes, graphics
  ,extctrls, dialogs, controls, sysutils
  ,stdctrls, messages, sctvar, sctctrl
  ,printers, commdlg, buttons, psetup,
  sctrtf, sctutil, AceOut, aceview, acefile, AcePage,aceutil
{$IFDEF AceDesignTime}, dsgnintf {$ENDIF}  
{$ifdef AceBDE}
   ,db,aceds
   {$ifndef VCL130PLUS}
      , dbtables {$ifdef WIN32}, bde {$endif} 
   {$endif}
{$endif}
  ;

const
  GP_UpdateVarList = (wm_User+0);
  Sct_UpdateForm = (wm_User+1);
  Sct_SetDataLists = (wm_User+2);
  Sct_CreatePage = (wm_User+3);
  Sct_AddBands = (wm_User+4);
  Sct_SelectGroupPage = (wm_User+5);
{  Sct_RunAutoLabel = (wm_User+6);}
{  Sct_ComponentSelection = (wm_User+7);}
  Sct_DataControl = (wm_User+8);
  Sct_DataUpdateVars = (wm_User+9);
  Sct_VarChanged = (wm_User+10);

  Sct_OverviewReport = (wm_User + 11);
  Sct_DiagReport = (wm_User + 12);

{$define SCT_NO_OLDEVENT}

  Sct_ModifyTextLabel = (wm_User+13);
  Sct_CopyReport = (wm_User+14);

type
  TSctUpdateForm = TWMNoParams;
  TSctSetDataLists = TWMNoParams;
  TSctCreatePage = TWMNoParams;
  TSctSelectGroupPage = TWMNoParams;
{  TSctRunAutoLabel = TWMNoParams;}
{  TSctComponentSelection = TWMNoParams;}
  TSctDataControl = TWMNoParams;
  TSctDataUpdateVars = TWMNoParams;
  TSctVarChanged = TWMNoParams;
  TGPUpdateVarList = TWMNoParams;
  TSctAddBands = TWMNoParams;

  TSctOverviewReport = TWMNoParams;
  TSctDiagReport = TWMNoParams;

  TWMSCTLABEL = record
    Msg: Cardinal;
    WParam: Word;
    LB: TSctTextLabel;
    LB2: TSctTextLabel;
    Result: LongInt;
  end;
  TSctModifyLabel = TWMSCTLABEL;
  TSctCopyReport = TWMNoParams;



  TSctReport = class;
  TSctGroup = class;
  TSctBand = class;
  TSctPage = class;
  TSctGrouppage = class;
  TSctSubDataBand = class;
  TSctDataSourceGuide = class;

  TSctBandHead = class;
  TSctOverlayBand = class;
  TSctSubBand = class;
  TSctDataHeadBand = class;

{ TSctPageState }
TSctPageState = set of (psArrangeBands,psUpdateVarList,psInsertBand);
{ TSctOutputType }
TSctOutputType = (otNormal, otRichText);
{ TSctStatus }
TSctStatus = (ssBegin, ssEnd, ssPrinting, ssNoWhere, ssGenerating);
{ TSctOnUpdateStatus }
TSctOnUpdateStatus = procedure (Page: TSctPage; Stat: TSctStatus) of object;
{ TSctDataFilterEvent }
{$ifdef SCT_OLDEVENT}
TSctDataFilterEvent = function (Sender: TObject): Boolean of object;
{$else}
TSctDataFilterEvent = procedure (Sender: TObject; var Result: Boolean) of object;
{$endif}
{ TSctDataRange }
TSctDataRange = (drAllRecords, drSingleRecord);
{ TSctGroupPageState }
TSctGroupPageState = set of (gpsPrintHead,gpsPrintPageHead,gpsPrintDetail
               ,gpsPrintPageFoot, gpsPrintFoot, gpsPrintRepeats
               ,gpsPrintGroupHead, gpsPrintGroupFoot, gpsPrintOverLays);




{ TSctReportPrintEvent }
TSctReportPrintEvent = procedure (Report: TSctReport) of object;

{ TSctBandPrintEvent }
TSctBandPrintEvent = procedure (Band: TSctBand) of object;


{ TSctPrintWhenEvent }
{$ifdef SCT_OLDEVENT}
TSctPrintWhenEvent = function (Band: TSctBand): Boolean of object;
{$else}
TSctPrintWhenEvent = procedure (Band: TSctBand; var Result: Boolean) of object;
{$endif}

{ TSctPromptPrintEvent }
{$ifdef SCT_OLDEVENT}
TSctPromptPrintEvent = function (Page: TSctPage): Boolean of object;
{$else}
TSctPromptPrintEvent = procedure (Page: TSctPage; var Result: Boolean) of object;
{$endif}

{ TSctBandState }
TSctBandState = set of (bsPrinting);



{ TSctOnNewPage }
TSctOnNewPage = procedure (Page: TSctGroupPage; AceOutput: TObject; PageNum: LongInt) of object;
{ TSctPageAfterSkipEvent }
TSctPageAfterSkipEvent = procedure (Page: TSctGroupPage) of object;
{ TSctOnBeforeNewPage }
TSctOnBeforeNewPage = procedure (Page: TSctPage; var DoNewPage: Boolean) of object;

{ TSctReserveSpace }
TSctReserveSpace = class(TPersistent)
private
  FBand: TCustomPanel;
  FBandCount: Integer;
  FSpace: Integer;
protected
  function GetReserve: Integer;
public
  constructor Create; virtual;
  destructor Destroy; override;
  property Reserve: Integer read GetReserve;
published
  property Band: TCustomPanel read FBand write FBand;
  property BandCount: Integer read FBandCount Write FBandCount default 1;
  property Space: Integer read FSpace write FSpace default 0;
end;

{TSctBand}
TSctBand = class(TCustomPanel)
private
  FLabels: TList;
  FVisible: Boolean;
  FStretch: Boolean;
  FBandName: String;
  FAllowDelete: Boolean;
  FPage: TSctPage;
  FUpdateLevel: TSctLevel;
  FEndPrint, FFirstPass: Boolean;
  FPixelsPerInch: Integer;
  FOnPrintWhen: TSctPrintWhenEvent;
  FListPos: Integer;
  FNewPage: Boolean;
  FNewPageRepeat: Boolean;
  FBandState: TSctBandState;
  FContinued: Boolean;
  FBrush: TBrush;
  FPen: TPen;
  FBorderType: TSctBorderType;
  FReserveSpace: TSctReserveSpace;
  FOnBeforePrint, FOnAfterPrint: TSctBandPrintEvent;
  FOrder: Integer;
  FBand: TSctBand;
  FKeepTogether: Boolean;
  FSaveNewPage: Boolean;

  FSaveOutputDest: TAceDestination;
  FShade: TAceShadePercent;
  procedure PushDest;
  procedure PopDest;

  procedure WMSize(var Message: TWMSize); message WM_SIZE;
  procedure WMMove(var Message: TWMMove); message WM_MOVE;
  procedure ModifyLabel( var Message: TSctModifyLabel ); message Sct_ModifyTextLabel;

  procedure BandDragOver(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean);
  procedure BandDragDrop(Sender, Source: TObject; X, Y: Integer);
protected
  procedure SetParent(AParent: TWinControl); override;
  function GetPrintHeight: Integer;
  procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
  procedure Paint; override;
  procedure Loaded; override;
  function getppi: Integer;
  function GetPrintOk: Boolean;
  procedure SetVisible(value: Boolean); virtual;
  procedure SetStretch(value: Boolean); virtual;
  procedure SetNewPage(value: Boolean); virtual;
  procedure SetNewPageRepeat(value: Boolean); virtual;
  function GetMainBand: TSctBand; virtual;
  procedure SetBorderType(bt: TSctBorderType); virtual;

  procedure BeforePrint;
  procedure AfterPrint;
  procedure MouseMovement(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  procedure WndProc(var Message: TMessage); override;

  function DoOnPrintWhen: Boolean;
  procedure SetOrder(n: Integer); virtual;
  procedure SetName(const NewName: TComponentName); override;
  procedure SetBandName(const NewName: String);
  procedure SetShade(ShadePercent: TAceShadePercent); virtual;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure InsertLabel(oLabel: TSctLabel);
  procedure RemoveLabel(oLabel: TSctLabel);
  procedure Print(oPage: TSctPage);
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  procedure SafeDelete;
  function GetAllowDelete: Boolean;
  property AllowDelete: Boolean read FAllowDelete write FAllowDelete;
  property OkDelete: Boolean read GetAllowDelete;
  property Page: TSctPage read FPage write FPage;
  property MainBand: TSctBand read GetMainBand;
  property Labels: TList read FLabels write FLabels;

  property EndPrint: Boolean read FEndPrint write FEndPrint;
  property FirstPass: Boolean read FFirstPass write FFirstPass;
  procedure StartPrint;
  procedure FinishedPrint;
  function PrintHeight( oPage: TSctPage; Space: Integer): Integer; virtual;
  property PrintOk: Boolean read GetPrintOk;
  property BandState: TSctBandState read FBandState write FBandState;
  property Continued: Boolean read FContinued write FContinued;
  function SpendHeight(oPage: TSctPage; Space: Integer): Integer;
  procedure PrintRtf(oPage: TSctPage; rtf: TSctRtfFile);


  property Hint;
  property HelpContext;
  property Cursor;
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnResize;
  property PHeight: Integer read GetPrintHeight;
  property PixelsPerInch: Integer read getppi write FPixelsPerInch;
  property ListPos: Integer read FListPos write FListPos;
  property Brush: TBrush read FBrush write FBrush;
  property Pen: TPen read FPen write FPen;

  property Order: Integer read FOrder write SetOrder default 0;
  procedure SetOrderDirect(n: Integer);
  property Band: TSctBand read FBand write FBand;
published
  property Color;
  property Font;
  property ParentColor;
  property ParentFont;
  property BandName: String read FBandName write SetBandName;
  property OnPrintWhen: TSctPrintWhenEvent read FOnPrintWhen write FOnPrintWhen;
  property Updatelevel: TSctLevel read FUpdateLevel write FUpdateLevel;

  property Visible: Boolean read FVisible write SetVisible default True;
  property Stretch: Boolean read FStretch write SetStretch default False;
  property NewPage: Boolean read FNewPage write SetNewPage default False;
  property NewPageRepeat: Boolean read FNewPageRepeat write SetNewPageRepeat default False;
  property BorderType: TSctBorderType read FBorderType write SetBorderType default btNone;
  property ReserveSpace: TSctReserveSpace read FReserveSpace write FReserveSpace;

  property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False;
  property OnBeforePrint: TSctBandPrintEvent read FOnBeforePrint write FOnBeforePrint;
  property OnAfterPrint: TSctBandPrintEvent read FOnAfterPrint write FOnAfterPrint;
  property Shade: TAceShadePercent read FShade write SetShade default spNone;
end;

{TSctGroup}
TSctGroup = class(TControl)
private
  FVariable: TSctvar;
  FHeader: TSctBand;
  FFooter: TSctBand;
  FShowHead: boolean;
  FShowFoot: boolean;
  FOnCheckBroken: TNotifyEvent;
  FBroken: boolean;
  FLevel: Integer;
  FGroupName: String;
  FAllowDelete: Boolean;
  FPage: TWinControl;
protected
  function CheckBroken: Boolean;
  function getpage: TWinControl;

  procedure SetVariable(MyVar: TSctVar);
  procedure SetParent(AParent: TWinControl); override;
  procedure SetName(const NewName: TComponentName); override;
  procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;

  procedure DefineProperties(Filer: TFiler); override;
  procedure ReadLevel( Reader: TReader);
  procedure WriteLevel( Writer: TWriter);
public
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  property Page: TWinControl read GetPage write FPage;
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property IsBroken: Boolean read CheckBroken;
  procedure PrintHead(oPage: TSctPage);
  procedure PrintFoot(oPage: TSctPage);
  property Broken: Boolean read FBroken write FBroken;
  procedure AddBands(BandParent: TWinControl);
  procedure DeleteBands;
  procedure SetGroupName(Name: String); virtual;
  procedure SetLevel(Pos: Integer); virtual;
  property GroupName: String read FGroupName write SetGroupName;
  procedure SafeDelete;
  function GetAllowDelete: Boolean;
  property AllowDelete: Boolean read FAllowDelete write FAllowDelete;
  property OkDelete: Boolean read GetAllowDelete;
  property Level: Integer read FLevel write SetLevel;
published
  property OnCheckBroken: TNotifyEvent read FOnCheckBroken write FOnCheckBroken;
  property Header: TSctBand read FHeader write FHeader;
  property Footer: TSctBand read FFooter write FFooter;
  property Variable: TSctvar read FVariable write SetVariable;
end;

{ TSctBandHead }
TSctBandHead = class(TPanel)
private
  Fnamelabel: TLabel;
  FArrow: TPaintBox;
  Fvisiblecheck: TCheckBox;
  FNewPageCheck: TcheckBox;
  FNewPageRepeatCheck: TCheckBox;
  FStretchCheck: TCheckBox;
protected
  procedure ChangeScale(M, D: Integer); override;
public
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  property NameLabel: TLabel read Fnamelabel write Fnamelabel;
  property Arrow: TPaintBox read FArrow write FArrow;
  property VisibleCheck: TCheckBox read FVisibleCheck write FVisibleCheck;
  property NewPagecheck: TCheckBox read FNewPageCheck write FNewPageCheck;
  property NewPageRepeatcheck: TCheckBox read FNewPageRepeatCheck write FNewPageRepeatCheck;
  property StretchCheck: TCheckBox read FStretchCheck write FStretchCheck;
end;


{ TSctVersion }
TSctVersion = (vACE1_0);

{ TSctNoScaleBtn }
TSctNoScaleBtn = class(TSpeedButton)
private
protected
  procedure ChangeScale(M, D: Integer); override;
public
end;

{TSctReport}
TSctReport = class(TScrollBox)
private
  FPages: TList;
  FPage: TSctPage;
  FPrompt: Boolean;
  FPixelsPerInch: Integer;
  FAutoRun: Boolean;
  FSTop, FSLeft, FSWidth, FSHeight, FMTop, FMLeft: Integer;
  FSAlign: TAlign;
  FMinimized: Boolean;
  FMinMaxButton, FPageManButton, FAutoLabelButton, FRunButton: TSctNoScaleBtn;
  FSelectButton, FDataButton: TSctNoScaleBtn;
  {$ifdef AceDesignTime}
    FLeftAlignButton, FCenterAlignButton, FRightAlignButton: TSctNoScaleBtn;
    FPageCenterButton: TSctNoScaleBtn;
    FDropForm: TForm;
    FVersionLabel: TLabel;
  {$endif}
  FRep1Button, FRep2Button: TSctNoScaleBtn;
  FVersion: TSctVersion;
  FOnPromptPrint: TSctPromptPrintEvent;
  FCancelPrintJob: Boolean;
  FDesignPreview: Boolean;
  FOnBeforePrint, FOnAfterPrint: TSctReportPrintEvent;
  FSuppressStatus: Boolean;
  FPrinting: Boolean;

  FGroupPage: TSctGroupPage;
  FSavePrompt: Boolean;
  FSaveSetup: TSctPageSetup;
  FPrintTo: TAceOutput;
  FStatusWin: TForm;
  FPassCount: Integer;
  FPass: Integer;
  FTopRuler: TSctRuler;
  FLeftRuler: TSctRulerContainer;
  FAceDestroying: Boolean;

  procedure NoVisibleChange(var Message: TMessage); message CM_VISIBLECHANGED;
  procedure SctCreatePage( var Message: TSctCreatePage ); message SCT_CreatePage;
  procedure NoCopyReport(var Message: TSctCopyReport); message Sct_CopyReport;
  procedure CreatePageManager;