source: branches/xpascal/Packages/Common/Forms/FormTests.pas

unit FormTests;

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
  ActnList, Menus, TestCase, FormEx;

type

  { TFormTests }

  TFormTests = class(TFormEx)
    ARun: TAction;
    AShow: TAction;
    ActionList1: TActionList;
    ButtonRun: TButton;
    LabelResult: TLabel;
    ListViewTestCases: TListView;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    PopupMenuTest: TPopupMenu;
    procedure ARunExecute(Sender: TObject);
    procedure AShowExecute(Sender: TObject);
    procedure ButtonRunClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListViewTestCasesData(Sender: TObject; Item: TListItem);
    procedure ListViewTestCasesSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    FTestCases: TTestCases;
    procedure ReloadList;
    procedure SetTestCases(AValue: TTestCases);
    procedure UpdateInterface;
  public
    property TestCases: TTestCases read FTestCases write SetTestCases;
  end;


implementation

{$R *.lfm}

uses
  FormTest;

{ TFormTests }

procedure TFormTests.ListViewTestCasesData(Sender: TObject; Item: TListItem);
begin
  if Item.Index < TestCases.Count then
  with TestCases[Item.Index] do begin
    Item.Caption := Name;
    Item.Data := TestCases[Item.Index];
    Item.SubItems.Add(ResultText[TestResult]);
  end;
end;

procedure TFormTests.ListViewTestCasesSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  UpdateInterface;
end;

procedure TFormTests.ReloadList;
begin
  if Assigned(TestCases) then
    ListViewTestCases.Items.Count := TestCases.Count
    else ListViewTestCases.Items.Count := 0;
  ListViewTestCases.Refresh;
end;

procedure TFormTests.SetTestCases(AValue: TTestCases);
begin
  if FTestCases = AValue then Exit;
  FTestCases := AValue;
  ReloadList;
  UpdateInterface;
end;

procedure TFormTests.UpdateInterface;
var
  Selected: Boolean;
  Passed: Integer;
  Failed: Integer;
  I: Integer;
begin
  Selected := Assigned(ListViewTestCases.Selected);
  ARun.Enabled := Selected;
  AShow.Enabled := Selected;
  ButtonRun.Enabled := Assigned(TestCases);

  Passed := 0;
  Failed := 0;
  if Assigned(TestCases) then
  for I := 0 to TestCases.Count - 1 do begin
    case TestCases[I].TestResult of
      trPassed: Inc(Passed);
      trFailed: Inc(Failed);
    end;
  end;
  LabelResult.Caption := SPassed + ' ' + IntToStr(Passed) + ', ' +
    SFailed + ' ' + IntToStr(Failed);
end;

procedure TFormTests.ButtonRunClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to TestCases.Count - 1 do
    TestCases[I].Run;
  ReloadList;
  UpdateInterface;
end;

procedure TFormTests.AShowExecute(Sender: TObject);
begin
  if Assigned(ListViewTestCases.Selected) then
  with TFormTest.Create(nil) do
  try
    MemoLog.Text := TTestCase(ListViewTestCases.Selected.Data).Log;
    ShowModal;
  finally
    Free;
  end;
end;

procedure TFormTests.ARunExecute(Sender: TObject);
begin
  if Assigned(ListViewTestCases.Selected) then begin
    TTestCase(ListViewTestCases.Selected.Data).Run;
    ReloadList;
    UpdateInterface;
  end;
end;

procedure TFormTests.FormShow(Sender: TObject);
begin
  ReloadList;
  UpdateInterface;
end;

end.