Module

fRptBox

Path

C:\CPRS\CPRS30\fRptBox.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -
fFrame -
uReports -

Units Used in Implementation

Name Comments
rCore -
rMisc -
rReports -
uCore -

Classes

Name Comments
TfrmReportBox -

Procedures

Name Owner Declaration Scope Comments
cmdCloseClick TfrmReportBox procedure cmdCloseClick(Sender: TObject); Public/Published -
cmdPrintClick TfrmReportBox procedure cmdPrintClick(Sender: TObject); Public/Published -
FormClose TfrmReportBox procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormResize TfrmReportBox procedure FormResize(Sender: TObject); Public/Published -
memReportClick TfrmReportBox procedure memReportClick(Sender: TObject); Public/Published -
PrintStrings - procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string); Interfaced
RemoteSiteID: string;    //for Remote site printing
  RemoteQuery: string;    //for Remote site printing
ReportBox - procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean); Interfaced -

Functions

Name Owner Declaration Scope Comments
CreateReportBox - function CreateReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox; Global -
ModelessReportBox - function ModelessReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox; Interfaced -


Module Source

1     unit fRptBox;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORFn, ComCtrls, ExtCtrls, fFrame, fBase508Form,
8       VA508AccessibilityManager, uReports;
9     
10    type
11      TfrmReportBox = class(TfrmBase508Form)
12        lblFontTest: TLabel;
13        memReport: TRichEdit;
14        pnlButton: TPanel;
15        cmdPrint: TButton;
16        dlgPrintReport: TPrintDialog;
17        cmdClose: TButton;
18        procedure memReportClick(Sender: TObject);
19        procedure cmdPrintClick(Sender: TObject);
20        procedure cmdCloseClick(Sender: TObject);
21        procedure FormClose(Sender: TObject; var Action: TCloseAction);
22        procedure FormResize(Sender: TObject);
23      end;
24    
25    procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean);
26    function ModelessReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
27    procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string);
28    
29    implementation
30    
31    uses
32      uCore, rCore, rReports, Printers, rMisc;
33    
34    {$R *.DFM}
35    
36    function CreateReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
37    var
38      i, AWidth, MinWidth, MaxWidth, AHeight: Integer;
39      Rect: TRect;
40      BtnArray: array of TButton;
41      BtnRight: array of integer;
42      BtnLeft:  array of integer;
43      //cmdCloseRightMargin: integer;
44      //cmdPrintRightMargin: integer;
45      j, k: integer;
46    begin
47      Result := TfrmReportBox.Create(Application);
48      try
49        with Result do
50        begin
51          k := 0;
52          MinWidth := 0;
53          with pnlButton do for j := 0 to ControlCount - 1 do
54            if Controls[j] is TButton then
55              begin
56                SetLength(BtnArray, k+1);
57                SetLength(BtnRight, k+1);
58                BtnArray[j] := TButton(Controls[j]);
59                BtnRight[j] := ResizeWidth(Font, MainFont, BtnArray[j].Width - BtnArray[j].Width - BtnArray[j].Left);
60                k := k + 1;
61              end;
62          //cmdCloseRightMargin := ResizeWidth(Font, MainFont, pnlButton.Width - cmdClose.Width - cmdClose.Left);
63          //cmdPrintRightMargin := ResizeWidth(Font, MainFont, pnlButton.Width - cmdPrint.Width - cmdPrint.Left);
64          MaxWidth := 350;
65          for i := 0 to ReportText.Count - 1 do
66          begin
67            AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]);
68            if AWidth > MaxWidth then MaxWidth := AWidth;
69          end;
70          cmdPrint.Visible := AllowPrint;
71          MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL);
72          AHeight := (ReportText.Count * (lblFontTest.Height + 2)) + pnlbutton.Height;
73          AHeight := HigherOf(AHeight, 250);
74          if AHeight > (Screen.Height - 80) then AHeight := Screen.Height - 80;
75          if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
76          ClientWidth := MaxWidth;
77          ClientHeight := AHeight;
78          ResizeAnchoredFormToFont(Result);
79          memReport.Align := alClient; //CQ6661
80          //CQ6889 - force Print & Close buttons to bottom right of form regardless of selected font size
81          cmdClose.Left := (pnlButton.Left+pnlButton.Width)-cmdClose.Width;
82          cmdPrint.Left := (cmdClose.Left-cmdPrint.Width)-1;
83          //end CQ6889
84          SetLength(BtnLeft, k);
85          for j := 0 to k - 1 do
86          begin
87            BtnLeft[j] := pnlButton.Width - BtnArray[j].Width - BtnRight[j];
88            MinWidth := MinWidth + BtnArray[j].Width;
89          end;
90          Width := width + (GetSystemMetrics(SM_CXVSCROLL) *2);
91          Constraints.MinWidth := MinWidth + (MinWidth div 2) + (GetSystemMetrics(SM_CXVSCROLL) *2);
92          if (mainFontSize = 8) then Constraints.MinHeight := 285
93          else if (mainFontSize = 10) then Constraints.MinHeight := 325
94          else if (mainFontSize = 12) then Constraints.MinHeight := 390
95          else if mainFontSize = 14 then Constraints.MinHeight := 460
96          else Constraints.MinHeight := 575;
97          QuickCopy(ReportText, memReport);
98          for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' ';
99          Caption := ReportTitle;
100         memReport.SelStart := 0;
101         Rect := BoundsRect;
102         ForceInsideWorkArea(Rect);
103         BoundsRect := Rect;
104       end;
105     except
106       KillObj(@Result);
107       raise;
108     end;
109   end;
110   
111   procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean);
112   var
113     frmReportBox: TfrmReportBox;
114     
115   begin
116     Screen.Cursor := crHourglass;  //wat cq 18425 added hourglass and disabled mnuFileOpen
117     fFrame.frmFrame.mnuFileOpen.Enabled := False;
118     frmReportBox := CreateReportBox(ReportText, ReportTitle, AllowPrint);
119     try
120       frmReportBox.ShowModal;
121     finally
122       frmReportBox.Release;
123       Screen.Cursor := crDefault;
124       fFrame.frmFrame.mnuFileOpen.Enabled := True;
125     end;
126   end;
127   
128   function ModelessReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
129   begin
130     Result := CreateReportBox(ReportText, ReportTitle, AllowPrint);
131     Result.FormStyle := fsStayOnTop;
132     Result.Show;
133   end;
134   
135   procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string);
136   var
137     AHeader: TStringList;
138     memPrintReport: TRichEdit;
139     MaxLines, LastLine, ThisPage, i: integer;
140     ErrMsg: string;
141   //  RemoteSiteID: string;    //for Remote site printing
142   //  RemoteQuery: string;    //for Remote site printing
143     dlgPrintReport: TPrintDialog;
144       BM: TBitmap;
145   const
146     PAGE_BREAK = '**PAGE BREAK**';
147   
148   begin
149   //  RemoteSiteID := '';
150   //  RemoteQuery := '';
151    BM := TBitmap.Create;
152     try
153     dlgPrintReport := TPrintDialog.Create(Form);
154     try
155       frmFrame.CCOWBusy := True;
156       if dlgPrintReport.Execute then
157       begin
158         AHeader := TStringList.Create;
159         CreatePatientHeader(AHeader, Title);
160         memPrintReport := CreateReportTextComponent(Form);
161         try
162           MaxLines := 60 - AHeader.Count;
163           LastLine := 0;
164           ThisPage := 0;
165           BM.Canvas.Font := memPrintReport.Font;
166           with memPrintReport do
167             begin
168               repeat
169                 with Lines do
170                   begin
171                    for i := 0 to MaxLines do begin
172                      if BM.Canvas.TextWidth(StringText[LastLine + i]) > Width then begin
173                        MaxLines := Maxlines - (BM.Canvas.TextWidth(StringText[LastLine + i]) div Width);
174                      end;
175                      if i >= MaxLines then begin
176                        break;
177                      end;
178   
179                       if i < StringText.Count then
180                        // Add(IntToStr(i) + ') ' + StringText[LastLine + i])
181                        Add(StringText[LastLine + i])
182                       else
183                         Break;
184                     end;
185   
186                     LastLine := LastLine + i;
187                     Add(' ');
188                     Add(' ');
189                     Add(StringOfChar('-', 74));
190                     if LastLine >= StringText.Count - 1 then
191                       Add(Trailer)
192                     else
193                       begin
194                         ThisPage := ThisPage + 1;
195                         Add('Page ' + IntToStr(ThisPage));
196                         Add(PAGE_BREAK);
197                         MaxLines := 60 - AHeader.Count;
198                       end;
199                   end;
200                 until LastLine >= StringText.Count - 1;
201               PrintWindowsReport(memPrintReport, PAGE_BREAK, Title, ErrMsg, True);
202             end;
203         finally
204           memPrintReport.Free;
205           AHeader.Free;
206         end;
207       end;
208     finally
209       frmFrame.CCOWBusy := False;
210       dlgPrintReport.Free;
211     end;
212     finally
213       BM.free;
214     end;
215   end;
216   
217   procedure TfrmReportBox.memReportClick(Sender: TObject);
218   begin
219     //Close;
220   end;
221   
222   procedure TfrmReportBox.cmdPrintClick(Sender: TObject);
223   begin
224     PrintStrings(Self, memReport.Lines, Self.Caption, 'End of report');
225     memReport.Invalidate;
226   end;
227   
228   procedure TfrmReportBox.cmdCloseClick(Sender: TObject);
229   begin
230     Close;
231   end;
232   
233   procedure TfrmReportBox.FormClose(Sender: TObject; var Action: TCloseAction);
234   begin
235     if(not (fsModal in FormState)) then
236       Action := caFree;
237   end;
238   
239   
240   procedure TfrmReportBox.FormResize(Sender: TObject);
241   begin
242     inherited;
243     self.memReport.Refresh;
244   end;
245   
246   end.

