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	cvsrabit	1.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