source: Common/Forms/FormTests.pas

Last change on this file was 566, checked in by chronos, 17 months ago
  • Modified: Updated Common package.
File size: 3.1 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 LabelResult: TLabel;
19 ListViewTestCases: TListView;
20 MenuItem1: TMenuItem;
21 MenuItem2: TMenuItem;
22 PopupMenuTest: TPopupMenu;
23 procedure ARunExecute(Sender: TObject);
24 procedure AShowExecute(Sender: TObject);
25 procedure ButtonRunClick(Sender: TObject);
26 procedure FormShow(Sender: TObject);
27 procedure ListViewTestCasesData(Sender: TObject; Item: TListItem);
28 procedure ListViewTestCasesSelectItem(Sender: TObject; Item: TListItem;
29 Selected: Boolean);
30 private
31 FTestCases: TTestCases;
32 procedure ReloadList;
33 procedure SetTestCases(AValue: TTestCases);
34 procedure UpdateInterface;
35 public
36 property TestCases: TTestCases read FTestCases write SetTestCases;
37 end;
38
39
40implementation
41
42{$R *.lfm}
43
44uses
45 FormTest;
46
47{ TFormTests }
48
49procedure TFormTests.ListViewTestCasesData(Sender: TObject; Item: TListItem);
50begin
51 if Item.Index < TestCases.Count then
52 with TestCases[Item.Index] do begin
53 Item.Caption := Name;
54 Item.Data := TestCases[Item.Index];
55 Item.SubItems.Add(ResultText[TestResult]);
56 end;
57end;
58
59procedure TFormTests.ListViewTestCasesSelectItem(Sender: TObject;
60 Item: TListItem; Selected: Boolean);
61begin
62 UpdateInterface;
63end;
64
65procedure TFormTests.ReloadList;
66begin
67 if Assigned(TestCases) then
68 ListViewTestCases.Items.Count := TestCases.Count
69 else ListViewTestCases.Items.Count := 0;
70 ListViewTestCases.Refresh;
71end;
72
73procedure TFormTests.SetTestCases(AValue: TTestCases);
74begin
75 if FTestCases = AValue then Exit;
76 FTestCases := AValue;
77 ReloadList;
78 UpdateInterface;
79end;
80
81procedure TFormTests.UpdateInterface;
82var
83 Selected: Boolean;
84 Passed: Integer;
85 Failed: Integer;
86 I: Integer;
87begin
88 Selected := Assigned(ListViewTestCases.Selected);
89 ARun.Enabled := Selected;
90 AShow.Enabled := Selected;
91 ButtonRun.Enabled := Assigned(TestCases);
92
93 Passed := 0;
94 Failed := 0;
95 if Assigned(TestCases) then
96 for I := 0 to TestCases.Count - 1 do begin
97 case TestCases[I].TestResult of
98 trPassed: Inc(Passed);
99 trFailed: Inc(Failed);
100 end;
101 end;
102 LabelResult.Caption := SPassed + ' ' + IntToStr(Passed) + ', ' +
103 SFailed + ' ' + IntToStr(Failed);
104end;
105
106procedure TFormTests.ButtonRunClick(Sender: TObject);
107var
108 I: Integer;
109begin
110 for I := 0 to TestCases.Count - 1 do
111 TestCases[I].Run;
112 ReloadList;
113 UpdateInterface;
114end;
115
116procedure TFormTests.AShowExecute(Sender: TObject);
117begin
118 if Assigned(ListViewTestCases.Selected) then
119 with TFormTest.Create(nil) do
120 try
121 MemoLog.Text := TTestCase(ListViewTestCases.Selected.Data).Log;
122 ShowModal;
123 finally
124 Free;
125 end;
126end;
127
128procedure TFormTests.ARunExecute(Sender: TObject);
129begin
130 if Assigned(ListViewTestCases.Selected) then begin
131 TTestCase(ListViewTestCases.Selected.Data).Run;
132 ReloadList;
133 UpdateInterface;
134 end;
135end;
136
137procedure TFormTests.FormShow(Sender: TObject);
138begin
139 ReloadList;
140 UpdateInterface;
141end;
142
143end.
144
Note: See TracBrowser for help on using the repository browser.