Module Calls (2 levels)


fRptBox
 ├fFrame
 │ ├fPage
 │ ├uConst
 │ ├VERGENCECONTEXTORLib_TLB
 │ ├fBase508Form
 │ ├XuDsigS
 │ ├rCore
 │ ├fPtSelMsg
 │ ├fPtSel
 │ ├fCover
 │ ├fProbs
 │ ├fMeds
 │ ├fOrders
 │ ├rOrders
 │ ├fNotes
 │ ├fConsults
 │ ├fDCSumm
 │ ├rMisc
 │ ├fLabs
 │ ├fReports
 │ ├rReports
 │ ├fPtDemo
 │ ├fEncnt
 │ ├fPtCWAD
 │ ├uCore
 │ ├fAbout
 │ ├fReview
 │ ├fxBroker
 │ ├fxLists
 │ ├fxServer
 │ ├fRptBox...
 │ ├rODAllergy
 │ ├uInit
 │ ├fLabInfo
 │ ├uReminders
 │ ├fReminderTree
 │ ├fDeviceSelect
 │ ├fDrawers
 │ ├fReminderDialog
 │ ├fOptions
 │ ├fGraphs
 │ ├fGraphData
 │ ├rTemplates
 │ ├fSurgery
 │ ├rSurgery
 │ ├uEventHooks
 │ ├uSignItems
 │ ├rECS
 │ ├fIconLegend
 │ ├uOrders
 │ ├uSpell
 │ ├uOrPtf
 │ ├fPatientFlagMulti
 │ ├fAlertForward
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOrdersSign
 │ ├uVitals
 │ ├fMHTest
 │ ├uFormMonitor
 │ ├fOtherSchedule
 │ ├uVA508CPRSCompatibility
 │ ├fIVRoutes
 │ ├fPrintLocation
 │ ├fTemplateEditor
 │ └fCombatVet
 ├fBase508Form...
 ├uReports
 └rReports...

