162 lines
5.5 KiB
Text
162 lines
5.5 KiB
Text
VERSION 5.00
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
|
Begin VB.UserControl ctlTrace
|
|
ClientHeight = 3660
|
|
ClientLeft = 0
|
|
ClientTop = 0
|
|
ClientWidth = 6270
|
|
ScaleHeight = 3660
|
|
ScaleWidth = 6270
|
|
Begin MSComctlLib.ImageList imlIcons
|
|
Left = 4680
|
|
Top = 1080
|
|
_ExtentX = 1005
|
|
_ExtentY = 1005
|
|
BackColor = -2147483643
|
|
ImageWidth = 16
|
|
ImageHeight = 16
|
|
MaskColor = 12632256
|
|
_Version = 393216
|
|
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
|
|
NumListImages = 4
|
|
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
|
|
Picture = "ctlTrace.ctx":0000
|
|
Key = ""
|
|
EndProperty
|
|
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
|
|
Picture = "ctlTrace.ctx":0352
|
|
Key = ""
|
|
EndProperty
|
|
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
|
|
Picture = "ctlTrace.ctx":06A4
|
|
Key = ""
|
|
EndProperty
|
|
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
|
|
Picture = "ctlTrace.ctx":09F6
|
|
Key = ""
|
|
EndProperty
|
|
EndProperty
|
|
End
|
|
Begin MSComctlLib.TreeView tvTrace
|
|
Height = 3375
|
|
Left = 0
|
|
TabIndex = 0
|
|
Top = 0
|
|
Width = 4455
|
|
_ExtentX = 7858
|
|
_ExtentY = 5953
|
|
_Version = 393217
|
|
LabelEdit = 1
|
|
Style = 7
|
|
ImageList = "imlIcons"
|
|
Appearance = 1
|
|
End
|
|
End
|
|
Attribute VB_Name = "ctlTrace"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
' The UnitTrace control is used to trace the progress and status of the executing test cases.
|
|
' The control displays all trace messages associated with each executing test case and groups
|
|
' them in a tree. Test cases that execute successfully are identified with a green ball.
|
|
' Test cases that contain failures receive a yellow ball, and test cases with errors receive
|
|
' a red ball. The UnitTrace control is useful if detailed information on the running tests is
|
|
' required.
|
|
|
|
' Constants
|
|
Const g_lOKImage = 1
|
|
Const g_lFailureImage = 2
|
|
Const g_lErrorImage = 3
|
|
|
|
' Member variables
|
|
Private WithEvents m_oTestResult As TestResult
|
|
Attribute m_oTestResult.VB_VarHelpID = -1
|
|
Private m_oTestCase As ITestCase
|
|
Private m_objRoot As Node
|
|
|
|
' Class destructor
|
|
Private Sub Class_Terminate()
|
|
Set m_oTestResult = Nothing
|
|
Set m_oTestCase = Nothing
|
|
End Sub
|
|
|
|
' Set the TestResult to be used for capturing the results of running the tests.
|
|
Public Property Set TestResult(oTestResult As TestResult)
|
|
Set m_oTestResult = oTestResult
|
|
End Property
|
|
|
|
Private Sub UserControl_Resize()
|
|
tvTrace.Width = ScaleWidth
|
|
tvTrace.Height = ScaleHeight
|
|
End Sub
|
|
|
|
' Resets the UnitTrace control clearing the results of the last test run.
|
|
Public Sub Reset()
|
|
tvTrace.Nodes.Clear
|
|
|
|
Set m_objRoot = tvTrace.Nodes.Add(Text:="Tests", Image:=4)
|
|
m_objRoot.Expanded = True
|
|
End Sub
|
|
|
|
Private Sub m_oTestResult_AfterStartTest(oTestCase As ITestCase)
|
|
Dim oNode As Node
|
|
Set oNode = tvTrace.Nodes.Add(m_objRoot.Index, tvwChild, TestName(oTestCase), TestName(oTestCase), g_lOKImage)
|
|
tvTrace.Nodes.Add oNode.Index, tvwChild, , "Start Test Case", g_lOKImage
|
|
Set m_oTestCase = oTestCase
|
|
DoEvents
|
|
End Sub
|
|
|
|
Private Sub m_oTestResult_AfterEndTest()
|
|
Dim oNode As Node
|
|
Set oNode = tvTrace.Nodes(TestName(m_oTestCase))
|
|
tvTrace.Nodes.Add oNode.Index, tvwChild, , "End Test Case", g_lOKImage
|
|
|
|
' change top node icon depending on trace events
|
|
Dim oChildNode As Node, lImage As Long
|
|
Set oChildNode = oNode.Child
|
|
While Not (oChildNode Is Nothing)
|
|
If (CLng(oChildNode.Image) > lImage) Then
|
|
lImage = CLng(oChildNode.Image)
|
|
End If
|
|
Set oChildNode = oChildNode.Next
|
|
Wend
|
|
oNode.Image = lImage
|
|
DoEvents
|
|
End Sub
|
|
|
|
Private Sub m_oTestResult_AfterAddError(oError As TestError)
|
|
Dim oNode As Node
|
|
Set oNode = tvTrace.Nodes(TestName(oError.TestCase))
|
|
tvTrace.Nodes.Add oNode.Index, tvwChild, , "Error: " & GetErrorMsg(oError), g_lErrorImage
|
|
DoEvents
|
|
End Sub
|
|
|
|
Private Sub m_oTestResult_AfterAddFailure(oError As TestError)
|
|
Dim oNode As Node
|
|
Set oNode = tvTrace.Nodes(TestName(oError.TestCase))
|
|
tvTrace.Nodes.Add oNode.Index, tvwChild, , "Failure: " & oError.Description, g_lFailureImage
|
|
DoEvents
|
|
End Sub
|
|
|
|
Private Sub m_oTestResult_AfterAddTrace(sMessage As String)
|
|
Dim oNode As Node
|
|
Set oNode = tvTrace.Nodes(TestName(m_oTestCase))
|
|
tvTrace.Nodes.Add oNode.Index, tvwChild, , "Trace: " & sMessage, g_lOKImage
|
|
DoEvents
|
|
End Sub
|
|
|
|
Private Function GetErrorMsg(oError As TestError)
|
|
GetErrorMsg = oError.Source & " (" & Trim(oError.ErrNumber) & "): " & oError.Description
|
|
End Function
|
|
|
|
Private Function TestName(oTestCase As TestCase) As String
|
|
If (oTestCase Is Nothing) Then
|
|
TestName = ""
|
|
Else
|
|
TestName = TypeName(oTestCase.TestContainer) & "." & oTestCase.Name
|
|
End If
|
|
End Function
|
|
|