/[cvs]/rabit/r3/Module_Console.bas
ViewVC logotype

Contents of /rabit/r3/Module_Console.bas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Tue Mar 12 21:29:05 2002 UTC (22 years ago) by cvsrabit
Branch: NFO, MAIN
CVS Tags: v034a, HEAD
Changes since 1.1: +0 -0 lines
Initial project import

1 Attribute VB_Name = "Module_Console"
2 Option Explicit
3
4 Public Const Const_strConsoleTextLine As String = "[c08]------------------------------------------------------[c07][brk]"
5 Public Const Const_strConsoleTextLineIndent As String = "[c08]-[c07] "
6 Public Const Const_strConsoleTextOK As String = "[c02]ok.[c07][brk]"
7 Public Const Const_strConsoleTextFail As String = "[c12]failed.[c07][brk]"
8
9 Public Const Const_strConsoleBlockTitlePre As String = Const_strConsoleTextLineIndent + "[c15]"
10 Public Const Const_strConsoleBlockTitlePost As String = "[c07][brk][brk]"
11 '
12
13 Public Sub ConPrint(sttpRectText1 As String)
14
15 Static iLine As Integer
16
17 Dim iLeftPos As Integer
18 Dim iPos As Integer
19 Dim iRightPos As Integer
20 Dim iTextLength As Integer
21
22 Dim strCommand As String
23
24 With Form_Start.Text_Console
25
26 .SelStart = Len(.Text)
27
28 sttpRectText1 = UCase(sttpRectText1)
29
30 iPos = 1
31 iRightPos = 0
32 iTextLength = Len(sttpRectText1)
33
34 While iPos < iTextLength
35
36 iLeftPos = InStr(iPos, sttpRectText1, "[")
37
38 If iLeftPos > 0 Then
39
40 iRightPos = InStr(iPos, sttpRectText1, "]")
41
42 If iRightPos = iLeftPos + 4 Then
43
44 .SelText = Mid(sttpRectText1, iPos, iLeftPos - iPos)
45
46 strCommand = Mid(sttpRectText1, iLeftPos + 1, iRightPos - iLeftPos - 1)
47 iPos = iRightPos + 1
48
49 Select Case LCase(strCommand)
50
51 Case "brk":
52
53 .SelText = vbCrLf
54
55 Case "c00", "c01", "c02", "c03", "c04", "c05", "c06", "c07", "c08", "c09", "c10", "c11", "c12", "c13", "c14", "c15":
56
57 .SelColor = QBColor(Val(Right(strCommand, 2)))
58
59 End Select
60
61 Else
62
63 If iRightPos < 1 Then
64
65 .SelText = Mid(sttpRectText1, iPos, iLeftPos - iPos + 1)
66 iPos = iLeftPos + 1
67 iRightPos = iLeftPos
68
69 Else
70
71 .SelText = Mid(sttpRectText1, iPos, iRightPos - iPos + 1)
72 iPos = iRightPos + 1
73
74 End If
75
76 End If
77
78 Else
79
80 .SelText = Mid(sttpRectText1, iRightPos + 1)
81 iPos = iTextLength
82
83 End If
84
85 Wend
86
87 End With
88
89 DoEvents
90
91 End Sub

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed