Module

fLabTests

Path

C:\CPRS\CPRS30\fLabTests.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
fLabs -
rLabs -
rMisc -

Classes

Name Comments
TfrmLabTests -

Procedures

Name Owner Declaration Scope Comments
cboTestsChange TfrmLabTests procedure cboTestsChange(Sender: TObject); Public/Published -
cboTestsEnter TfrmLabTests procedure cboTestsEnter(Sender: TObject); Public/Published -
cboTestsExit TfrmLabTests procedure cboTestsExit(Sender: TObject); Public/Published -
cboTestsNeedData TfrmLabTests procedure cboTestsNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Public/Published -
cmdAddClick TfrmLabTests procedure cmdAddClick(Sender: TObject); Public/Published -
cmdClearClick TfrmLabTests procedure cmdClearClick(Sender: TObject); Public/Published -
cmdOKClick TfrmLabTests procedure cmdOKClick(Sender: TObject); Public/Published -
cmdRemoveClick TfrmLabTests procedure cmdRemoveClick(Sender: TObject); Public/Published -
FormClose TfrmLabTests procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmLabTests procedure FormCreate(Sender: TObject); Public/Published -
lstListClick TfrmLabTests procedure lstListClick(Sender: TObject); Public/Published -
SelectTests - procedure SelectTests(FontSize: Integer); Interfaced -


Module Source

1     unit fLabTests;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ORCtrls, StdCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager;
8     
9     type
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    
39    procedure SelectTests(FontSize: Integer);
40    
41    implementation
42    
43    uses fLabs, ORFn, rLabs, rMisc, VAUtils;
44    
45    {$R *.DFM}
46    
47    procedure SelectTests(FontSize: Integer);
48    var
49      frmLabTests: TfrmLabTests;
50      W, H: integer;
51    begin
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;
71    end;
72    
73    procedure TfrmLabTests.FormCreate(Sender: TObject);
74    begin
75      RedrawSuspend(cboTests.Handle);
76      cboTests.InitLongList('');
77      RedrawActivate(cboTests.Handle);
78    end;
79    
80    procedure TfrmLabTests.cboTestsNeedData(Sender: TObject;
81      const StartFrom: string; Direction, InsertAt: Integer);
82    begin
83      cboTests.ForDataUse(AllTests(StartFrom, Direction));
84    end;
85    
86    procedure TfrmLabTests.cmdOKClick(Sender: TObject);
87    begin
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;
95    end;
96    
97    procedure TfrmLabTests.cmdClearClick(Sender: TObject);
98    begin
99      lstList.Clear;
100     lstListClick(self);
101   end;
102   
103   procedure TfrmLabTests.cmdRemoveClick(Sender: TObject);
104   var
105     newindex: integer;
106   begin
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);
117   end;
118   
119   procedure TfrmLabTests.lstListClick(Sender: TObject);
120   begin
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;
131   end;
132   
133   procedure TfrmLabTests.cboTestsChange(Sender: TObject);
134   begin
135     cmdAdd.Enabled := cboTests.ItemIndex > -1;
136   end;
137   
138   procedure TfrmLabTests.cboTestsEnter(Sender: TObject);
139   begin
140     cmdAdd.Default := true;
141   end;
142   
143   procedure TfrmLabTests.cboTestsExit(Sender: TObject);
144   begin
145     cmdAdd.Default := false;
146   end;
147   
148   procedure TfrmLabTests.cmdAddClick(Sender: TObject);
149   var
150     i, textindex: integer;
151   begin
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);
158   end;
159   
160   procedure TfrmLabTests.FormClose(Sender: TObject;
161     var Action: TCloseAction);
162   begin
163     SaveUserBounds(Self);
164   end;
165   
166   end.

Module Calls (2 levels)


fLabTests
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├fLabs
 │ ├fHSplit
 │ ├fLabTest
 │ ├fLabTests...
 │ ├fLabTestGroups
 │ ├uConst
 │ ├fBase508Form...
 │ ├uCore
 │ ├rLabs
 │ ├rCore
 │ ├rOrders
 │ ├fLabPrint
 │ ├fFrame
 │ ├fRptBox
 │ ├fReportsPrint
 │ ├rReports
 │ ├rGraphs
 │ └uReports
 ├rLabs...
 └rMisc
   └fOrders

Module Called-By (2 levels)


                fLabTests
                  fLabs┘ 
               fFrame┤   
             fLabTest┤   
         fLabTests...┤   
       fLabTestGroups┤   
            fLabPrint┤   
fOptionsReportsCustom┘