source: cprs/trunk/CPRS-Chart/fPtDemo.pas@ 1535

Last change on this file since 1535 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 4.7 KB
Line 
1unit fPtDemo;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ORCtrls, ORFn, ComCtrls, fBase508Form,
8 VA508AccessibilityManager, uReports;
9
10type
11 TfrmPtDemo = class(TfrmBase508Form)
12 lblFontTest: TLabel;
13 memPtDemo: TRichEdit;
14 pnlTop: TORAutoPanel;
15 cmdNewPt: TButton;
16 cmdClose: TButton;
17 cmdPrint: TButton;
18 dlgPrintReport: TPrintDialog;
19 procedure cmdCloseClick(Sender: TObject);
20 procedure cmdNewPtClick(Sender: TObject);
21 procedure FormCreate(Sender: TObject);
22 procedure cmdPrintClick(Sender: TObject);
23 private
24 { Private declarations }
25 FNewPt: Boolean;
26 public
27 { Public declarations }
28 end;
29
30procedure PatientInquiry(var NewPt: Boolean);
31
32implementation
33
34{$R *.DFM}
35
36uses rCover, rReports, Printers, uCore;
37
38procedure PatientInquiry(var NewPt: Boolean);
39{ displays patient demographics, returns true in NewPt if the user pressed 'Select New' btn }
40var
41 frmPtDemo: TfrmPtDemo;
42begin
43 if StrToInt64Def(Patient.DFN, 0) <= 0 then exit;
44 frmPtDemo := TfrmPtDemo.Create(Application);
45 try
46 with frmPtDemo do
47 begin
48 frmPtDemo.ShowModal;
49 NewPt := FNewPt;
50 end; {with frmPtDemo}
51 finally
52 frmPtDemo.Release;
53 end;
54end;
55
56procedure TfrmPtDemo.FormCreate(Sender: TObject);
57var
58 i, MaxWidth, AWidth, AHeight: Integer;
59 Rect: TRect;
60begin
61 FNewPt := False;
62 LoadDemographics(memPtDemo.Lines);
63 memPtDemo.SelStart := 0;
64 ResizeAnchoredFormToFont(self);
65 MaxWidth := 350; // make sure at least 350 wide
66 for i := 0 to memPtDemo.Lines.Count - 1 do
67 begin
68 AWidth := lblFontTest.Canvas.TextWidth(memPtDemo.Lines[i]);
69 if AWidth > MaxWidth then MaxWidth := AWidth;
70 end;
71 { width = borders + inset of memo box (left=8) }
72 MaxWidth := MaxWidth + (GetSystemMetrics(SM_CXFRAME) * 2)
73 + GetSystemMetrics(SM_CXVSCROLL) + 16;
74 { height = height of lines + title bar + borders + 4 lines (room for buttons) }
75 AHeight := ((memPtDemo.Lines.Count + 4) * (lblFontTest.Height + 1))
76 + (GetSystemMetrics(SM_CYFRAME) * 3) + GetSystemMetrics(SM_CYCAPTION);
77 AHeight := HigherOf(AHeight, 250); // make sure at least 250 high
78 if AHeight > (Screen.Height - 120) then AHeight := Screen.Height - 120;
79 if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
80 Width := MaxWidth;
81 Height := AHeight;
82 Rect := BoundsRect;
83 ForceInsideWorkArea(Rect);
84 BoundsRect := Rect;
85end;
86
87procedure TfrmPtDemo.cmdNewPtClick(Sender: TObject);
88begin
89 FNewPt := True;
90 Close;
91end;
92
93procedure TfrmPtDemo.cmdCloseClick(Sender: TObject);
94begin
95 Close;
96end;
97
98procedure TfrmPtDemo.cmdPrintClick(Sender: TObject);
99var
100 AHeader: TStringList;
101 memPrintReport: TRichEdit;
102 StartLine, MaxLines, LastLine, ThisPage, i: integer;
103 ErrMsg: string;
104 RemoteSiteID: string; //for Remote site printing
105 RemoteQuery: string; //for Remote site printing
106const
107 PAGE_BREAK = '**PAGE BREAK**';
108begin
109 RemoteSiteID := '';
110 RemoteQuery := '';
111 if dlgPrintReport.Execute then
112 begin
113 AHeader := TStringList.Create;
114 CreatePatientHeader(AHeader, Self.Caption);
115 memPrintReport := CreateReportTextComponent(Self);
116 try
117 MaxLines := 60 - AHeader.Count;
118 LastLine := 0;
119 ThisPage := 0;
120 with memPrintReport do
121 begin
122 StartLine := 4;
123 repeat
124 with Lines do
125 begin
126 AddStrings(AHeader);
127 for i := StartLine to MaxLines do
128 //if i < memPtDemo.Lines.Count - 1 then
129 if i < memPtDemo.Lines.Count then
130 Add(memPtDemo.Lines[LastLine + i])
131 else
132 Break;
133 LastLine := LastLine + i;
134 Add(' ');
135 Add(' ');
136 Add(StringOfChar('-', 74));
137 if LastLine >= memPtDemo.Lines.Count - 1 then
138 Add('End of report')
139 else
140 begin
141 ThisPage := ThisPage + 1;
142 Add('Page ' + IntToStr(ThisPage));
143 Add(PAGE_BREAK);
144 StartLine := 0;
145 end;
146 end;
147 until LastLine >= memPtDemo.Lines.Count - 1;
148 PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg);
149 end;
150 finally
151 memPrintReport.Free;
152 AHeader.Free;
153 end;
154 end;
155 memPtDemo.SelStart := 0;
156 memPtDemo.Invalidate;
157end;
158
159end.
Note: See TracBrowser for help on using the repository browser.