rpsystem.pas

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

procedure TRvSystem.PreviewShowEvent(Sender: TObject);
begin { PreviewShowEvent }
  if Assigned(FOnPreviewShow) then begin
    FOnPreviewShow(Sender);
  end; { if }
end;  { PreviewShowEvent }

procedure TRvSystem.SetStream(Value: TStream);
begin { SetStream }
  SystemFiler.FStream := Value;
end;  { SetStream }

procedure TRvSystem.SetStorageMacroData(Value: TStrings);
begin { SetStorageMacroData }
  FStorageMacroData.Assign(Value);
end;  { SetStorageMacroData }

function TRvSystem.GetStream: TStream;
begin { GetStream }
  Result := SystemFiler.FStream;
end;  { GetStream }

procedure TRvSystem.OverrideSetupProc(    ReportSystem: TRvSystem;
                                          OverrideMode: TOverrideMode;
                                      var OverrideForm: TForm);
begin { OverrideSetupProc }
  case OverrideMode of
    omCreate: begin
      OverrideForm := TRPSetupForm.Create(self);
      OverrideForm.Caption := FTitleSetup;
      (OverrideForm as TRPSetupForm).ReportSystem := ReportSystem;
    end;
    omShow: begin
      with OverrideForm as TRPSetupForm,ReportSystem do begin
        PreviewSetup := false;
        Aborted := ShowModal = mrCancel;
      end; { with }
    end;
    omWait: begin
    { No need to wait since we always ShowModal }
    end;
    omFree: begin
      FreeAndNil(OverrideForm);
    end;
  end; { case }
end;  { OverrideSetupProc }

procedure TRvSystem.OverrideStatusProc(    ReportSystem: TRvSystem;
                                           OverrideMode: TOverrideMode;
                                       var OverrideForm: TForm);
begin { OverrideStatusProc }
  if not (soShowStatus in ReportSystem.SystemOptions) then Exit;

  case OverrideMode of
    omCreate: begin
      OverrideForm := TRPStatusForm.Create(self);
      OverrideForm.Caption := FTitleStatus;
      (OverrideForm as TRPStatusForm).ReportSystem := ReportSystem;
    end;
    omShow: begin
      with OverrideForm as TRPStatusForm,ReportSystem do begin
        BaseReport.StatusLabel := StatusLabel;
        //CancelButton.Caption := Trans('Cancel');
        Show;
      end; { with }
    end;
    omWait: begin
      with OverrideForm as TRPStatusForm,ReportSystem do begin
        if soWaitForOK in SystemOptions then begin
          CancelButton.Caption := Trans('Ok');
          CancelButton.ModalResult := mrOk;
          FormClosed := false;
          repeat
            Application.ProcessMessages;
          until FormClosed;
        end; { if }
      end; { with }
    end;
    omFree: begin
      FreeAndNil(OverrideForm);
    end;
  end; { case }
end;  { OverrideStatusProc }

procedure TRvSystem.OverridePreviewProc(    ReportSystem: TRvSystem;
                                            OverrideMode: TOverrideMode;
                                        var OverrideForm: TForm);
begin { OverridePreviewProc }
  case OverrideMode of
    omCreate: begin
      OverrideForm := TRavePreviewForm.Create(self);
      OverrideForm.Caption := ReportSystem.TitlePreview;
      OverrideForm.Width := ReportSystem.SystemPreview.FormWidth;
      OverrideForm.Height := ReportSystem.SystemPreview.FormHeight;
      OverrideForm.WindowState := ReportSystem.SystemPreview.FormState;
      (OverrideForm as TRavePreviewForm).ReportSystem := ReportSystem;
      (OverrideForm as TRavePreviewForm).OnAfterPreviewPrint := FOnAfterPreviewPrint;
    end;
    omShow: begin
      (OverrideForm as TRavePreviewForm).RvRenderPrinter.MacroData.Assign(StorageMacroData);
      (OverrideForm as TRavePreviewForm).RvRenderPreview.MacroData.Assign(StorageMacroData);
      (OverrideForm as TRavePreviewForm).RvRenderPrinter.OnDecodeImage := FOnDecodeImage;
      (OverrideForm as TRavePreviewForm).RvRenderPreview.OnDecodeImage := FOnDecodeImage;

      SystemPreview.InitPreview((OverrideForm as TRavePreviewForm).RvRenderPreview);
      if Assigned(FOnPreviewSetup) then begin
        FOnPreviewSetup((OverrideForm as TRavePreviewForm).RvRenderPreview);
      end; { if }

      (OverrideForm as TRavePreviewForm).InputFileName := SystemFiler.Filename;
      (OverrideForm as TRavePreviewForm).InputStream := SystemFiler.Stream;
      (OverrideForm as TRavePreviewForm).InitFromRPSystem;
    (* *)
      if soPreviewModal in ReportSystem.SystemOptions then begin
        OverrideForm.ShowModal;
      end else begin
        OverrideForm.Show;
      end; { else }
    end;
    omWait: begin
      if not (soPreviewModal in ReportSystem.SystemOptions) then begin
      // Wait for close
        repeat
          Sleep(250);
          Application.ProcessMessages;
        until not OverrideForm.Visible;
      end; { if }
    end;
    omFree: begin
      if (SystemFiler.StreamMode in [smTempFile,smFile]) then begin
        (OverrideForm as TRavePreviewForm).RvRenderPreview.NDRStream.Free;
        (OverrideForm as TRavePreviewForm).RvRenderPreview.NDRStream := nil;
      end; { if }
      FreeAndNil(OverrideForm);
    end;
  end; { case }
