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