Procedure

PrintWindowsReport

Module

rReports

Last Modified

7/15/2014 3:26:44 PM

Scope

Interfaced

Declaration

procedure PrintWindowsReport(ARichEdit: TRichEdit; APageBreak, ATitle: string;
  var ErrMsg: string; IncludeHeader: Boolean = false);

Calls Hierarchy


PrintWindowsReport
 └CreatePatientHeader
   ├TEncounter.GetLocationName
   │ └TEncounter.UpdateText
   │   └GetEncounterText
   └FMNow

Called-By Hierarchy


                        PrintWindowsReport
                            PrintStrings┤ 
           TfrmReportBox.cmdPrintClick┤ │ 
        TfrmTemplateView.btnPrintClick┘ │ 
                TfrmPtDemo.cmdPrintClick┤ 
                TfrmNotePrint.cmdOKClick┤ 
                             PrintNote┘ │ 
             TfrmDCSumm.RequestPrint┤   │ 
       TfrmFrame.mnuFilePrintClick┘ │   │ 
     TfrmDCSumm.RequestMultiplePrint┤   │ 
          TfrmPrintList.cmdOKClick┘ │   │ 
   TfrmConsults.mnuActNotePrintClick┤   │ 
TfrmConsults.popNoteMemoPrintClick┘ │   │ 
            TfrmSurgery.RequestPrint┤   │ 
       TfrmFrame.mnuFilePrintClick┘ │   │ 
              TfrmNotes.RequestPrint┤   │ 
       TfrmFrame.mnuFilePrintClick┘ │   │ 
      TfrmNotes.RequestMultiplePrint┘   │ 
          TfrmPrintList.cmdOKClick┘     │ 
         TfrmPrerequisites.cmdPrintClick┤ 
                 TfrmLabPrint.cmdOKClick┤ 
                             PrintLabs┘ │ 
               TfrmLabs.RequestPrint┘   │ 
              TfrmLabs.Print1Click┤     │ 
              TfrmLabs.Print2Click┤     │ 
       TfrmFrame.mnuFilePrintClick┘     │ 
                TfrmReportPrt.cmdOKClick┤ 
                          PrintReports┘ │ 
            TfrmLabs.RequestPrint...┤   │ 
            TfrmReports.RequestPrint┤   │ 
       TfrmFrame.mnuFilePrintClick┤ │   │ 
           TfrmReports.Print1Click┤ │   │ 
           TfrmReports.Print2Click┘ │   │ 
           TfrmProblems.RequestPrint┘   │ 
       TfrmFrame.mnuFilePrintClick┘     │ 
                 Tfrm513Print.cmdOKClick┘ 
                            PrintSF513┘   
           TfrmConsults.RequestPrint┤     
TfrmConsults.mnuActPrintSF513Click┤ │     
       TfrmFrame.mnuFilePrintClick┘ │     
   TfrmConsults.RequestMultiplePrint┘     
          TfrmPrintList.cmdOKClick┘       

Calls

Name Declaration Comments
CreatePatientHeader procedure CreatePatientHeader(var HeaderList: TStringList; PageTitle: string); -

Called-By

Name Declaration Comments
TfrmNotePrint.cmdOKClick procedure cmdOKClick(Sender: TObject); -
TfrmLabPrint.cmdOKClick procedure cmdOKClick(Sender: TObject); -
TfrmReportPrt.cmdOKClick procedure cmdOKClick(Sender: TObject); -
Tfrm513Print.cmdOKClick procedure cmdOKClick(Sender: TObject); -
TfrmPtDemo.cmdPrintClick procedure cmdPrintClick(Sender: TObject); -
TfrmPrerequisites.cmdPrintClick procedure cmdPrintClick(Sender: TObject); -
PrintStrings procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string); -


Source

