rpsystem.pas

本系统为病历管理系统

{*************************************************************************}
{ Rave Reports version 5.0                                                }
{ Copyright (c), 1995-2002, Nevrona Designs, all rights reserved          }
{*************************************************************************}

unit RpSystem;

interface

uses
  Windows, Messages, Forms, Graphics, Controls, Dialogs,
  StdCtrls, ExtCtrls, Buttons,
  SysUtils, Classes, RpDefine, RpBase, RpFiler, RpDevice, RpRender,
  RpRenderPrinter, RpRenderPreview;

type
  TOverrideMode = (omCreate,omShow,omWait,omFree);
  TRvSystem = class;
  TRvSystemEvent = procedure(    ReportSystem: TRvSystem;
                                 OverrideMode: TOverrideMode;
                             var OverrideForm: TForm) of object;

{ class TSystemPrinter }

  TSystemPrinter = class(TPersistent)
  protected
    FCopies: integer;
    FFirstPage: integer;
    FLastPage: integer;
    FLineHeightMethod: TLineHeightMethod;
    FLinesPerInch: integer;
    FMarginBottom: double;
    FMarginLeft: double;
    FMarginRight: double;
    FMarginTop: double;
    FOrientation: TOrientation;
    FScaleX: double;
    FScaleY: double;
    FStatusFormat: TFormatString;
    FStatusText: TStrings;
    FTabShade: integer;
    FTextBKMode: TBKMode;
    FTitle: TTitleString;
    FUnits: TPrintUnits;
    FUnitsFactor: double;

    procedure SetStatusText(Value: TStrings);
    procedure SetTabShade(Value: integer);
    procedure SetUnits(Value: TPrintUnits);
    procedure SetUnitsFactor(Value: double);
  public
    FCollate: boolean;
    FDuplex: TDuplex;

    constructor Create;
    destructor Destroy; override;
    procedure InitPrinter(BaseReport: TBaseReport);
  published
    property Copies: integer read FCopies write FCopies default 1;
    property FirstPage: integer read FFirstPage write FFirstPage default 1;
    property LastPage: integer read FLastPage write FLastPage default 9999;
    property LineHeightMethod: TLineHeightMethod read FLineHeightMethod write
     FLineHeightMethod default lhmFont;
    property LinesPerInch: integer read FLinesPerInch write FLinesPerInch
     default 6;
    property MarginBottom: double read FMarginBottom write FMarginBottom;
    property MarginLeft: double read FMarginLeft write FMarginLeft;
    property MarginRight: double read FMarginRight write FMarginRight;
    property MarginTop: double read FMarginTop write FMarginTop;
    property Orientation: TOrientation read FOrientation write
     FOrientation default poPortrait;
    property ScaleX: double read FScaleX write FScaleX;
    property ScaleY: double read FScaleY write FScaleY;
    property StatusFormat: TFormatString read FStatusFormat write FStatusFormat;
    property StatusText: TStrings read FStatusText write SetStatusText;
    property TabShade: integer read FTabShade write SetTabShade default 0;
    property TextBKMode: TBKMode read FTextBKMode write FTextBKMode
     default bkTransparent;
    property Title: TTitleString read FTitle write FTitle;
    property Units: TPrintUnits read FUnits write SetUnits default unInch;
    property UnitsFactor: double read FUnitsFactor write SetUnitsFactor;
  end; { TSystemPrinter }

