| [453] | 1 | //kt -- Modified with SourceScanner on 7/19/2007 | 
|---|
|  | 2 | unit fLabTests; | 
|---|
|  | 3 |  | 
|---|
|  | 4 | interface | 
|---|
|  | 5 |  | 
|---|
|  | 6 | uses | 
|---|
|  | 7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
|  | 8 | ORCtrls, StdCtrls, ExtCtrls, DKLang; | 
|---|
|  | 9 |  | 
|---|
|  | 10 | type | 
|---|
|  | 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 |  | 
|---|
|  | 42 | procedure SelectTests(FontSize: Integer); | 
|---|
|  | 43 |  | 
|---|
|  | 44 | implementation | 
|---|
|  | 45 |  | 
|---|
|  | 46 | uses fLabs, ORFn, rLabs, rMisc; | 
|---|
|  | 47 |  | 
|---|
|  | 48 | {$R *.DFM} | 
|---|
|  | 49 |  | 
|---|
|  | 50 | procedure SelectTests(FontSize: Integer); | 
|---|
|  | 51 | var | 
|---|
|  | 52 | frmLabTests: TfrmLabTests; | 
|---|
|  | 53 | W, H: integer; | 
|---|
|  | 54 | begin | 
|---|
|  | 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; | 
|---|
|  | 73 | end; | 
|---|
|  | 74 |  | 
|---|
|  | 75 | procedure TfrmLabTests.FormCreate(Sender: TObject); | 
|---|
|  | 76 | begin | 
|---|
|  | 77 | RedrawSuspend(cboTests.Handle); | 
|---|
|  | 78 | cboTests.InitLongList(''); | 
|---|
|  | 79 | RedrawActivate(cboTests.Handle); | 
|---|
|  | 80 | end; | 
|---|
|  | 81 |  | 
|---|
|  | 82 | procedure TfrmLabTests.cboTestsNeedData(Sender: TObject; | 
|---|
|  | 83 | const StartFrom: string; Direction, InsertAt: Integer); | 
|---|
|  | 84 | begin | 
|---|
|  | 85 | cboTests.ForDataUse(AllTests(StartFrom, Direction)); | 
|---|
|  | 86 | end; | 
|---|
|  | 87 |  | 
|---|
|  | 88 | procedure TfrmLabTests.cmdOKClick(Sender: TObject); | 
|---|
|  | 89 | begin | 
|---|
|  | 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; | 
|---|
|  | 98 | end; | 
|---|
|  | 99 |  | 
|---|
|  | 100 | procedure TfrmLabTests.cmdClearClick(Sender: TObject); | 
|---|
|  | 101 | begin | 
|---|
|  | 102 | lstList.Clear; | 
|---|
|  | 103 | lstListClick(self); | 
|---|
|  | 104 | end; | 
|---|
|  | 105 |  | 
|---|
|  | 106 | procedure TfrmLabTests.cmdRemoveClick(Sender: TObject); | 
|---|
|  | 107 | var | 
|---|
|  | 108 | newindex: integer; | 
|---|
|  | 109 | begin | 
|---|
|  | 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); | 
|---|
|  | 120 | end; | 
|---|
|  | 121 |  | 
|---|
|  | 122 | procedure TfrmLabTests.lstListClick(Sender: TObject); | 
|---|
|  | 123 | begin | 
|---|
|  | 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; | 
|---|
|  | 134 | end; | 
|---|
|  | 135 |  | 
|---|
|  | 136 | procedure TfrmLabTests.cboTestsChange(Sender: TObject); | 
|---|
|  | 137 | begin | 
|---|
|  | 138 | cmdAdd.Enabled := cboTests.ItemIndex > -1; | 
|---|
|  | 139 | end; | 
|---|
|  | 140 |  | 
|---|
|  | 141 | procedure TfrmLabTests.cboTestsEnter(Sender: TObject); | 
|---|
|  | 142 | begin | 
|---|
|  | 143 | cmdAdd.Default := true; | 
|---|
|  | 144 | end; | 
|---|
|  | 145 |  | 
|---|
|  | 146 | procedure TfrmLabTests.cboTestsExit(Sender: TObject); | 
|---|
|  | 147 | begin | 
|---|
|  | 148 | cmdAdd.Default := false; | 
|---|
|  | 149 | end; | 
|---|
|  | 150 |  | 
|---|
|  | 151 | procedure TfrmLabTests.cmdAddClick(Sender: TObject); | 
|---|
|  | 152 | var | 
|---|
|  | 153 | i, textindex: integer; | 
|---|
|  | 154 | begin | 
|---|
|  | 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); | 
|---|
|  | 161 | end; | 
|---|
|  | 162 |  | 
|---|
|  | 163 | procedure TfrmLabTests.FormShow(Sender: TObject); | 
|---|
|  | 164 | begin | 
|---|
|  | 165 | SetFormPosition(Self); | 
|---|
|  | 166 | end; | 
|---|
|  | 167 |  | 
|---|
|  | 168 | procedure TfrmLabTests.FormClose(Sender: TObject; | 
|---|
|  | 169 | var Action: TCloseAction); | 
|---|
|  | 170 | begin | 
|---|
|  | 171 | SaveUserBounds(Self); | 
|---|
|  | 172 | end; | 
|---|
|  | 173 |  | 
|---|
|  | 174 | end. | 
|---|