unit fLabTests; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORCtrls, StdCtrls, ExtCtrls; type TfrmLabTests = class(TForm) pnlLabTests: TORAutoPanel; cmdOK: TButton; cmdCancel: TButton; lstList: TORListBox; cboTests: TORComboBox; cmdRemove: TButton; cmdClear: TButton; lblTests: TLabel; lblList: TLabel; cmdAdd: TButton; procedure FormCreate(Sender: TObject); procedure cboTestsNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); procedure cmdOKClick(Sender: TObject); procedure cmdClearClick(Sender: TObject); procedure cmdRemoveClick(Sender: TObject); procedure lstListClick(Sender: TObject); procedure cboTestsChange(Sender: TObject); procedure cboTestsEnter(Sender: TObject); procedure cboTestsExit(Sender: TObject); procedure cmdAddClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; procedure SelectTests(FontSize: Integer); implementation uses fLabs, ORFn, rLabs, rMisc; {$R *.DFM} procedure SelectTests(FontSize: Integer); var frmLabTests: TfrmLabTests; W, H: integer; begin frmLabTests := TfrmLabTests.Create(Application); try with frmLabTests do begin Font.Size := FontSize; W := ClientWidth; H := ClientHeight; ResizeToFont(FontSize, W, H); ClientWidth := W; pnlLabTests.Width := W; ClientHeight := H; pnlLabTests.Height := H; lstList.Items.Assign(frmLabs.lstTests.Items); if lstList.Items.Count > 0 then lstList.ItemIndex := 0; lstListClick(frmLabTests); ShowModal; end; finally frmLabTests.Release; end; end; procedure TfrmLabTests.FormCreate(Sender: TObject); begin RedrawSuspend(cboTests.Handle); cboTests.InitLongList(''); RedrawActivate(cboTests.Handle); end; procedure TfrmLabTests.cboTestsNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); begin cboTests.ForDataUse(AllTests(StartFrom, Direction)); end; procedure TfrmLabTests.cmdOKClick(Sender: TObject); begin if lstList.Items.Count = 0 then ShowMessage('No tests were selected.') else begin frmLabs.lstTests.Items.Assign(lstList.Items); Close; end; end; procedure TfrmLabTests.cmdClearClick(Sender: TObject); begin lstList.Clear; lstListClick(self); end; procedure TfrmLabTests.cmdRemoveClick(Sender: TObject); var newindex: integer; begin if lstList.Items.Count > 0 then begin if lstList.ItemIndex = (lstList.Items.Count -1 ) then newindex := lstList.ItemIndex - 1 else newindex := lstList.ItemIndex; lstList.Items.Delete(lstList.ItemIndex); if lstList.Items.Count > 0 then lstList.ItemIndex := newindex; end; lstListClick(self); end; procedure TfrmLabTests.lstListClick(Sender: TObject); begin if lstList.Items.Count = 0 then begin cmdClear.Enabled := false; cmdRemove.Enabled := false; end else begin cmdClear.Enabled := true; cmdRemove.Enabled := true; end; end; procedure TfrmLabTests.cboTestsChange(Sender: TObject); begin cmdAdd.Enabled := cboTests.ItemIndex > -1; end; procedure TfrmLabTests.cboTestsEnter(Sender: TObject); begin cmdAdd.Default := true; end; procedure TfrmLabTests.cboTestsExit(Sender: TObject); begin cmdAdd.Default := false; end; procedure TfrmLabTests.cmdAddClick(Sender: TObject); var i, textindex: integer; begin textindex := lstList.Items.Count; for i := 0 to lstList.Items.Count -1 do if lstList.Items[i] = cboTests.Items[cboTests.ItemIndex] then textindex := i; if textindex = lstList.Items.Count then lstList.Items.Add(cboTests.Items[cboTests.ItemIndex]); lstList.ItemIndex := textindex; lstListClick(self); end; procedure TfrmLabTests.FormShow(Sender: TObject); begin SetFormPosition(Self); end; procedure TfrmLabTests.FormClose(Sender: TObject; var Action: TCloseAction); begin SaveUserBounds(Self); end; end.