end;  { OverridePreviewProc }

procedure TRvSystem.SetupReport(var SetupForm: TForm);
begin { SetupReport }
  ReportDest := DefaultDest;
  Aborted := false;
  if ssAllowSetup in SystemSetups then begin
    if not Assigned(FOnOverrideSetup) then begin
      FOnOverrideSetup := OverrideSetupProc;
    end; { if }
    FOnOverrideSetup(self,omCreate,SetupForm);
    try
      FOnOverrideSetup(self,omShow,SetupForm);
      FOnOverrideSetup(self,omWait,SetupForm);
    finally
      FOnOverrideSetup(self,omFree,SetupForm);
    end; { tryf }
  end; { if }
end;  { SetupReport }

procedure TRvSystem.GenerateReport(var StatusForm: TForm);
begin { GenerateReport }
  if soNoGenerate in SystemOptions then Exit;

  Aborted := true;
  if not Assigned(FOnOverrideStatus) then begin
    FOnOverrideStatus := OverrideStatusProc;
  end; { if }
  FOnOverrideStatus(self,omCreate,StatusForm);
  BaseReport := nil;
  try
  { Create and init ReportFiler }
    BaseReport := TRvNDRWriter.Create(Owner);
    SystemPrinter.InitPrinter(BaseReport);
    SystemFiler.InitFiler(BaseReport);
    if (ReportDest = rdFile) and not Assigned(RenderObject) then begin
      if DoNativeOutput then begin
      // Output printer native
        BaseReport.OutputName := OutputFileName;
      end else begin
      // Output NDR
        TRvNDRWriter(BaseReport).StreamMode := smFile;
        TRvNDRWriter(BaseReport).FileName := OutputFileName;
      end; { else }
    end; { if }
    InitEvents(BaseReport);
    FOnOverrideStatus(self,omShow,StatusForm);
    BaseReport.Execute;
    StorageMacroData := BaseReport.MacroData;
    Aborted := BaseReport.Aborted;
  finally
    if BaseReport <> nil then begin
      SaveLabel := BaseReport.StatusLabel;
      SystemFiler.FileName := (BaseReport as TRvNDRWriter).FileName;
      BaseReport.Free;
      BaseReport := nil;
    end; { if }
    FOnOverrideStatus(self,omFree,StatusForm);
  end; { try }
end;  { GenerateReport }

procedure TRvSystem.PrintReport(var StatusForm: TForm);
var
  RvRenderPrinter: TRvRenderPrinter;
begin { PrintReport }
  RvRenderPrinter := TRvRenderPrinter.Create(self);
  try
    RvRenderPrinter.OnDecodeImage := FOnDecodeImage;
    RvRenderPrinter.MacroData.Assign(StorageMacroData);
    if SystemFiler.FileName <> '' then begin
      RvRenderPrinter.Render(SystemFiler.FileName);
    end else begin
      RvRenderPrinter.Render(SystemFiler.Stream);
    end;
  finally
    FreeAndNil(RvRenderPrinter);
  end;
end;  { PrintReport }

