source: trunk/Packages/Common/Forms/FormTests.pas

Last change on this file was 219, checked in by chronos, 5 days ago
  • Modified: Updated Common package.
  • Modified: Remove U prefix from unit names.
  • Modified: Use Gneeric.Collections instead of fgl.
  • Modified: Do not use global form variables.
File size: 3.2 KB
Line 
1unit FormTests;
2
3interface
4
5uses
6 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
7 ActnList, Menus, TestCase, FormEx;
8
9type
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
41implementation
42
43{$R *.lfm}
44
45uses
46 FormTest;
47
48{ TFormTests }
49
50procedure TFormTests.ListViewTestCasesData(Sender: TObject; Item: TListItem);
51begin
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;
58end;
59
60procedure TFormTests.ListViewTestCasesSelectItem(Sender: TObject;
61 Item: TListItem; Selected: Boolean);
62begin
63 UpdateInterface;
64end;
65
66procedure TFormTests.ReloadList;
67begin
68 if Assigned(TestCases) then
69 ListViewTestCases.Items.Count := TestCases.Count
70 else ListViewTestCases.Items.Count := 0;
71 ListViewTestCases.Refresh;
72end;
73
74procedure TFormTests.SetTestCases(AValue: TTestCases);
75begin
76 if FTestCases = AValue then Exit;
77 FTestCases := AValue;
78 ReloadList;
79 UpdateInterface;
80end;
81
82procedure TFormTests.UpdateInterface;
83var
84 Selected: Boolean;
85 Passed: Integer;
86 Failed: Integer;
87 I: Integer;
88begin
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);
105end;
106
107procedure TFormTests.ButtonRunClick(Sender: TObject);
108var
109 I: Integer;
110begin
111 for I := 0 to TestCases.Count - 1 do
112 TestCases[I].Run;
113 ReloadList;
114 UpdateInterface;
115end;
116
117procedure TFormTests.AShowExecute(Sender: TObject);
118begin
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;
128end;
129
130procedure TFormTests.ARunExecute(Sender: TObject);
131begin
132 if Assigned(ListViewTestCases.Selected) then begin
133 TTestCase(ListViewTestCases.Selected.Data).Run;
134 ReloadList;
135 UpdateInterface;
136 end;
137end;
138
139procedure TFormTests.FormShow(Sender: TObject);
140begin
141 ReloadList;
142 UpdateInterface;
143end;
144
145end.
146
Note: See TracBrowser for help on using the repository browser.