Module Called-By (2 levels)


                     fRptBox
                   uOrders┤ 
                   uCore┤ │ 
                 fODBase┤ │ 
                 rODBase┤ │ 
                  fFrame┤ │ 
                 fOrders┤ │ 
             fOrdersSign┤ │ 
                   fMeds┤ │ 
               fARTAllgy┤ │ 
                  fNotes┤ │ 
               fConsults┤ │ 
         fReminderDialog┤ │ 
                 fReview┤ │ 
            fOrdersRenew┤ │ 
               fOrdersCV┤ │ 
                 fODMeds┤ │ 
                 fOMNavA┤ │ 
         fOrderSaveQuick┤ │ 
                  fOMSet┤ │ 
          fOrdersRelease┤ │ 
                 fOMHTML┤ │ 
               fODMedNVA┤ │ 
fODChangeUnreleasedRenew┤ │ 
          fOrdersOnChart┤ │ 
         fODReleaseEvent┤ │ 
               fODActive┘ │ 
                 fFrame...┤ 
                fOrders...┤ 
                  fDrawers┤ 
               fFrame...┤ │ 
                 dShared┤ │ 
              uReminders┤ │ 
               fNotes...┤ │ 
            fConsults...┤ │ 
                 fDCSumm┤ │ 
         fTemplateEditor┤ │ 
                fSurgery┘ │ 
           fTemplateDialog┤ 
              fODBase...┤ │ 
              uTemplates┤ │ 
             fDrawers...┤ │ 
               fNotes...┤ │ 
            fConsults...┤ │ 
              fDCSumm...┤ │ 
           fTemplateView┤ │ 
      fReminderDialog...┤ │ 
             fSurgery...┤ │ 
    fTemplateFieldEditor┤ │ 
         fTemplateFields┤ │ 
                 fODAuto┘ │ 
             uReminders...┤ 
                   fVitals┤ 
              fEncVitals┤ │ 
                  fCover┤ │ 
                    fvit┘ │ 
                 fCover...┤ 
                    fPtSel┤ 
               fFrame...┤ │ 
             fPtSelOptns┤ │ 
                 fDupPts┘ │ 
            fOrdersSign...┤ 
                  fMeds...┤ 
                 fAllgyBox┤ 
               fCover...┘ │ 
              fARTAllgy...┤ 
                 fNotes...┤ 
                    fProbs┤ 
               fFrame...┤ │ 
                fProbEdt┤ │ 
                fProbflt┤ │ 
                fProbLex┘ │ 
                   fGraphs┤ 
               fFrame...┤ │ 
                fReports┘ │ 
            fGraphProfiles┤ 
              fGraphs...┤ │ 
                fOptions┘ │ 
              fConsults...┤ 
          fTemplateView...┤ 
        fReminderDialog...┤ 
                     fLabs┤ 
               fFrame...┤ │ 
                fLabTest┤ │ 
               fLabTests┤ │ 
          fLabTestGroups┤ │ 
               fLabPrint┤ │ 
   fOptionsReportsCustom┘ │ 
                   fPtCWAD┤ 
               fFrame...┤ │ 
                fODAllgy┘ │ 
                fReview...┤ 
         fPatientFlagMulti┤ 
               fFrame...┤ │ 
               fCover...┘ │ 
                fNoteProps┤ 
               fNotes...┤ │ 
            fConsults...┤ │ 
             fSurgery...┤ │ 
            fAddlSigners┘ │ 
                  fNotesBP┤ 
               fNotes...┤ │ 
            fConsults...┤ │ 
              fDCSumm...┤ │ 
             fSurgery...┘ │ 
                 fEditProc┤ 
            fConsults...┘ │ 
              fEditConsult┤ 
            fConsults...┘ │ 
              fConsMedRslt┤ 
            fConsults...┘ │ 
                    fODLab┤ 
              uOrders...┤ │ 
       fODLabOthCollSamp┘ │ 
                fODMeds...┤ 
         fOrdersRelease...┤ 
              fODMedNVA...┤ 
         fOrdersOnChart...┤ 
        fODReleaseEvent...┤ 
                  uOptions┘ 
             fOptions...┤   
            fOptionsDays┤   
       fOptionsSurrogate┤   
fOptionsPatientSelection┤   
           fOptionsLists┤   
           fOptionsTeams┘