| 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 |
|
|---|