rabit/r3/Module_Console.bas

Attribute VB_Name = "Module_Console"
Option Explicit

Public Const Const_strConsoleTextLine As String = "[c08]------------------------------------------------------[c07][brk]"
Public Const Const_strConsoleTextLineIndent As String = "[c08]-[c07] "
Public Const Const_strConsoleTextOK As String = "[c02]ok.[c07][brk]"
Public Const Const_strConsoleTextFail As String = "[c12]failed.[c07][brk]"

Public Const Const_strConsoleBlockTitlePre As String = Const_strConsoleTextLineIndent + "[c15]"
Public Const Const_strConsoleBlockTitlePost As String = "[c07][brk][brk]"
'

Public Sub ConPrint(sttpRectText1 As String)

Static iLine As Integer

Dim iLeftPos As Integer
Dim iPos As Integer
Dim iRightPos As Integer
Dim iTextLength As Integer

Dim strCommand As String

    With Form_Start.Text_Console
    
        .SelStart = Len(.Text)
        
        sttpRectText1 = UCase(sttpRectText1)
        
        iPos = 1
        iRightPos = 0
        iTextLength = Len(sttpRectText1)
    
        While iPos < iTextLength
            
            iLeftPos = InStr(iPos, sttpRectText1, "[")
            
            If iLeftPos > 0 Then
        
                iRightPos = InStr(iPos, sttpRectText1, "]")
            
                If iRightPos = iLeftPos + 4 Then
        
                    .SelText = Mid(sttpRectText1, iPos, iLeftPos - iPos)
                    
                    strCommand = Mid(sttpRectText1, iLeftPos + 1, iRightPos - iLeftPos - 1)
                    iPos = iRightPos + 1
                    
                    Select Case LCase(strCommand)
                    
                        Case "brk":
                    
                            .SelText = vbCrLf
                    
                        Case "c00", "c01", "c02", "c03", "c04", "c05", "c06", "c07", "c08", "c09", "c10", "c11", "c12", "c13", "c14", "c15":
                                                    
                            .SelColor = QBColor(Val(Right(strCommand, 2)))
                    
                    End Select
                    
                Else
                
                    If iRightPos < 1 Then
                    
                        .SelText = Mid(sttpRectText1, iPos, iLeftPos - iPos + 1)
                        iPos = iLeftPos + 1
                        iRightPos = iLeftPos
                        
                    Else
                    
                        .SelText = Mid(sttpRectText1, iPos, iRightPos - iPos + 1)
                        iPos = iRightPos + 1
                
                    End If
                
                End If
        
            Else
            
                .SelText = Mid(sttpRectText1, iRightPos + 1)
                iPos = iTextLength
                
            End If
        
        Wend

    End With

    DoEvents

End Sub
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