DUnitMainForm.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:3k
源码类别:

Email服务器

开发平台:

Delphi

  1. { $Id: DUnitMainForm.pas,v 1.7 2006/07/19 02:45:54 judc Exp $ }
  2. {: DUnit: An XTreme testing framework for Delphi programs.
  3.    @author  The DUnit Group.
  4.    @version $Revision: 1.7 $ 2001/03/08 uberto
  5. }
  6. (*
  7.  * The contents of this file are subject to the Mozilla Public
  8.  * License Version 1.1 (the "License"); you may not use this file
  9.  * except in compliance with the License. You may obtain a copy of
  10.  * the License at http://www.mozilla.org/MPL/
  11.  *
  12.  * Software distributed under the License is distributed on an "AS
  13.  * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  14.  * implied. See the License for the specific language governing
  15.  * rights and limitations under the License.
  16.  *
  17.  * The Original Code is DUnit.
  18.  *
  19.  * The Initial Developers of the Original Code are Kent Beck, Erich Gamma,
  20.  * and Juancarlo A眅z.
  21.  * Portions created The Initial Developers are Copyright (C) 1999-2000.
  22.  * Portions created by The DUnit Group are Copyright (C) 2000-2003.
  23.  * All rights reserved.
  24.  *
  25.  * Contributor(s):
  26.  * Kent Beck <kentbeck@csi.com>
  27.  * Erich Gamma <Erich_Gamma@oti.com>
  28.  * Juanco A馿z <juanco@users.sourceforge.net>
  29.  * The DUnit group at SourceForge <http://dunit.sourceforge.net>
  30.  *
  31.  *)
  32. unit DUnitMainForm;
  33. interface
  34. uses
  35.   Messages,
  36.   Classes,
  37.   TestFramework,
  38.   GUITestRunner,
  39.   Graphics, Controls, Dialogs,
  40.   Menus, ActnList, ImgList, StdCtrls, ComCtrls, ToolWin,
  41.   ExtCtrls;
  42. const
  43.   rcs_id :string = '#(@)$Id: DUnitMainForm.pas,v 1.7 2006/07/19 02:45:54 judc Exp $';
  44. type
  45.   TDUnitForm = class(TGUITestRunner)
  46.     DUnitActions: TActionList;
  47.     LoadTestsAction: TAction;
  48.     UnloadTestscAction: TAction;
  49.     OpenTestsDialog: TOpenDialog;
  50.     LoadTests1: TMenuItem;
  51.     AboutAction: TAction;
  52.     Help1: TMenuItem;
  53.     AboutItem: TMenuItem;
  54.     procedure LoadTestsActionExecute(Sender: TObject);
  55.     procedure FormCreate(Sender: TObject);
  56.     procedure FormDestroy(Sender: TObject);
  57.     procedure AboutActionExecute(Sender: TObject);
  58.   protected
  59.     FRootSuite :ITestSuite;
  60.   public
  61.     property RootSuite :ITestSuite read FRootSuite;
  62.   end;
  63. var
  64.   DUnitForm: TDUnitForm;
  65. implementation
  66. uses
  67.   SysUtils,
  68.   Forms, 
  69.   DUnitAbout,
  70.   TestModules;
  71. {$R *.DFM}
  72. { TDUnitForm }
  73. procedure TDUnitForm.LoadTestsActionExecute(Sender: TObject);
  74. var
  75.   f  :Integer;
  76. begin
  77.   inherited;
  78.   with OpenTestsDialog do
  79.     if Execute then
  80.     begin
  81.       for f := 0 to Files.Count-1 do
  82.       begin
  83.         try
  84.           RootSuite.AddTest(LoadModuleTests(Files[f]));
  85.         except
  86.           on e :Exception do
  87.             MessageDlg(e.Message, mtError, [mbOK], 0);
  88.         end;
  89.       end;
  90.       inherited Suite := RootSuite;
  91.       // Set up the GUI nodes in the test nodes
  92.       SetupGUINodes;
  93.     end;
  94. end;
  95. procedure TDUnitForm.FormCreate(Sender: TObject);
  96. var
  97.   i  :Integer;
  98.   Suite :ITest;
  99. begin
  100.   inherited;
  101.   FRootSuite := TTestSuite.Create('All Tests');
  102.   for i := 1 to ParamCount do
  103.   begin
  104.     if not (ParamStr(i)[1] in ['/','-']) then
  105.     begin
  106.       Suite := LoadModuleTests(ParamStr(i));
  107.       if Suite <> nil then
  108.         RootSuite.AddTest(Suite);
  109.     end;
  110.   end;
  111.   inherited Suite := RootSuite;
  112. end;
  113. procedure TDUnitForm.FormDestroy(Sender: TObject);
  114. begin
  115.   inherited Suite := nil;
  116.   FRootSuite := nil;
  117.   inherited;
  118.   UnloadTestModules;
  119. end;
  120. procedure TDUnitForm.AboutActionExecute(Sender: TObject);
  121. begin
  122.   inherited;
  123.   TDUnitAboutBox.Create(nil).ShowModal;
  124. end;
  125. end.
  126.