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

Email服务器

开发平台:

Delphi

  1. unit XPDUnitTestClass;
  2. {
  3.  $Source: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/XPDUnitTestClass.pas,v $
  4.  $Revision: 1.2 $
  5.  $Date: 2004/05/03 15:07:16 $
  6.  Last amended by $Author: pvspain $
  7.  $State: Exp $
  8.  TXPDUnitTestClassForm:
  9.  Copyright (c) 2003 by The Excellent Programming Company Pty Ltd
  10.  (Australia) (ABN 27 005 394 918). All rights reserved.
  11.  Contact Paul Spain via email: paul@xpro.com.au
  12.  This unit is free software; you can redistribute it and/or
  13.  modify it under the terms of the GNU Lesser General Public
  14.  License as published by the Free Software Foundation; either
  15.  version 2.1 of the License, or (at your option) any later version.
  16.  This unit is distributed in the hope that it will be useful,
  17.  but WITHOUT ANY WARRANTY; without even the implied warranty of
  18.  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19.  Lesser General Public License for more details.
  20.  You should have received a copy of the GNU Lesser General Public
  21.  License along with this unit; if not, the license can be viewed at:
  22.  http://www.gnu.org/copyleft/lesser.html
  23.  or write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  24.  Boston, MA  02111-1307  USA
  25.  }
  26. interface
  27. {$I JEDI.inc}
  28. uses
  29.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  30.   StdCtrls, Buttons, ExtCtrls, XPDUnitCommon, IniFiles, ComCtrls, ImgList,
  31.   XPTestedUnitParser, XPTestedUnitUtils, XPParserFilters;
  32. type
  33. ////////////////////////////////////////////////////////////////////////////
  34. //          TXPDUnitTestClassForm declaration
  35. ////////////////////////////////////////////////////////////////////////////
  36.   TXPDUnitTestClassForm = class(TForm)
  37.     GroupBox1: TGroupBox;
  38.     CancelTestClass: TBitBtn;
  39.     CreateTestClass: TBitBtn;
  40.     Label4: TLabel;
  41.     NodeImages: TImageList;
  42.     Classes: TPanel;
  43.     TestClassesView: TTreeView;
  44.     Splitter1: TSplitter;
  45.     TestedClassesView: TTreeView;
  46.     Label5: TLabel;
  47.     StateImages: TImageList;
  48.     procedure FormCreate(Sender: TObject);
  49.     procedure FormShow(Sender: TObject);
  50.     procedure CreateTestClassClick(Sender: TObject);
  51.     procedure FormDestroy(Sender: TObject);
  52.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  53.     procedure TestedClassesViewClick(Sender: TObject);
  54.   private
  55.     FParameters: IXPDUnitParameters;
  56.     FBehaviours: IXPDUnitBehaviours;
  57.     FPersistedValues: TIniFile;
  58.     FTestedModuleParser: IXPTestedUnitParser;
  59.     FTestedClassFilter: IXPTestedClassFilter;
  60.     FTestClassFilter: IXPTestClassFilter;
  61.     procedure ParseCurrentUnit;
  62.     procedure PopulateTestedClasses;
  63.     procedure UpdateTestClasses;
  64.     function GetTestedClasses: IXPParserTree;
  65.     function ClickedOnStateIcon(out ANode: TTreeNode): boolean;
  66.     procedure SetNodeState(const ANode: TTreeNode; const Enabled: boolean);
  67.     function TreeToParser(const ANode: TTreeNode): IXPParserNode;
  68.     procedure UpdateNodeImage(const ANode: TTreeNode);
  69.     procedure UpdateNodeState(const ANode: TTreeNode);
  70.     function CurrentViewCursorPos(out CursorPos: Integer): boolean;
  71.   public
  72.     property Parameters: IXPDUnitParameters
  73.       read FParameters;
  74.     property Behaviours: IXPDUnitBehaviours
  75.       read FBehaviours;
  76.     property TestClass: IXPParserTree
  77.       read GetTestedClasses;
  78.   end;
  79. ///////////////////////////////////////////////////////////////////////////////
  80. //  Unit entry point
  81. ///////////////////////////////////////////////////////////////////////////////
  82. function ShowXPDUnitTestClassForm(out ATestClass: IXPParserTree;
  83.   out AParameters: IXPDUnitParameters;
  84.   out ABehaviours: IXPDUnitBehaviours): boolean;
  85. implementation
  86. uses
  87. {$IFNDEF DELPHI6_UP}
  88.   XPInterfacedObject,   // IInterface
  89.   FileCtrl,             // SelectDirectory()
  90. {$ELSE}
  91.   QDialogs,             // SelectDirectory()
  92. {$ENDIF}
  93. {$IFDEF GUI_DEMO}
  94.   TestedUnitStream,
  95. {$ENDIF}
  96.   XP_OTAUtils,          // GetTopView(), EditPosToFilePos()
  97.   XPDUnitSetup,         // CreateXPDUnitBehaviours()
  98.   XPDUnitParameters,    // CreateXPDUnitParameters()
  99.   ToolsAPI;             // IOTAEditView;
  100. const CVSID: string = '$Header: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/XPDUnitTestClass.pas,v 1.2 2004/05/03 15:07:16 pvspain Exp $';
  101. {$R *.DFM}
  102. var
  103.   LForm: TXPDUnitTestClassForm;
  104. ///////////////////////////////////////////////////////////////////////////////
  105. //  Unit entry point
  106. ///////////////////////////////////////////////////////////////////////////////
  107. function ShowXPDUnitTestClassForm(out ATestClass: IXPParserTree;
  108.   out AParameters: IXPDUnitParameters;
  109.   out ABehaviours: IXPDUnitBehaviours): boolean;
  110. begin
  111.   // Singleton instance of form. Destroyed in finalization section
  112.   // Don't assign Owner as this form is part of a package, which can be removed
  113.   // from IDE at any time. We want to be in control of form destruction.
  114.   if not System.Assigned(LForm) then
  115.     LForm := TXPDUnitTestClassForm.Create(nil);
  116.   // Extract user's settings
  117.   ATestClass := LForm.TestClass;
  118.   AParameters := LForm.Parameters;
  119.   ABehaviours := LForm.Behaviours;
  120.   // Modal form
  121.   Result := (LForm.ShowModal = mrOK);
  122. end;
  123. ////////////////////////////////////////////////////////////////////////////
  124. //          TXPDUnitTestClassForm implementation
  125. ////////////////////////////////////////////////////////////////////////////
  126. procedure TXPDUnitTestClassForm.FormCreate(Sender: TObject);
  127. begin
  128.   FBehaviours := XPDUnitSetup.CreateXPDUnitBehaviours;
  129.   FParameters := XPDUnitParameters.CreateXPDUnitParameters;
  130.   FPersistedValues := TIniFile.Create(XPDUnitSetupFile);
  131.   FTestedModuleParser := XPTestedUnitParser.CreateXPTestedUnitParser;
  132.   FTestedClassFilter := XPParserFilters.CreateTestedClassFilter;
  133.   FTestClassFilter := XPParserFilters.CreateTestClassFilter;
  134. end;
  135. procedure TXPDUnitTestClassForm.FormDestroy(Sender: TObject);
  136. begin
  137.   FPersistedValues.Free;
  138.   // Clear local reference
  139.   LForm := nil;
  140. end;
  141. procedure TXPDUnitTestClassForm.FormClose(Sender: TObject;
  142.   var Action: TCloseAction);
  143. begin
  144.   Action := caFree;
  145.   // Persist our geometry
  146.   FPersistedValues.WriteInteger('TestClassForm', 'Width', Width);
  147.   FPersistedValues.WriteInteger('TestClassForm', 'Height', Height);
  148.   FPersistedValues.WriteInteger('TestClassForm', 'TestedClassesViewWidth',
  149.     TestedClassesView.Width);
  150. end;
  151. procedure TXPDUnitTestClassForm.FormShow(Sender: TObject);
  152. begin
  153.   // Reload our persisted data
  154.   Width := FPersistedValues.ReadInteger('TestClassForm', 'Width', Width);
  155.   Height := FPersistedValues.ReadInteger('TestClassForm', 'Height', Height);
  156.   TestedClassesView.Width := FPersistedValues.ReadInteger('TestClassForm',
  157.     'TestedClassesViewWidth', TestedClassesView.Width);
  158.   // Initialise fields for *current* invocation
  159.   FParameters.ClearValues;
  160.   FParameters.EvaluateValues;
  161.   // Setup tested class tree view
  162.   PopulateTestedClasses;
  163.   // Setup new test class tree view
  164.   UpdateTestClasses;
  165. end;
  166. function TXPDUnitTestClassForm.CurrentViewCursorPos(
  167.   out CursorPos: longint): boolean;
  168. var
  169.   EditView: IOTAEditView;
  170. begin
  171.   if XP_OTAUtils.GetTopView(EditView) then
  172.   begin
  173.     CursorPos := XP_OTAUtils.EditPosToFilePos(EditView, EditView.CursorPos);
  174.     Result := true;
  175.   end
  176.   else
  177.     Result := false;
  178. end;
  179. procedure TXPDUnitTestClassForm.PopulateTestedClasses;
  180. var
  181.   SectionNode: IXPParserNode;
  182.   ClassNode: IXPParserNode;
  183.   VisibilityNode: IXPParserNode;
  184.   MethodNode: IXPParserNode;
  185.   CurrentSection: TTreeNode;
  186.   CurrentClass: TTreeNode;
  187.   CursorPos: longint;
  188.   CurrentVisibility: TTreeNode;
  189. const
  190.   RootNode = nil;
  191.   procedure AssignImages(const Node: TTreeNode; const ImageIndex: integer);
  192.   begin
  193.     Node.ImageIndex := ImageIndex;
  194.     Node.SelectedIndex := ImageIndex;
  195.     UpdateNodeImage(Node);
  196.   end;
  197. begin
  198.   // Setup tested class tree view
  199.   ParseCurrentUnit;
  200.   if not CurrentViewCursorPos(CursorPos) then
  201.     exit;
  202.   FTestedClassFilter.SetInput(FTestedModuleParser.ParseTree, FBehaviours,
  203.     CursorPos);
  204.   FTestedClassFilter.Children.Start;
  205.   TestedClassesView.Items.BeginUpdate;
  206.   try
  207.     TestedClassesView.Items.Clear;
  208.     while FTestedClassFilter.Children.Next(SectionNode) do
  209.     begin
  210.       CurrentSection := TestedClassesView.Items.AddChildObject(RootNode,
  211.         SectionNode.Name, pointer(SectionNode));
  212.       AssignImages(CurrentSection, System.Ord(niSection));
  213.       SectionNode.Children.Start;
  214.       while SectionNode.Children.Next(ClassNode) do
  215.       begin
  216.         CurrentClass := TestedClassesView.Items.AddChildObject(CurrentSection,
  217.           ClassNode.Name, pointer(ClassNode));
  218.         AssignImages(CurrentClass, System.Ord(niClass));
  219.         ClassNode.Children.Start;
  220.         while ClassNode.Children.Next(VisibilityNode) do
  221.         begin
  222.           CurrentVisibility := TestedClassesView.Items.AddChildObject(
  223.             CurrentClass, VisibilityNode.Name, pointer(VisibilityNode));
  224.           AssignImages(CurrentVisibility, System.Ord(niVisibility));
  225.           VisibilityNode.Children.Start;
  226.           while VisibilityNode.Children.Next(MethodNode) do
  227.             AssignImages(TestedClassesView.Items.AddChildObject(
  228.               CurrentVisibility, MethodNode.Name, pointer(MethodNode)),
  229.               System.Ord(niMethod));
  230.         end;
  231.       end;
  232.     end;
  233.   finally
  234.     TestedClassesView.Items.EndUpdate;
  235.   end;
  236.   TestedClassesView.FullExpand;
  237. end;
  238. procedure TXPDUnitTestClassForm.UpdateTestClasses;
  239. var
  240.   SectionNode: IXPParserNode;
  241.   ClassNode: IXPParserNode;
  242.   VisibilityNode: IXPParserNode;
  243.   MethodNode: IXPParserNode;
  244.   CurrentClass: TTreeNode;
  245.   CurrentVisibility: TTreeNode;
  246. const
  247.   RootNode = nil;
  248.   procedure AssignImages(const Node: TTreeNode; const ImageIndex: integer);
  249.   begin
  250.     Node.ImageIndex := ImageIndex;
  251.     Node.SelectedIndex := ImageIndex;
  252.   end;
  253. begin
  254.   FTestClassFilter.SetInput(FTestedClassFilter);
  255.   FTestClassFilter.Children.Start;
  256.   TestClassesView.Items.BeginUpdate;
  257.   try
  258.     TestClassesView.Items.Clear;
  259.     while FTestClassFilter.Children.Next(SectionNode) do
  260.     begin
  261.       SectionNode.Children.Start;
  262.       while SectionNode.Children.Next(ClassNode) do
  263.       begin
  264.         // Build treeview without a Section as the root node
  265.         CurrentClass := TestClassesView.Items.AddChildObject(RootNode,
  266.           FParameters.TestClassName(ClassNode.Name), pointer(ClassNode));
  267.         AssignImages(CurrentClass, System.Ord(niClass));
  268.         ClassNode.Children.Start;
  269.         while ClassNode.Children.Next(VisibilityNode) do
  270.         begin
  271.           CurrentVisibility := TestClassesView.Items.AddChildObject(
  272.             CurrentClass, VisibilityNode.Name, nil);
  273.           AssignImages(CurrentVisibility, System.Ord(niVisibility));
  274.           VisibilityNode.Children.Start;
  275.           while VisibilityNode.Children.Next(MethodNode) do
  276.             AssignImages(TestClassesView.Items.AddChildObject(
  277.               CurrentVisibility, FParameters.TestMethodName(MethodNode.Name),
  278.               pointer(MethodNode)), System.Ord(niMethod));
  279.         end;
  280.       end;
  281.     end;
  282.     TestClassesView.FullExpand;
  283.   finally
  284.     TestClassesView.Items.EndUpdate;
  285.   end;
  286. end;
  287. procedure TXPDUnitTestClassForm.ParseCurrentUnit;
  288. begin
  289. {$IFDEF GUI_DEMO}
  290.   FTestedModuleParser.Parse(TestedUnitStream.CreateTestedUnitStream);
  291. {$ELSE}
  292.   // Parse current IDE unit
  293.   FTestedModuleParser.Parse;
  294. {$ENDIF}
  295. end;
  296. procedure TXPDUnitTestClassForm.CreateTestClassClick(Sender: TObject);
  297. begin
  298.   // Close form now
  299.   // * parameters and tested classes handed on via public properties
  300.   // * ModalResult is mrOK
  301. end;
  302. function TXPDUnitTestClassForm.GetTestedClasses: IXPParserTree;
  303. begin
  304.   Result := FTestClassFilter;
  305. end;
  306. procedure TXPDUnitTestClassForm.TestedClassesViewClick(Sender: TObject);
  307. var
  308.   Node: TTreeNode;
  309. begin
  310.   if ClickedOnStateIcon(Node) then
  311.   begin
  312.     SetNodeState(Node, not TreeToParser(Node).Enabled);
  313.     UpdateTestClasses;
  314.   end;
  315. end;
  316. function TXPDUnitTestClassForm.ClickedOnStateIcon(
  317.   out ANode: TTreeNode): boolean;
  318. var
  319.   HitInfo: THitTests;
  320.   Pos: TPoint;
  321. begin
  322.   Windows.GetCursorPos(Pos);
  323.   Pos := TestedClassesView.ScreenToClient(Pos);
  324.   HitInfo := TestedClassesView.GetHitTestInfoAt(Pos.X, Pos.Y);
  325.   ANode := TestedClassesView.GetNodeAt(Pos.X, Pos.Y);
  326.   Result := System.Assigned(ANode) and (HtOnStateIcon in HitInfo);
  327. end;
  328. procedure TXPDUnitTestClassForm.SetNodeState(const ANode: TTreeNode;
  329.   const Enabled :boolean);
  330. var
  331.   MostSeniorChanged: TTreeNode;
  332.   Node: TTreeNode;
  333. begin
  334.   System.Assert(System.Assigned(ANode));
  335.   Node := ANode;
  336.   TreeToParser(Node).Enabled := Enabled;
  337.   MostSeniorChanged := Node;
  338.   // update ancestors if enabling
  339.   if Enabled then
  340.   begin
  341.     while System.Assigned(Node.Parent) do
  342.     begin
  343.       Node := Node.Parent;
  344.       if not TreeToParser(Node).Enabled then
  345.       begin // changed
  346.         TreeToParser(Node).Enabled := true;
  347.         MostSeniorChanged := Node;
  348.       end;
  349.     end;
  350.   end;
  351.   TestedClassesView.Items.BeginUpdate;
  352.   try
  353.     UpdateNodeState(MostSeniorChanged);
  354.   finally
  355.     TestedClassesView.Items.EndUpdate;
  356.   end;
  357. end;
  358. function TXPDUnitTestClassForm.TreeToParser(
  359.   const ANode: TTreeNode): IXPParserNode;
  360. begin
  361.   System.Assert(System.Assigned(ANode)
  362.     and SysUtils.Supports(IInterface(ANode.Data), IXPParserNode, Result));
  363. end;
  364. procedure TXPDUnitTestClassForm.UpdateNodeImage(const ANode: TTreeNode);
  365. var
  366.   ParserNode: IXPParserNode;
  367.   Node: TTreeNode;
  368. begin
  369.   Node := ANode;
  370.   ParserNode := TreeToParser(Node);
  371.   if not ParserNode.Enabled then
  372.     Node.StateIndex := System.Ord(siDisabled)
  373.   else if (Node.Parent <> nil)
  374.     and (Node.Parent.StateIndex <= System.Ord(siParentDisabled)) then
  375.     Node.StateIndex := System.Ord(siParentDisabled)
  376.   else
  377.     Node.StateIndex := System.Ord(siEnabled);
  378. end;
  379. procedure TXPDUnitTestClassForm.UpdateNodeState(const ANode: TTreeNode);
  380. var
  381.   Node: TTreeNode;
  382. begin
  383.   System.Assert(System.Assigned(ANode));
  384.   Node := ANode;
  385.   UpdateNodeImage(Node);
  386.   if Node.HasChildren then
  387.   begin
  388.     Node := Node.GetFirstChild;
  389.     while System.Assigned(Node) do
  390.     begin
  391.       UpdateNodeState(Node);
  392.       Node := Node.getNextSibling;
  393.     end;
  394.   end;
  395. end;
  396. initialization
  397. finalization
  398.   LForm.Free;
  399. end.