1 | unit FormTests;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
|
---|
7 | ActnList, Menus, TestCase, FormEx;
|
---|
8 |
|
---|
9 | type
|
---|
10 |
|
---|
11 | { TFormTests }
|
---|
12 |
|
---|
13 | TFormTests = class(TFormEx)
|
---|
14 | ARun: TAction;
|
---|
15 | AShow: TAction;
|
---|
16 | ActionList1: TActionList;
|
---|
17 | ButtonRun: TButton;
|
---|
18 | ButtonClose: TButton;
|
---|
19 | LabelResult: TLabel;
|
---|
20 | ListViewTestCases: TListView;
|
---|
21 | MenuItem1: TMenuItem;
|
---|
22 | MenuItem2: TMenuItem;
|
---|
23 | PopupMenuTest: TPopupMenu;
|
---|
24 | procedure ARunExecute(Sender: TObject);
|
---|
25 | procedure AShowExecute(Sender: TObject);
|
---|
26 | procedure ButtonRunClick(Sender: TObject);
|
---|
27 | procedure FormShow(Sender: TObject);
|
---|
28 | procedure ListViewTestCasesData(Sender: TObject; Item: TListItem);
|
---|
29 | procedure ListViewTestCasesSelectItem(Sender: TObject; Item: TListItem;
|
---|
30 | Selected: Boolean);
|
---|
31 | private
|
---|
32 | FTestCases: TTestCases;
|
---|
33 | procedure ReloadList;
|
---|
34 | procedure SetTestCases(AValue: TTestCases);
|
---|
35 | procedure UpdateInterface;
|
---|
36 | public
|
---|
37 | property TestCases: TTestCases read FTestCases write SetTestCases;
|
---|
38 | end;
|
---|
39 |
|
---|
40 |
|
---|
41 | implementation
|
---|
42 |
|
---|
43 | {$R *.lfm}
|
---|
44 |
|
---|
45 | uses
|
---|
46 | FormTest;
|
---|
47 |
|
---|
48 | { TFormTests }
|
---|
49 |
|
---|
50 | procedure TFormTests.ListViewTestCasesData(Sender: TObject; Item: TListItem);
|
---|
51 | begin
|
---|
52 | if Item.Index < TestCases.Count then
|
---|
53 | with TestCases[Item.Index] do begin
|
---|
54 | Item.Caption := Name;
|
---|
55 | Item.Data := TestCases[Item.Index];
|
---|
56 | Item.SubItems.Add(ResultText[TestResult]);
|
---|
57 | end;
|
---|
58 | end;
|
---|
59 |
|
---|
60 | procedure TFormTests.ListViewTestCasesSelectItem(Sender: TObject;
|
---|
61 | Item: TListItem; Selected: Boolean);
|
---|
62 | begin
|
---|
63 | UpdateInterface;
|
---|
64 | end;
|
---|
65 |
|
---|
66 | procedure TFormTests.ReloadList;
|
---|
67 | begin
|
---|
68 | if Assigned(TestCases) then
|
---|
69 | ListViewTestCases.Items.Count := TestCases.Count
|
---|
70 | else ListViewTestCases.Items.Count := 0;
|
---|
71 | ListViewTestCases.Refresh;
|
---|
72 | end;
|
---|
73 |
|
---|
74 | procedure TFormTests.SetTestCases(AValue: TTestCases);
|
---|
75 | begin
|
---|
76 | if FTestCases = AValue then Exit;
|
---|
77 | FTestCases := AValue;
|
---|
78 | ReloadList;
|
---|
79 | UpdateInterface;
|
---|
80 | end;
|
---|
81 |
|
---|
82 | procedure TFormTests.UpdateInterface;
|
---|
83 | var
|
---|
84 | Selected: Boolean;
|
---|
85 | Passed: Integer;
|
---|
86 | Failed: Integer;
|
---|
87 | I: Integer;
|
---|
88 | begin
|
---|
89 | Selected := Assigned(ListViewTestCases.Selected);
|
---|
90 | ARun.Enabled := Selected;
|
---|
91 | AShow.Enabled := Selected;
|
---|
92 | ButtonRun.Enabled := Assigned(TestCases);
|
---|
93 |
|
---|
94 | Passed := 0;
|
---|
95 | Failed := 0;
|
---|
96 | if Assigned(TestCases) then
|
---|
97 | for I := 0 to TestCases.Count - 1 do begin
|
---|
98 | case TestCases[I].TestResult of
|
---|
99 | trPassed: Inc(Passed);
|
---|
100 | trFailed: Inc(Failed);
|
---|
101 | end;
|
---|
102 | end;
|
---|
103 | LabelResult.Caption := SPassed + ' ' + IntToStr(Passed) + ', ' +
|
---|
104 | SFailed + ' ' + IntToStr(Failed);
|
---|
105 | end;
|
---|
106 |
|
---|
107 | procedure TFormTests.ButtonRunClick(Sender: TObject);
|
---|
108 | var
|
---|
109 | I: Integer;
|
---|
110 | begin
|
---|
111 | for I := 0 to TestCases.Count - 1 do
|
---|
112 | TestCases[I].Run;
|
---|
113 | ReloadList;
|
---|
114 | UpdateInterface;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | procedure TFormTests.AShowExecute(Sender: TObject);
|
---|
118 | begin
|
---|
119 | if Assigned(ListViewTestCases.Selected) then
|
---|
120 | with TFormTest.Create(nil) do
|
---|
121 | try
|
---|
122 | TestCase := TTestCase(ListViewTestCases.Selected.Data);
|
---|
123 | ShowModal;
|
---|
124 | ReloadList;
|
---|
125 | finally
|
---|
126 | Free;
|
---|
127 | end;
|
---|
128 | end;
|
---|
129 |
|
---|
130 | procedure TFormTests.ARunExecute(Sender: TObject);
|
---|
131 | begin
|
---|
132 | if Assigned(ListViewTestCases.Selected) then begin
|
---|
133 | TTestCase(ListViewTestCases.Selected.Data).Run;
|
---|
134 | ReloadList;
|
---|
135 | UpdateInterface;
|
---|
136 | end;
|
---|
137 | end;
|
---|
138 |
|
---|
139 | procedure TFormTests.FormShow(Sender: TObject);
|
---|
140 | begin
|
---|
141 | ReloadList;
|
---|
142 | UpdateInterface;
|
---|
143 | end;
|
---|
144 |
|
---|
145 | end.
|
---|
146 |
|
---|