VB is normally for creating apps with GUI. But what can you do if you want to make a console mode application? You write it yourself? No! Just paste this code into a module and that's all. See the comments for details.
'Console control module by Adam Visegradi
'Don't redistribute!!!
'With this module you can easily create console mode applications using the 5
'easy-to-use routines:
' InitConsole
' WriteToConsole
' WriteLnToConsole
' ReadFromConsole
' CloseConsole
'
' IMPORTANT NOTES!
' -Do not forget to close the console before you exit: if you run the app
' from the IDE, forget to close the console form the app and close it manually,
' the system will close the IDE too!
' -Your application can has only one console at the same time
' -Don't forget: The system runs the console, not you. So everything you do is a request, which can be denied.
'
'For TP, QBasic, etc. users:
'Anybody could tell me, where blinking gone? (e.g.:Blinking blue => Dark blue, even in full screen mode)
'The code:
'API declarations:
'Console initialization
Private Declare Function AllocConsole Lib "kernel32" () As Long
'Set's the console's title
Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
'Closing the console
Private Declare Function FreeConsole Lib "kernel32" () As Long
'Getting the console's handle
'NOTE: nStdHandle: the handle type(later), not the buffer for the handle.
' The function returns the handle
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
'Console output
Private Declare Function WriteC Lib "kernel32" Alias "WriteConsoleA" _
(ByVal hConsoleOutput As Long, _
ByVal lpBuffer As Any, _
ByVal nNumberOfCharsToWrite As Long, _
lpNumberOfCharsWritten As Long, _
lpReserved As Any) As Long
'Console input
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
'Text attribute setting
Private Declare Function SetConsoleTextAttribute Lib "kernel32" _
(ByVal hConsoleOutput As Long, _
ByVal wAttributes As Long) As Long
'Console mode sttings(later)
Private Declare Function SetConsoleMode Lib "kernel32" _
(ByVal hConsoleOutput As Long, _
dwMode As Long) As Long
'Handle mode constants for SetConsoleMode and GetStdHandle
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_ERROR_HANDLE = -12&
'Console input mode constants for SetConsoleMode(I don't know which of what, somebody please tell me.)
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
'Console output mode constants for SetConsoleMode
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
'Handle variables
Private hIn As Long
Private hOut As Long
'Forecolor constants collected into an enumarated type for a simplier use
Public Enum ConsoleForeGroundAttributes
fBlack = &H0
fDBlue = &H1
fDGreen = &H2
fDCyan = &H3
fDRed = &H4
fDMagenta = &H5
fDYellow = &H6
fGrey = &H7
fDGrey = &H8
fBlue = &H1 Or &H8
fGreen = &H2 Or &H8
fCyan = &H3 Or &H8
fRed = &H4 Or &H8
fMagenta = &H5 Or &H8
fYellow = &H6 Or &H8
fWhite = &H7 Or &H8
End Enum
'Backcolor constants
Public Enum ConsoleBackGroundAttributes
bBlack = &H0
bDBlue = &H10
bDGreen = &H20
bDCyan = &H30
bDRed = &H40
bDMagenta = &H50
bDYellow = &H60
bGrey = &H70
bDGrey = &H80
bBlue = &H10 Or &H80
bGreen = &H20 Or &H80
bCyan = &H30 Or &H80
bRed = &H40 Or &H80
bMagenta = &H50 Or &H80
bYellow = &H60 Or &H80
bWhite = &H70 Or &H80
End Enum
'Writes a string to the console
Public Sub WriteToConsole(StringToWrite As String, Optional ForeGroundAttributes As ConsoleForeGroundAttributes = fGrey, Optional BackGroundAttributes As ConsoleBackGroundAttributes = bBlack)
'Sets the console's text attributes for the following output
SetConsoleTextAttribute hOut, ForeGroundAttributes Or BackGroundAttributes
'Writes out the string
WriteC hOut, StringToWrite, Len(StringToWrite), vbNull, vbNull
End Sub
'Writes a string with a vbCrLf to the console
Public Sub WriteLnToConsole(StringToWrite As String, Optional ForeGroundAttributes As ConsoleForeGroundAttributes = fGrey, Optional BackGroundAttributes As ConsoleBackGroundAttributes = bBlack)
'The same as WriteToConsole
SetConsoleTextAttribute hOut, ForeGroundAttributes Or BackGroundAttributes
WriteC hOut, StringToWrite + vbCrLf, Len(StringToWrite + vbCrLf), vbNull, vbNull
End Sub
'Reads a (!)line from the console(The app hangs on, until the user presses enter. Then the routine returns the string the user entered
'and writes a vbCrLf to the console. The vbCrLf is written out by the system so it cannot be ignored.
Public Function ReadFromConsole() As String
'Creates a buffer. (The buffer must be no longer than 256 bytes.)
Dim S As String * 256
'Reads the user input to the buffer
Call ReadConsole(hIn, S, Len(S), vbNull, vbNull)
'Trim the end of the buffer from the Chr(0) and sets the value of the function
ReadFromConsole = Left$(S, InStr(S, vbNullChar) - 3)
End Function
'Inits the console. If you don't enter a title, the system will give your app's name for the console window.
Public Function InitConsole(Optional Title As String = "") As Boolean
'The function returns True only if there is no error occoured
'Create console
If AllocConsole = 0 Then
InitConsole = False
Else
'Gets the input-handle of the console
hIn = GetStdHandle(STD_INPUT_HANDLE)
'Sets the mode of the console.
If SetConsoleMode(hIn, ENABLE_ECHO_INPUT) <> 0 Then
InitConsole = False
Else
'Gets the output-handle of the console
hOut = GetStdHandle(STD_OUTPUT_HANDLE)
'If the Title is not "" then sets the console's title
If Title <> "" Then
If SetConsoleTitle(Title) = 0 Then
InitConsole = False
Else
InitConsole = True
End If
Else
InitConsole = True
End If
End If
End If
End Function
'Closes the console
Public Function CloseConsole() As Boolean
If FreeConsole = 0 Then: CloseConsole = False: Else: CloseConsole = True
End Function
'So that's all, if you don't know something (or you know something that I don't know),
'ask (or tell) me in the VBWeb's forum(vAdam), or in E-Mail: [email protected] ("c"+Zero+"[email protected]")
'
'Have a nice day (and night ;-), and don't drink applejuice unless you wash it!
Comments