procedure TRvSystem.Generate;
begin { Generate }
  if soNoGenerate in SystemOptions then Exit;

  Aborted := true;
  BaseReport := nil;
  try
  { Create and init NDRWriter }
    BaseReport := TRvNDRWriter.Create(Owner);
    SystemPrinter.InitPrinter(BaseReport);
    SystemFiler.InitFiler(BaseReport);

    if (ReportDest = rdFile) and not Assigned(RenderObject) then begin
      if DoNativeOutput then begin
      // Output printer native
        BaseReport.OutputName := OutputFileName;
      end else begin
      // Output NDR
        TRvNDRWriter(BaseReport).StreamMode := smFile;
        TRvNDRWriter(BaseReport).FileName := OutputFileName;
      end; { else }
    end; { if }
    InitEvents(BaseReport);

  //!!! Install hooks to call back to render object

    BaseReport.Execute;

    StorageMacroData := BaseReport.MacroData;
    Aborted := BaseReport.Aborted;
  finally
    if BaseReport <> nil then begin
      SaveLabel := BaseReport.StatusLabel;
      SystemFiler.FileName := (BaseReport as TRvNDRWriter).FileName;
      FreeAndNil(FBaseReport);
    end; { if }
  end; { try }
end;  { Generate }

procedure TRvSystem.PreviewReport(var PreviewForm: TForm);
begin { PreviewReport }
  if not Assigned(FOnOverridePreview) then begin
    FOnOverridePreview := OverridePreviewProc;
  end; { if }
  FOnOverridePreview(self,omCreate,PreviewForm);
  try
    FOnOverridePreview(self,omShow,PreviewForm);
    FOnOverridePreview(self,omWait,PreviewForm);
  finally
    FOnOverridePreview(self,omFree,PreviewForm);
  end; { tryf }
end;  { PreviewReport }

procedure TRvSystem.Execute;
var
  ReportStream: TMemoryStream;
  SetupForm: TForm;
  StatusForm: TForm;
  PreviewForm: TForm;
  TempFile: file;

  function CreateNDR: boolean; //!!! temporary
  begin
//    Result := (ReportDest = rdPreview) or (soUseFiler in SystemOptions) or
    Result := (soUseFiler in SystemOptions) or
     ForceMultiPrint or ((ReportDest = rdFile) and not DoNativeOutput
     and not (soNoGenerate in SystemOptions));
  end;

begin { Execute }
  SetupForm := nil;
  StatusForm := nil;
  PreviewForm := nil;

  SetupReport(SetupForm);
  if not Aborted then begin
    ForceMultiPrint := (GlobalDevice.MaxCopies <= 1) and (SystemPrinter.Copies > 1);
(*
    If SystemFiler.StreamMode = smMemory then begin
      ReportStream := TMemoryStream.Create;
      Stream := ReportStream;
    end else begin
      ReportStream := nil;
    end; { else }

    try
      if ReportDest = rdPreview then begin
        PreviewReport(PreviewForm);
      end else begin
      end; { else }
*)
(*
      GenerateReport(StatusForm);

      if not Aborted then begin
        if ReportDest in [rdPrinter,rdFile] then begin
          if (ReportDest = rdPrinter) or DoNativeOutput then begin // Printer or Native output
            PrintReport(StatusForm);
          end else if Assigned(RenderObject) then begin // Rendered output
            PrintRender(StatusForm);
          end else begin // NDR output only
            if Assigned(FOnOverrideStatus) then begin
              FOnOverrideStatus(self,omFree,StatusForm);
            end; { if }
          end; { else }
        end else if ReportDest = rdPreview then begin
          PreviewReport(PreviewForm);
        end; { else }
      end; { if }
*)
(*
    finally
      if ReportStream <> nil then begin
        ReportStream.Free;
      end; { if }
      if ((ReportDest = rdPreview) or (soUseFiler in SystemOptions) or
       ForceMultiPrint) and
       (SystemFiler.StreamMode = smTempFile) then begin { Erase temp file }
        AssignFile(TempFile,SystemFiler.FileName);
        try
          Erase(TempFile);
        except
        end; { tryx }
      end; { if }
    end; { tryf }
*)

    if CreateNDR and (SystemFiler.StreamMode = smMemory) then begin
      ReportStream := TMemoryStream.Create;
      Stream := ReportStream;
    end else begin
      ReportStream := nil;
    end; { else }
    try
      GenerateReport(StatusForm);