Console API

[Mad Compie]

Hi kids,

any 1 knows how to use the following Kernel API?

SetConsoleMode()
SetConsoleTextAttribute()
SetConsoleTitle()
...

Could this be the access to the DOS windows, as mentioned in some older forum requests?

Put the following in a Class Module.

Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleOutput As Long, dwMode As Long) As Long
Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Declare Function SetConsoleCtrlHandler Lib "kernel32" (ByVal HandlerRoutine As Long, ByVal Add As Long) As Long
Private Declare Function SetConsoleOutputCP Lib "kernel32" (ByVal wCodePageID As Long) As Long
Private Declare Function GetConsoleTitle Lib "kernel32" Alias "GetConsoleTitleA" (ByVal lpConsoleTitle As String, ByVal nSize As Long) As Long
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_ERROR_HANDLE = -12&
Private Const ENABLE_LINE_INPUT = &H2
Private Const ENABLE_ECHO_INPUT = &H4
Private Const ENABLE_MOUSE_INPUT = &H10
Private Const ENABLE_PROCESSED_INPUT = &H1
Private Const ENABLE_WINDOW_INPUT = &H8
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
Private hConsoleIn As Long
Private hConsoleOut As Long
Private hConsoleErr As Long
Private crColorB As Long
Private crColorF As Long
Private crBack As Long
Private crFore As Long
Private strMode As String
Private lpMode As Long
Private strTitle As String

Public Property Let Mode(ByVal strMode As String)
    If strMode = "Line Input" Then
End Property

Public Property Get Mode() As String
    Mode = mvarMode
End Property

Public Property Let Color(ByVal crColor As Long)
    SetConsoleTextAttribute hConsoleOut, crColor
End Property

Public Property Get Color() As Long
    Color = crColor
End Property

Public Property Let Title(ByVal strTitle As String)
    SetConsoleTitle strTitle
End Property

Public Property Get Title() As String
    Title = GetConsoleTitle(strTitle, Len(strTitle))
End Property

Public Sub TextOut(szOut As String, Optional tChar As Boolean)
    If tChar = True Then
        WriteConsole hConsoleOut, szOut, Len(szOut), vbNull, vbNull
    Else
        WriteConsole hConsoleOut, szOut & vbCrLf, Len(szOut), vbNull, vbNull
    End If
End Sub

Public Function ConsoleRead() As String
    Dim sUserInput As String * 256
    Call ReadConsole(hConsoleIn, sUserInput, Len(sUserInput), vbNull, vbNull)
    ConsoleRead = Left$(sUserInput, InStr(sUserInput, Chr$(0)) - 3)
End Function

Public Sub CreateWindow()
    AllocConsole
    hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
    hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
    hConsoleErr = GetStdHandle(STD_ERROR_HANDLE)
End Sub

Public Sub DestoryWindow(Optional bMode As Boolean)
    If bMode = False Then
        Call Me.ConsoleRead
        FreeConsole
    Else
        FreeConsole
    End If
End Sub

Put the following in a Module.

Sub main()
    
    Dim x As CConsole
    Set x = New CConsole
    Dim TEMP As String
    
    'Create the window
    x.CreateWindow
    x.Color = &H1 Or &H2 Or &H4 Or &H8
    'Set the title
    x.Title = "Hello"
    'Display text
    x.TextOut "Testing" & vbCrLf
    x.Color = &H2 Or &H4 Or &H8
    'Read text
    TEMP = x.ConsoleRead()
    'Destroy the window
    x.DestoryWindow
    
End Sub

This will create a Console window. Remember to set the startup object to Sub Main.

[Mad Compie]

Thanks Megatron, you really are a guru!

By the way, is there any higher level than "guru"?

Your welcome. I was actually in the process of writing a Console module, so your question had come up at the right time.

Yes there is a rank above guru. See this page for further reference.