{ class TSystemPreview }

  TSystemPreview = class(TPersistent)
  protected
    FGridHoriz: double;
    FGridPen: TPen;
    FGridVert: double;
    FMarginMethod: TMarginMethod;
    FMarginPercent: double;
    FMonochrome: boolean;
    FPagesWide: integer;
    FPagesHigh: integer;
    FPageInc: integer;
    FRulerType: TRulerType;
    FShadowDepth: integer;
    FZoomFactor: double;
    FZoomInc: integer;
    FFormWidth: integer;
    FFormHeight: integer;
    FFormState: TWindowState;

    procedure SetMonochrome(Value: boolean);
    procedure SetShadowDepth(Value: integer);
    procedure SetZoomFactor(Value: double);
  public
    constructor Create;
    destructor Destroy; override;
    procedure InitPreview(RenderPreview: TRvRenderPreview);
  published
    property FormWidth: integer read FFormWidth write FFormWidth default 615;
    property FormHeight: integer read FFormHeight write FFormHeight default 450;
    property FormState: TWindowState read FFormState write FFormState default wsNormal;
    property GridHoriz: double read FGridHoriz write FGridHoriz;
    property GridPen: TPen read FGridPen write FGridPen;
    property GridVert: double read FGridVert write FGridVert;
    property MarginMethod: TMarginMethod read FMarginMethod write FMarginMethod
     default mmFixed;
    property MarginPercent: double read FMarginPercent write FMarginPercent;
    property Monochrome: boolean read FMonochrome write SetMonochrome default
     false;
    property PagesWide: integer read FPagesWide write FPagesWide default 1;
    property PagesHigh: integer read FPagesHigh write FPagesHigh default 1;
    property PageInc: integer read FPageInc write FPageInc default 1;
    property RulerType: TRulerType read FRulerType write FRulerType default
     rtNone;
    property ShadowDepth: integer read FShadowDepth write SetShadowDepth default 0;
    property ZoomFactor: double read FZoomFactor write SetZoomFactor;
    property ZoomInc: integer read FZoomInc write FZoomInc default 10;
  end; { TSystemPreview }

