source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fLabTests.pas@ 1723

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

Upgrading to version 27

File size: 4.2 KB
Line 
1unit fLabTests;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ORCtrls, StdCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager;
8
9type
10 TfrmLabTests = class(TfrmBase508Form)
11 pnlLabTests: TORAutoPanel;
12 cmdOK: TButton;
13 cmdCancel: TButton;
14 lstList: TORListBox;
15 cboTests: TORComboBox;
16 cmdRemove: TButton;
17 cmdClear: TButton;
18 lblTests: TLabel;
19 lblList: TLabel;
20 cmdAdd: TButton;
21 procedure FormCreate(Sender: TObject);
22 procedure cboTestsNeedData(Sender: TObject; const StartFrom: string;
23 Direction, InsertAt: Integer);
24 procedure cmdOKClick(Sender: TObject);
25 procedure cmdClearClick(Sender: TObject);
26 procedure cmdRemoveClick(Sender: TObject);
27 procedure lstListClick(Sender: TObject);
28 procedure cboTestsChange(Sender: TObject);
29 procedure cboTestsEnter(Sender: TObject);
30 procedure cboTestsExit(Sender: TObject);
31 procedure cmdAddClick(Sender: TObject);
32 procedure FormClose(Sender: TObject; var Action: TCloseAction);
33 private
34 { Private declarations }
35 public
36 { Public declarations }
37 end;
38
39procedure SelectTests(FontSize: Integer);
40
41implementation
42
43uses fLabs, ORFn, rLabs, rMisc, VAUtils;
44
45{$R *.DFM}
46
47procedure SelectTests(FontSize: Integer);
48var
49 frmLabTests: TfrmLabTests;
50 W, H: integer;
51begin
52 frmLabTests := TfrmLabTests.Create(Application);
53 try
54 with frmLabTests do
55 begin
56 Font.Size := FontSize;
57 W := ClientWidth;
58 H := ClientHeight;
59 ResizeToFont(FontSize, W, H);
60 ClientWidth := W; pnlLabTests.Width := W;
61 ClientHeight := H; pnlLabTests.Height := H;
62 SetFormPosition(frmLabTests);
63 FastAssign(frmLabs.lstTests.Items, lstList.Items);
64 if lstList.Items.Count > 0 then lstList.ItemIndex := 0;
65 lstListClick(frmLabTests);
66 ShowModal;
67 end;
68 finally
69 frmLabTests.Release;
70 end;
71end;
72
73procedure TfrmLabTests.FormCreate(Sender: TObject);
74begin
75 RedrawSuspend(cboTests.Handle);
76 cboTests.InitLongList('');
77 RedrawActivate(cboTests.Handle);
78end;
79
80procedure TfrmLabTests.cboTestsNeedData(Sender: TObject;
81 const StartFrom: string; Direction, InsertAt: Integer);
82begin
83 cboTests.ForDataUse(AllTests(StartFrom, Direction));
84end;
85
86procedure TfrmLabTests.cmdOKClick(Sender: TObject);
87begin
88 if lstList.Items.Count = 0 then
89 ShowMsg('No tests were selected.')
90 else
91 begin
92 FastAssign(lstList.Items, frmLabs.lstTests.Items);
93 Close;
94 end;
95end;
96
97procedure TfrmLabTests.cmdClearClick(Sender: TObject);
98begin
99 lstList.Clear;
100 lstListClick(self);
101end;
102
103procedure TfrmLabTests.cmdRemoveClick(Sender: TObject);
104var
105 newindex: integer;
106begin
107 if lstList.Items.Count > 0 then
108 begin
109 if lstList.ItemIndex = (lstList.Items.Count -1 ) then
110 newindex := lstList.ItemIndex - 1
111 else
112 newindex := lstList.ItemIndex;
113 lstList.Items.Delete(lstList.ItemIndex);
114 if lstList.Items.Count > 0 then lstList.ItemIndex := newindex;
115 end;
116 lstListClick(self);
117end;
118
119procedure TfrmLabTests.lstListClick(Sender: TObject);
120begin
121 if lstList.Items.Count = 0 then
122 begin
123 cmdClear.Enabled := false;
124 cmdRemove.Enabled := false;
125 end
126 else
127 begin
128 cmdClear.Enabled := true;
129 cmdRemove.Enabled := true;
130 end;
131end;
132
133procedure TfrmLabTests.cboTestsChange(Sender: TObject);
134begin
135 cmdAdd.Enabled := cboTests.ItemIndex > -1;
136end;
137
138procedure TfrmLabTests.cboTestsEnter(Sender: TObject);
139begin
140 cmdAdd.Default := true;
141end;
142
143procedure TfrmLabTests.cboTestsExit(Sender: TObject);
144begin
145 cmdAdd.Default := false;
146end;
147
148procedure TfrmLabTests.cmdAddClick(Sender: TObject);
149var
150 i, textindex: integer;
151begin
152 textindex := lstList.Items.Count;
153 for i := 0 to lstList.Items.Count -1 do
154 if lstList.Items[i] = cboTests.Items[cboTests.ItemIndex] then textindex := i;
155 if textindex = lstList.Items.Count then lstList.Items.Add(cboTests.Items[cboTests.ItemIndex]);
156 lstList.ItemIndex := textindex;
157 lstListClick(self);
158end;
159
160procedure TfrmLabTests.FormClose(Sender: TObject;
161 var Action: TCloseAction);
162begin
163 SaveUserBounds(Self);
164end;
165
166end.
Note: See TracBrowser for help on using the repository browser.