source: cprs/branches/tmg-cprs/CPRS-Chart/fLabTests.pas@ 838

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

Initial upload of TMG-CPRS 1.0.26.69

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