{ class TSystemFiler }

  TSystemFiler = class(TPersistent)
  protected
    FAccuracyMethod: TAccuracyMethod;
    FFileName: TFileName;
    FStatusFormat: TFormatString;
    FStatusText: TStrings;
    FStreamMode: TStreamMode;
    FStream: TStream;
    FIgnoreRPTF: boolean;

    procedure SetStatusText(Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
    procedure InitFiler(BaseReport: TBaseReport);

    property Stream: TStream read FStream write FStream;
    property IgnoreRPTF: boolean read FIgnoreRPTF write FIgnoreRPTF;
  published
    property AccuracyMethod: TAccuracyMethod read FAccuracyMethod write
     FAccuracyMethod default amPositioning;
    property FileName: TFileName read FFileName write FFileName;
    property StatusFormat: TFormatString read FStatusFormat write FStatusFormat;
    property StatusText: TStrings read FStatusText write SetStatusText;
    property StreamMode: TStreamMode read FStreamMode write FStreamMode
     default smMemory;
  end; { TSystemFiler }

{ class TRvSystem }

  TRvSystem = class(TRPBaseComponent)
  protected
    FDoNativeOutput: boolean;
    FAborted: boolean;
    FBaseReport: TBaseReport;
    SaveLabel: TLabel;
    FDefaultDest: TReportDest;
    FReportDest: TReportDest;
    FOutputFileName: TFileName;
    ForceMultiPrint: boolean;

    FSystemSetups: TSystemSetups;
    FSystemOptions: TSystemOptions;

    FSystemFiler: TSystemFiler;
    FSystemPreview: TSystemPreview;
    FSystemPrinter: TSystemPrinter;
    FTitleSetup: TFormatString;
    FTitleStatus: TFormatString;
    FTitlePreview: TFormatString;
    FStorageMacroData: TStrings;
    FRenderObject: TRPRender;

  { Public Event methods }
    FOnRenderPage: TNotifyEvent;
    FOnRenderData: TNotifyEvent;

  { Published Event methods }
    FOnPrint: TNotifyEvent;
    FOnPrintPage: TPrintPageEvent;
    FOnBeforePrint: TNotifyEvent;
    FOnAfterPrint: TNotifyEvent;
    FOnAfterPreviewPrint: TNotifyEvent;
    FOnNewPage: TNotifyEvent;
    FOnNewColumn: TNotifyEvent;
    FOnPrintHeader: TNotifyEvent;
    FOnPrintFooter: TNotifyEvent;
    FOnEndOfSection: TNotifyEvent;
    FOnDecodeImage: TDecodeImageEvent;
    FOnPreviewSetup: TNotifyEvent;
    FOnPreviewShow: TNotifyEvent;
    FOnOverrideSetup: TRvSystemEvent;
    FOnOverrideStatus: TRvSystemEvent;
    FOnOverridePreview: TRvSystemEvent;

    procedure SetRenderObject(const Value: TRPRender);
    procedure InitEvents(BaseReport: TBaseReport);
    function GetStream: TStream;
    procedure SetStream(Value: TStream);
    procedure OverrideSetupProc(    ReportSystem: TRvSystem;
                                    OverrideMode: TOverrideMode;
                                var OverrideForm: TForm); virtual;
    procedure OverrideStatusProc(    ReportSystem: TRvSystem;
                                     OverrideMode: TOverrideMode;
                                 var OverrideForm: TForm); virtual;
    procedure OverridePreviewProc(    ReportSystem: TRvSystem;
                                      OverrideMode: TOverrideMode;
                                  var OverrideForm: TForm); virtual;
    procedure SetupReport(var SetupForm: TForm);
    procedure GenerateReport(var StatusForm: TForm);
    procedure PrintReport(var StatusForm: TForm);
    procedure PreviewReport(var PreviewForm: TForm);
    procedure SetStorageMacroData(Value: TStrings);
    procedure InitRenderStream(var RenderStream: TStream);
    procedure PrintRender(var StatusForm: TForm);

  public
  { Report Methods - public }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Execute;
    procedure Generate;
    procedure PreviewShowEvent(Sender: TObject);

    property Stream: TStream read GetStream write SetStream;
    property ReportDest: TReportDest read FReportDest write FReportDest;
    property OutputFileName: TFileName read FOutputFileName write FOutputFileName;
    property BaseReport: TBaseReport read FBaseReport write FBaseReport;
    property Aborted: boolean read FAborted write FAborted;
    property StorageMacroData: TStrings read FStorageMacroData write SetStorageMacroData;
    property RenderObject: TRPRender read FRenderObject write SetRenderObject;
    property DoNativeOutput: boolean read FDoNativeOutput write FDoNativeOutput default true;
    property OnRenderPage: TNotifyEvent read FOnRenderPage write FOnRenderPage;
    property OnRenderData: TNotifyEvent read FOnRenderData write FOnRenderData;
  published
    property TitleSetup: TFormatString read FTitleSetup write FTitleSetup;
    property TitleStatus: TFormatString read FTitleStatus write FTitleStatus;
    property TitlePreview: TFormatString read FTitlePreview write FTitlePreview;
    property SystemSetups: TSystemSetups read FSystemSetups write FSystemSetups
     default [ssAllowSetup,ssAllowCopies,ssAllowCollate,ssAllowDuplex,
      ssAllowDestPreview,ssAllowDestPrinter,ssAllowDestFile,ssAllowPrinterSetup,
      ssAllowPreviewSetup];
    property SystemOptions: TSystemOptions read FSystemOptions write FSystemOptions
     default [soShowStatus,soAllowPrintFromPreview,soPreviewModal];
    property DefaultDest: TReportDest read FDefaultDest write FDefaultDest
     default rdPreview;

  { System properties }
    property SystemFiler: TSystemFiler read FSystemFiler write FSystemFiler;
    property SystemPreview: TSystemPreview read FSystemPreview write FSystemPreview;
    property SystemPrinter: TSystemPrinter read FSystemPrinter write FSystemPrinter;

  { Event Properties - redeclare as published }
    property OnPrint: TNotifyEvent read FOnPrint write FOnPrint;
    property OnPrintPage: TPrintPageEvent read FOnPrintPage write FOnPrintPage;
    property OnBeforePrint: TNotifyEvent read FOnBeforePrint write
     FOnBeforePrint;
    property OnAfterPrint: TNotifyEvent read FOnAfterPrint write FOnAfterPrint;
    property OnAfterPreviewPrint: TNotifyEvent read FOnAfterPreviewPrint write FOnAfterPreviewPrint;
    property OnNewPage: TNotifyEvent read FOnNewPage write FOnNewPage;
    property OnNewColumn: TNotifyEvent read FOnNewColumn write FOnNewColumn;
    property OnPrintHeader: TNotifyEvent read FOnPrintHeader write FOnPrintHeader;
    property OnPrintFooter: TNotifyEvent read FOnPrintFooter write FOnPrintFooter;
    property OnEndOfSection: TNotifyEvent read FOnEndOfSection write FOnEndOfSection;
    property OnDecodeImage: TDecodeImageEvent read FOnDecodeImage write FOnDecodeImage;

    property OnPreviewSetup: TNotifyEvent read FOnPreviewSetup write FOnPreviewSetup;
    property OnPreviewShow: TNotifyEvent read FOnPreviewShow write FOnPreviewShow;
    property OverrideSetup: TRvSystemEvent read FOnOverrideSetup write FOnOverrideSetup;
    property OverrideStatus: TRvSystemEvent read FOnOverrideStatus write FOnOverrideStatus;
    property OverridePreview: TRvSystemEvent read FOnOverridePreview write FOnOverridePreview;
  end; { TRvSystem }
  TReportSystem = TRvSystem;

implementation

uses
  RpFormSetup, RpFormPreview, RpFormStatus;

{ class TRvSystem }

constructor TRvSystem.Create(AOwner: TComponent);
begin { Create }
  inherited Create(AOwner);

  if (AOwner <> nil) and (csDesigning in ComponentState) and not (csReading in AOwner.ComponentState) then begin
    FTitleSetup := Trans('Output Options');
    FTitleStatus := Trans('Report Status');
    FTitlePreview := Trans('Report Preview');
  end; { if }
  FSystemSetups := [ssAllowSetup,ssAllowCopies,ssAllowCollate,ssAllowDuplex,
   ssAllowDestPreview,ssAllowDestPrinter,ssAllowDestFile,ssAllowPrinterSetup,
   ssAllowPreviewSetup];
  FSystemOptions := [soShowStatus,soAllowPrintFromPreview,soPreviewModal];
  FDefaultDest := rdPreview;
  BaseReport := nil;
  FSystemFiler := TSystemFiler.Create;
  FSystemPreview := TSystemPreview.Create;
  FSystemPrinter := TSystemPrinter.Create;
  FStorageMacroData := TStringList.Create;
  FOutputFileName := '';
  FRenderObject := nil;
  FDoNativeOutput := true;
end;  { Create }

destructor TRvSystem.Destroy;
begin { Destroy }
  FreeAndNil(FSystemPrinter);
  FreeAndNil(FSystemPreview);
  FreeAndNil(FSystemFiler);
  FreeAndNil(FStorageMacroData);

  inherited Destroy;
end;  { Destroy }

procedure TRvSystem.InitEvents(BaseReport: TBaseReport);
begin { InitEvents }
  with BaseReport do begin
    OnPrint := FOnPrint;
    OnPrintPage := FOnPrintPage;
    OnBeforePrint := FOnBeforePrint;
    OnAfterPrint := FOnAfterPrint;
    OnNewPage := FOnNewPage;
    OnNewColumn := FOnNewColumn;
    OnPrintHeader := FOnPrintHeader;
    OnPrintFooter := FOnPrintFooter;
    OnEndOfSection := FOnEndOfSection;
    OnDecodeImage := FOnDecodeImage;
  end; { with }
  if BaseReport is TRvNDRWriter then begin
    TRvNDRWriter(BaseReport).OnRenderPage := FOnRenderPage;
    TRvNDRWriter(BaseReport).OnRenderData := FOnRenderData;
  end; { if }
end;  { InitEvents }