1 | unit fLabTest;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | ORCtrls, StdCtrls, ExtCtrls, ORNet, fBase508Form, VA508AccessibilityManager;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TfrmLabTest = class(TfrmBase508Form)
|
---|
11 | pnlLabTest: TORAutoPanel;
|
---|
12 | cmdOK: TButton;
|
---|
13 | cmdCancel: TButton;
|
---|
14 | cboList: TORComboBox;
|
---|
15 | cboSpecimen: TORComboBox;
|
---|
16 | lblTest: TLabel;
|
---|
17 | lblSpecimen: TLabel;
|
---|
18 | lblSpecInfo: TLabel;
|
---|
19 | procedure FormCreate(Sender: TObject);
|
---|
20 | procedure cboListNeedData(Sender: TObject; const StartFrom: string;
|
---|
21 | Direction, InsertAt: Integer);
|
---|
22 | procedure cboSpecimenNeedData(Sender: TObject; const StartFrom: string;
|
---|
23 | Direction, InsertAt: Integer);
|
---|
24 | procedure cmdOKClick(Sender: TObject);
|
---|
25 | procedure cboListEnter(Sender: TObject);
|
---|
26 | procedure cboListExit(Sender: TObject);
|
---|
27 | private
|
---|
28 | { Private declarations }
|
---|
29 | public
|
---|
30 | { Public declarations }
|
---|
31 | end;
|
---|
32 |
|
---|
33 | procedure SelectTest(FontSize: Integer);
|
---|
34 |
|
---|
35 | implementation
|
---|
36 |
|
---|
37 | uses fLabs, ORFn, rLabs, VAUtils;
|
---|
38 |
|
---|
39 | {$R *.DFM}
|
---|
40 |
|
---|
41 | procedure SelectTest(FontSize: Integer);
|
---|
42 | var
|
---|
43 | frmLabTest: TfrmLabTest;
|
---|
44 | W, H: integer;
|
---|
45 | begin
|
---|
46 | frmLabTest := TfrmLabTest.Create(Application);
|
---|
47 | try
|
---|
48 | with frmLabTest do
|
---|
49 | begin
|
---|
50 | Font.Size := FontSize;
|
---|
51 | W := ClientWidth;
|
---|
52 | H := ClientHeight;
|
---|
53 | ResizeToFont(FontSize, W, H);
|
---|
54 | ClientWidth := W; pnlLabTest.Width := W;
|
---|
55 | ClientHeight := H; pnlLabTest.Height := H;
|
---|
56 | lblSpecInfo.Height := cboList.Height;
|
---|
57 | lblSpecInfo.Width := pnlLabTest.Width - cboList.Left - cboList.Width -10;
|
---|
58 | ShowModal;
|
---|
59 | end;
|
---|
60 | finally
|
---|
61 | frmLabTest.Release;
|
---|
62 | end;
|
---|
63 | end;
|
---|
64 |
|
---|
65 | procedure TfrmLabTest.FormCreate(Sender: TObject);
|
---|
66 | var
|
---|
67 | blood, urine, serum, plasma: string;
|
---|
68 | begin
|
---|
69 | RedrawSuspend(cboList.Handle);
|
---|
70 | cboList.InitLongList('');
|
---|
71 | RedrawActivate(cboList.Handle);
|
---|
72 | RedrawSuspend(cboSpecimen.Handle);
|
---|
73 | cboSpecimen.InitLongList('');
|
---|
74 | SpecimenDefaults(blood, urine, serum, plasma);
|
---|
75 | cboSpecimen.Items.Add('0^Any');
|
---|
76 | cboSpecimen.Items.Add(serum + '^Serum');
|
---|
77 | cboSpecimen.Items.Add(blood + '^Blood');
|
---|
78 | cboSpecimen.Items.Add(plasma + '^Plasma');
|
---|
79 | cboSpecimen.Items.Add(urine + '^Urine');
|
---|
80 | cboSpecimen.Items.Add(LLS_LINE);
|
---|
81 | cboSpecimen.Items.Add(LLS_SPACE);
|
---|
82 | cboSpecimen.ItemIndex := 0;
|
---|
83 | RedrawActivate(cboSpecimen.Handle);
|
---|
84 | end;
|
---|
85 |
|
---|
86 | procedure TfrmLabTest.cboListNeedData(Sender: TObject;
|
---|
87 | const StartFrom: string; Direction, InsertAt: Integer);
|
---|
88 | begin
|
---|
89 | cboList.ForDataUse(AtomicTests(StartFrom, Direction));
|
---|
90 | end;
|
---|
91 |
|
---|
92 | procedure TfrmLabTest.cboSpecimenNeedData(Sender: TObject;
|
---|
93 | const StartFrom: string; Direction, InsertAt: Integer);
|
---|
94 | begin
|
---|
95 | cboSpecimen.ForDataUse(Specimens(StartFrom, Direction));
|
---|
96 | end;
|
---|
97 |
|
---|
98 | procedure TfrmLabTest.cmdOKClick(Sender: TObject);
|
---|
99 | begin
|
---|
100 | if cboList.ItemIndex = -1 then
|
---|
101 | ShowMsg('No test was selected.')
|
---|
102 | else
|
---|
103 | begin
|
---|
104 | frmLabs.lblSingleTest.Caption := cboList.Items[cboList.ItemIndex];
|
---|
105 | frmLabs.lblSpecimen.Caption := cboSpecimen.Items[cboSpecimen.ItemIndex];
|
---|
106 | Close;
|
---|
107 | end;
|
---|
108 | end;
|
---|
109 |
|
---|
110 | procedure TfrmLabTest.cboListEnter(Sender: TObject);
|
---|
111 | begin
|
---|
112 | cmdOK.Default := true;
|
---|
113 | end;
|
---|
114 |
|
---|
115 | procedure TfrmLabTest.cboListExit(Sender: TObject);
|
---|
116 | begin
|
---|
117 | cmdOK.Default := false;
|
---|
118 | end;
|
---|
119 |
|
---|
120 | end.
|
---|