source: tags/1.4.0/Forms/UFormTest.pas

unit UFormTest;

interface

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

type

  { TFormTest }

  TFormTest = class(TForm)
    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 FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(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;

var
  FormTest: TFormTest;


implementation

{$R *.lfm}

uses
  UCore, UFormTestCase, UVCard;

{ TFormTest }

procedure TFormTest.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[Result]);
  end;
end;

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

procedure TFormTest.ReloadList;
begin
  ListViewTestCases.Items.Count := TestCases.Count;
  ListViewTestCases.Refresh;
end;

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

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

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

procedure TFormTest.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  Core.PersistentForm1.Save(Self);
end;

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

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

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

procedure TFormTest.FormCreate(Sender: TObject);
begin
  Core.Translator.TranslateComponentRecursive(Self);
  Core.ThemeManager1.UseTheme(Self);
end;

procedure TFormTest.FormDestroy(Sender: TObject);
begin
end;

procedure TFormTest.FormShow(Sender: TObject);
begin
  Core.PersistentForm1.Load(Self);
  ReloadList;
  UpdateInterface;
end;

end.