545   procedure PrintWindowsReport(ARichEdit: TRichEdit; APageBreak, Atitle: string; var ErrMsg: string; IncludeHeader: Boolean = false);
546   var
547     i, j, x, y, LineHeight: integer;
548     aGoHead: string;
549     aHeader: TStringList;
550   const
551     TX_ERR_CAP = 'Print Error';
552     TX_FONT_SIZE = 10;
553     TX_FONT_NAME = 'Courier New';
554   begin
555     aHeader := TStringList.Create;
556     aGoHead := '';
557     if piece(Atitle,';',2) = '1' then
558       begin
559         Atitle := piece(Atitle,';',1);
560         aGoHead := '1';
561       end;
562     CreatePatientHeader(aHeader ,ATitle);
563     with ARichEdit do
564       begin
565   (*      if Lines[Lines.Count - 1] = APageBreak then      //  remove trailing form feed
566           Lines.Delete(Lines.Count - 1);
567         while (Lines[0] = '') or (Lines[0] = APageBreak) do
568           Lines.Delete(0);                               //  remove leading blank lines and form feeds*)
569   
570           {v20.4 - SFC-0602-62899 - RV}
571           while (Lines.Count > 0) and ((Lines[Lines.Count - 1] = '') or (Lines[Lines.Count - 1] = APageBreak)) do
572             Lines.Delete(Lines.Count - 1);                 //  remove trailing blank lines and form feeds
573           while (Lines.Count > 0) and ((Lines[0] = '') or (Lines[0] = APageBreak)) do
574             Lines.Delete(0);                               //  remove leading blank lines and form feeds
575   
576         if Lines.Count > 1 then
577           begin
578   (*          i := Lines.IndexOf(APageBreak);
579             if ((i >= 0 ) and (i < Lines.Count - 1)) then        // removed in v15.9 (RV)
580               begin*)
581                 Printer.Canvas.Font.Size := TX_FONT_SIZE;
582                 Printer.Canvas.Font.Name := TX_FONT_NAME;
583                 Printer.Title := ATitle;
584                 x := Trunc(Printer.Canvas.TextWidth(StringOfChar('=', TX_FONT_SIZE)) * 0.75);
585                 LineHeight := Printer.Canvas.TextHeight(TX_FONT_NAME);
586                 y := LineHeight * 5;            // 5 lines = .83" top margin   v15.9 (RV)
587                 Printer.BeginDoc;
588   
589                 //Do we need to add the header?
590                 IF IncludeHeader then begin
591                  for j := 0 to aHeader.Count - 1 do
592                   begin
593                    Printer.Canvas.TextOut(x, y, aHeader[j]);
594                    y := y + LineHeight;
595                   end;
596                 end;
597   
598                 for i := 0 to Lines.Count - 1 do
599                   begin
600                     if Lines[i] = APageBreak then
601                       begin
602                         Printer.NewPage;
603                         y := LineHeight * 5;   // 5 lines = .83" top margin    v15.9 (RV)
604                         if (IncludeHeader) then
605                           begin
606                             for j := 0 to aHeader.Count - 1 do
607                               begin
608                                 Printer.Canvas.TextOut(x, y, aHeader[j]);
609                                 y := y + LineHeight;
610                               end;
611                           end;
612                       end
613                     else
614                       begin
615                         Printer.Canvas.TextOut(x, y, Lines[i]);
616                         y := y + LineHeight;
617                       end;
618                   end;
619                 Printer.EndDoc;
620   (*            end
621             else                               // removed in v15.9 (RV)  TRichEdit.Print no longer used.
622               try
623                 Font.Size := TX_FONT_SIZE;
624                 Font.Name := TX_FONT_NAME;
625                 Print(ATitle);
626               except
627                 ErrMsg := TX_ERR_CAP;
628               end;*)
629           end
630         else if ARichEdit.Lines.Count = 1 then
631           if Piece(ARichEdit.Lines[0], U, 1) <> '0' then
632             ErrMsg := Piece(ARichEdit.Lines[0], U, 2);
633       end;
634     aHeader.Free;
635   end;