rvproj.pas

医院病历管理简易版,完全用DELPHI实现.

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

unit RvProj;

interface

{$I RpVer.inc}

uses
  Windows, Controls, ComCtrls, Forms, Dialogs, Graphics,
  TypInfo, SysUtils, Classes, RvDefine, RvUtil, RvClass, RvData,
  RpDefine, RpBase, RpSystem, RpDevice, RvSecurity;

type
  TTagKind = (tkProject,tkExport,tkDataView,tkPage,tkReport,tkReportPage,tkDataObject);

  TImportConflictEvent = procedure(CurrentItem: TRaveProjectItem;
                                   var ImportName: string) of object;

  TRaveProjectManager = class;

  TRaveReport = class(TRaveProjectItem)
  protected
    FCategory: string;
    FLastActivePage: string;
    SaveOnPrint: TNotifyEvent;
    SaveBeforePrint: TNotifyEvent;
    SaveAfterPrint: TNotifyEvent;
    LoadedList: TList; { Loaded pages for this report }
    FixUpList: TStrings; { List of loaded modules that may not be ready until
                           after all report items are loaded }
    FFirstPage: TRavePage; { Page to begin execution for }
    FCopies: integer;
    FPageList: TRaveComponentList; { List of pages to print }
    FAlwaysGenerate: boolean;
    FCollate: TRavePrinterCollate;
    FDuplex: TRavePrinterDuplex;
    FPrinter: string;
    FResolution: TRavePrinterResolution;
    FMaxPages: integer; { Max number of pages to print }
    FSecurityControl: TRaveBaseSecurity;
    FExecProject: TRaveProjectManager;

    procedure SetPageList(Value: TRaveComponentList);
    function GetLoadedCount: integer;
    function GetLoaded(Index: integer): TRavePage;
    procedure RSPrint(Sender: TObject);
    procedure RSBeforePrint(Sender: TObject);
    procedure RSAfterPrint(Sender: TObject);
    procedure Changing(OldItem: TRaveComponent;
                       NewItem: TRaveComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveToStreamHelper(StreamHelper: TStreamHelper); override;
    procedure LoadFromStreamHelper(StreamHelper: TStreamHelper); override;
    procedure Open; override;
    procedure Close; override;
    procedure Compile; override;
    function NewPage: TRavePage;
    procedure LoadPage(Page: TRavePage);
    procedure UnloadPage(Page: TRavePage);
    procedure ProcessLoaded;
    procedure Execute(Engine: TRPComponent);
    procedure InternalExecute(Engine: TRPComponent);

    property LoadedPageCount: integer read GetLoadedCount;
    property LoadedPage[Index: integer]: TRavePage read GetLoaded;
    property LastActivePage: string read FLastActivePage write FLastActivePage;
    property ExecProject: TRaveProjectManager read FExecProject;
  published
    property AlwaysGenerate: boolean read FAlwaysGenerate write FAlwaysGenerate default false;
    property Category: string read FCategory write FCategory;
    property Copies: integer read FCopies write FCopies default 0;
    property FirstPage: TRavePage read FFirstPage write FFirstPage default nil;
    property PageList: TRaveComponentList read FPageList write SetPageList;
    property Collate: TRavePrinterCollate read FCollate write FCollate
     default pcDefault;
    property Duplex: TRavePrinterDuplex read FDuplex write FDuplex
     default pdDefault;
    property MaxPages: integer read FMaxPages write FMaxPages default 0;
    property Parameters;
    property PIVars;
    property Printer: string read FPrinter write FPrinter;
    property Resolution: TRavePrinterResolution read FResolution
     write FResolution default prDefault;
    property SecurityControl: TRaveBaseSecurity read FSecurityControl write
     FSecurityControl;
  end; { TRaveReport }

  TRaveModuleManager = class
  protected
    ModuleList: TList;
    FProjectManager: TRaveProjectManager;
    //
    function ModuleIndex(ModuleName: string): integer;
    function LoadModule(ModuleName: string): integer;
  public
    constructor Create(AProjectManager: TRaveProjectManager);
    destructor Destroy; override;
    function GetModule(ModuleName: string): TRaveModule;
    function FindModule(ModuleName: string): TRaveModule;
    procedure LoadModules(StreamHelper: TStreamHelper);
    procedure SaveModules(StreamHelper: TStreamHelper);
    procedure ReleaseModule(AModule: TRaveModule);
    //
    property ProjectManager: TRaveProjectManager read FProjectManager;
  end; { TRaveModuleManager }

  TRaveProjectManager = class(TRaveProjectItem)
  protected
    ForwardRefList: TStringList;
    RenameRefList: TStringList;
    LastActiveReport: string;
    FReportList: TList; { List of all reports }
    FGlobalPageList: TList; { List of all global pages }
    FDataObjectList: TList; { List of all data objects }
    FActiveReport: TRaveReport;
    FSaved: boolean; { Has this project ever been saved }
    FFileName: string; { Filename of this project }
    Signature: string;
    FDataChanged: boolean;
    FPrinting: boolean;
    ExportList: TList;
    Importing: boolean;
    ImportReplace: boolean;
    FOnImportConflict: TImportConflictEvent;
    FVersion: integer;
    FCategories: TStrings;
    Params: TStringList;
    FUnits: TPrintUnits; { Units type }
    FUnitsFactor: TRaveFloat; { Units factor }
    FStreamParamValues: boolean; { Put parameter values in save stream? }
    IsLoading: boolean;
    FMasterProject: TRaveProjectManager;
    FNoDesigner: boolean;
    FSecurityControl: TRaveBaseSecurity;
    FAdminPassword: string;
    FBaseReport: TBaseReport;
    FModuleManager: TRaveModuleManager;

    procedure SetDepth(Control: TRaveComponent;
                       Adjustment: integer); override;
    procedure SetCategories(Value: TStrings);
    procedure SetUnits(Value: TPrintUnits);
    procedure SetUnitsFactor(Value: double);
    procedure SetDataChanged(Value: boolean);
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadParamValues(Reader: TReader);
    procedure WriteParamValues(Writer: TWriter);
    procedure Changing(OldItem: TRaveComponent;
                       NewItem: TRaveComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ReportToStream(AReport: TRaveReport;
                             AStream: TStream);
    function FindReport(const AName: string; const AIsFullName: boolean): TRaveReport;
    procedure AddForwardRef(AName: string; AOwner: TRaveComponent; AInstance: TPersistent;
     APropInfo: PPropInfo; AParam: longint);
    procedure AddRenameRef(OrigName: string; NewInstance: TRaveComponent);
    procedure FreeForwardRefs;
    procedure New;
    procedure RemoveForwardRefs(Target: TRaveComponent);
    procedure Save;
    procedure Load;
    procedure Unload;
    procedure Clear;
    procedure LoadFromStreamHelper(StreamHelper: TStreamHelper); override;
    procedure SaveToStreamHelper(StreamHelper: TStreamHelper); override;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure ExportProject(ExportFileName: string;
                            Items: TList);
    function ImportProject(ImportFileName: string;
                           AutoReplace: boolean): boolean;
    procedure DeactivateReport;
    procedure ActivateReport(Report: TRaveReport);
    function FindRaveComponent(Name: string;
                               DefRoot: TRaveComponent): TRaveComponent;
    function GetUniqueName(BaseName: string;
                           NameOwner: TRaveComponent;
                           UseCurrent: boolean): string;

    function NewReport: TRaveReport;
    function NewGlobalPage: TRavePage;
    function NewDataObject(DataObjectClass: TRaveDataObjectClass): TRaveDataObject;
    procedure DeleteItem(Item: TRaveProjectItem;
                         Notify: boolean);
    procedure SetParam(Param: string;
                       Value: string);
    function GetParam(Param: string): string;
    procedure ClearParams;
    procedure ClearChanged;
    procedure Compile; override;

    property ReportList: TList read FReportList;
    property GlobalPageList: TList read FGlobalPageList;
    property DataObjectList: TList read FDataObjectList;

    property ActiveReport: TRaveReport read FActiveReport;
    property Saved: boolean read FSaved write FSaved;
  { DataChanged will only change value when set to true, to clear call ClearChanged }
    property DataChanged: boolean read FDataChanged write SetDataChanged;
    property Printing: boolean read FPrinting;
    property Version: integer read FVersion;
    property OnImportConflict: TImportConflictEvent read FOnImportConflict write
     FOnImportConflict;
    property StreamParamValues: boolean read FStreamParamValues write FStreamParamValues;
    property FileName: string read FFileName write FFileName stored false;
    property MasterProject: TRaveProjectManager read FMasterProject write FMasterProject;
    property NoDesigner: boolean read FNoDesigner write FNoDesigner;
    property BaseReport: TBaseReport read FBaseReport write FBaseReport;
    property ModuleManager: TRaveModuleManager read FModuleManager;
  published
    property AdminPassword: string read FAdminPassword write FAdminPassword;
    property Categories: TStrings read FCategories write SetCategories;
    property Parameters;
    property PIVars;
    property SecurityControl: TRaveBaseSecurity read FSecurityControl write
     FSecurityControl;
    property Units: TPrintUnits read FUnits write SetUnits stored false;
    property UnitsFactor: TRaveFloat read FUnitsFactor write SetUnitsFactor;
  end; { TRaveProjectManager }

// Procs
  procedure RaveRegister;

var
  ProjectManager: TRaveProjectManager = nil;

implementation

uses
  {$IFNDEF RaveServer}RvDirectDataView,{$ENDIF} RvDataField, RpMBCS;

{ Forward References Handling }

type
  TRaveForwardRef = class
  protected
    FParam: longint;
    FInstance: TPersistent;
    FPropInfo: PPropInfo;
  public
    constructor Create(AInstance: TPersistent;
                       APropInfo: PPropInfo;
                       AParam: longint);
    property Param: longint read FParam;
    property Instance: TPersistent read FInstance;
    property PropInfo: PPropInfo read FPropInfo;
  end; { TRaveForwardRef }

constructor TRaveForwardRef.Create(AInstance: TPersistent; APropInfo: PPropInfo; AParam: longint);
begin { Create }
  FInstance := AInstance;
  FPropInfo := APropInfo;
  FParam := AParam;
end;  { Create }

procedure TRaveProjectManager.AddForwardRef(AName: string; AOwner: TRaveComponent; AInstance: TPersistent;
 APropInfo: PPropInfo; AParam: longint);
begin { AddForwardRef }
  if not Assigned(ForwardRefList) then begin
    ForwardRefList := TStringList.Create;
    ForwardRefList.Sorted := true;
    ForwardRefList.Duplicates := dupAccept;
  end; { if }
  if Pos('.',AName) = 0 then begin
    AName := AOwner.Name + '.' + AName;
  end; { if }
  ForwardRefList.AddObject(AName,TRaveForwardRef.Create(AInstance,APropInfo,AParam));
end;  { AddForwardRef }

procedure TRaveProjectManager.AddRenameRef(OrigName: string; NewInstance: TRaveComponent);
begin { AddRenameRef }
  if not Assigned(RenameRefList) then begin
    RenameRefList := TStringList.Create;
    RenameRefList.Sorted := true;
    RenameRefList.Duplicates := dupIgnore;
  end; { if }
  RenameRefList.AddObject(NewInstance.Owner.Name + '.' + OrigName,NewInstance);
end;  { AddRenameRef }

procedure TRaveProjectManager.RemoveForwardRefs(Target: TRaveComponent);
var
  TargetName: string;
  Index: integer;
begin { RemoveForwardRefs }
  TargetName := Target.Owner.Name + '.' + Target.Name;
  if Assigned(ForwardRefList) and ForwardRefList.Find(TargetName,Index) then begin
    repeat
      with TRaveForwardRef(ForwardRefList.Objects[Index]) do begin
        if not Assigned(PropInfo) then begin
          TRaveComponentList(Instance).Items[Param] := Target;
        end else begin
          SetOrdProp(Instance,PropInfo,integer(Target));
        end; { else }
      end; { with }
      ForwardRefList.Objects[Index].Free;
      ForwardRefList.Delete(Index);
    until (Index >= ForwardRefList.Count) or
     (AnsiCompareText(ForwardRefList[Index],TargetName) <> 0);
  end; { if }
end;  { RemoveForwardRefs }

procedure RaveRegister;
begin { RaveRegister }
  RegisterRaveComponents('',[TRaveReport,TRaveProjectManager]);
  RegisterRaveModuleClasses('RvProj',[TRaveReport,TRaveProjectManager]);
end;  { RaveRegister }

type
  TRaveComponentAccess = class(TRaveComponent)
  end; { TRaveComponentAccess }

{ class TRaveReport }

constructor TRaveReport.Create(AOwner: TComponent);
begin { Create }
  inherited Create(AOwner);
  LoadedList := TList.Create;
  FCopies := 0;
  FResolution := prDefault;
  FCollate := pcDefault;
  FDuplex := pdDefault;
end;  { Create }

destructor TRaveReport.Destroy;
begin { Destroy }
  FreeAndNil(LoadedList);
  FreeAndNil(FPageList);
  inherited Destroy;
end;  { Destroy }

procedure TRaveReport.Changing(OldItem: TRaveComponent;
                               NewItem: TRaveComponent);
var
  I1: integer;
begin { Changing }
  inherited Changing(OldItem,NewItem);
  if Assigned(FirstPage) and (FirstPage = OldItem) then begin
    FirstPage := NewItem as TRavePage;
  end; { if }
  if Assigned(SecurityControl) and (OldItem = SecurityControl) then begin
    SecurityControl := NewItem as TRaveBaseSecurity;
  end; { if }
  if Assigned(PageList) then begin
    I1 := 0;
    while I1 < PageList.Count do begin
      if Assigned(PageList[I1]) and (PageList[I1] = OldItem) then begin
        if Assigned(NewItem) then begin
          PageList[I1] := NewItem; { Replace with NewItem }
        end else begin
          PageList.Delete(I1); { Remove OldItem from PageList }
          Dec(I1);
        end; { else }
      end; { if }
      Inc(I1);
    end; { while }
  end; { if }
end;  { Changing }

procedure TRaveReport.SaveToStreamHelper(StreamHelper: TStreamHelper);
var
  I1: integer;
begin { SaveToStreamHelper }
  with StreamHelper do begin
    WriteString(LastActivePage);

  { Write out list of owned editors }
    WriteIndex(ChildCount);
    for I1 := 0 to (ChildCount - 1) do begin
      WriteByte(0); { Marker for TRaveProjectItem type }
      WriteString(Child[I1].Name);
    end; { for }

  { Write out list of loaded editors }
    WriteIndex(LoadedList.Count);
    for I1 := 0 to (LoadedList.Count - 1) do begin
      WriteString(TRavePage(LoadedList[I1]).Name);
    end; { for }

  { Write out report properties }
    with TRaveWriter.Create(StreamHelper) do try
      WriteComponent(self,false);
    finally
      Free;
    end; { with }

  { Write out pages }
    for I1 := 0 to (ChildCount - 1) do begin
      StreamHelper.StartWriteBlock;
      TRavePage(Child[I1]).SaveToStreamHelper(StreamHelper);
      StreamHelper.FinishWriteBlock;
    end; { for }
  end; { with }