source: cprs/branches/foia-cprs/CPRS-Chart/fLabTests.pas@ 755

Last change on this file since 755 was 460, checked in by Kevin Toppenberg, 16 years ago

Uploading from OR_30_258

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;
8
9type
10 TfrmLabTests = class(TForm)
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 FormShow(Sender: TObject);
33 procedure FormClose(Sender: TObject; var Action: TCloseAction);
34 private
35 { Private declarations }
36 public
37 { Public declarations }
38 end;
39
40procedure SelectTests(FontSize: Integer);
41
42implementation
43
44uses fLabs, ORFn, rLabs, rMisc;
45
46{$R *.DFM}
47
48procedure SelectTests(FontSize: Integer);
49var
50 frmLabTests: TfrmLabTests;
51 W, H: integer;
52begin
53 frmLabTests := TfrmLabTests.Create(Application);
54 try
55 with frmLabTests do
56 begin
57 Font.Size := FontSize;
58 W := ClientWidth;
59 H := ClientHeight;
60 ResizeToFont(FontSize, W, H);
61 ClientWidth := W; pnlLabTests.Width := W;
62 ClientHeight := H; pnlLabTests.Height := H;
63 lstList.Items.Assign(frmLabs.lstTests.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 ShowMessage('No tests were selected.')
90 else
91 begin
92 frmLabs.lstTests.Items.Assign(lstList.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.FormShow(Sender: TObject);
161begin
162 SetFormPosition(Self);
163end;
164
165procedure TfrmLabTests.FormClose(Sender: TObject;
166 var Action: TCloseAction);
167begin
168 SaveUserBounds(Self);
169end;
170
171end.
Note: See TracBrowser for help on using the repository browser.