Теперь к делу: многие думают, что консольные приложения для Win32 создать можно только в MSVC++, C++ Builder или Delphi. Как бы не так! Исследовав MSDN и API-Guide, ваш покорный слуга кой-чего накопал. Смотрите и учитесь:
- Код: Выделить всё
Private Const FOREGROUND_BLUE = &H1
Private Const FOREGROUND_GREEN = &H2
Private Const FOREGROUND_RED = &H4
Private Const BACKGROUND_BLUE = &H10
Private Const BACKGROUND_GREEN = &H20
Private Const BACKGROUND_RED = &H40
Private Const BACKGROUND_INTENSITY = &H80&
Private Const BACKGROUND_SEARCH = &H20&
Private Const FOREGROUND_INTENSITY = &H8&
Private Const FOREGROUND_SEARCH = (&H10&)
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 Const STD_OUTPUT_HANDLE = -11&
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_ERROR_HANDLE = -12&
Private Const INVALID_HANDLE_VALUE = -1&
Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal _
nStdHandle As Long) As Long
Private Declare Function WriteConsole Lib "kernel32" _
Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, _
lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, _
lpNumberOfCharsWritten As Long, lpReserved As Any) 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 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 hConsoleOut As Long, hConsoleIn As Long, _
hConsoleErr As Long
Private Sub Form_Load()
If AllocConsole() Then
hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
If hConsoleOut = INVALID_HANDLE_VALUE Then _
MsgBox "Невозможно получить модификатор вывода STDOUT"
hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
If hConsoleOut = INVALID_HANDLE_VALUE Then _
MsgBox "Невозможно получить модификатор ввода STDIN"
Else
MsgBox "Невозможно создать консоль!"
End If
'Установить надпись
SetConsoleTitle "Another Nice Example by hCORe <hCORe@mail.ru>"
'Вывести текст
ConsoleWriteLine "Welcome to Microsoft " + _
"Windowns (R) DOS (TM)!"
ReadData:
ConsoleWrite "Please enter your name: "
'Получить данные с консоли и вывести их
strln = ConsoleReadLine()
If Len(strln) = 0 Then
ConsoleWriteLine "INCORRECT INPUT! TRY AGAIN!"
GoTo ReadData
End If
ConsoleWriteLine "Hello, " + strln
ConsoleWritePlaceHolder
ConsoleWriteLine "This example was created by" + _
" hCORe <hCORe@mail.ru>"
ConsoleWriteLine "It is based on API-Guide examples"
ConsoleWritePlaceHolder
ConsoleWriteLine "Now I'll output some text in " + _
"color (16 variants):"
ConsoleWritePlaceHolder
'коричневый, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or _
BACKGROUND_INTENSITY
ConsoleWrite "MAROON "
'красный, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or _
FOREGROUND_INTENSITY Or BACKGROUND_INTENSITY
ConsoleWriteLine "RED"
'зеленый, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_GREEN Or _
BACKGROUND_INTENSITY
ConsoleWrite "GREEN "
'травяной (травить собрались ;), серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_GREEN Or _
FOREGROUND_INTENSITY Or BACKGROUND_INTENSITY
ConsoleWriteLine "LIME"
'темно-синий, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_BLUE Or _
BACKGROUND_INTENSITY
ConsoleWrite "NAVY "
'синий, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_BLUE Or _
BACKGROUND_INTENSITY Or FOREGROUND_INTENSITY
ConsoleWriteLine "BLUE"
'пурпурный, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or _
FOREGROUND_BLUE Or BACKGROUND_INTENSITY
ConsoleWrite "MAGENTA "
'розовый, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or _
FOREGROUND_BLUE Or FOREGROUND_INTENSITY Or _
BACKGROUND_INTENSITY
ConsoleWriteLine "PINK"
'голубой, стандартный фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_GREEN Or _
FOREGROUND_BLUE
ConsoleWrite "TEAL "
'светло-голубой, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_BLUE Or _
FOREGROUND_GREEN Or FOREGROUND_INTENSITY Or _
BACKGROUND_INTENSITY
ConsoleWriteLine "CYAN"
'оливковый, стандартный фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or _
FOREGROUND_GREEN
ConsoleWrite "OLIVE "
'желтый, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or _
FOREGROUND_GREEN Or FOREGROUND_INTENSITY Or _
BACKGROUND_INTENSITY
ConsoleWriteLine "YELLOW"
'темно-серый, стандартный фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_INTENSITY
ConsoleWrite "GRAY "
'белый, серый фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_BLUE Or _
FOREGROUND_GREEN Or FOREGROUND_INTENSITY Or _
FOREGROUND_RED Or BACKGROUND_INTENSITY
ConsoleWriteLine "WHITE"
'черный, белый фон
SetConsoleTextAttribute hConsoleOut, &H0 Or _
BACKGROUND_BLUE Or BACKGROUND_GREEN Or _
BACKGROUND_RED Or BACKGROUND_INTENSITY
ConsoleWrite "BLACK"
'восстановить нормальный текст и фон
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or _
FOREGROUND_GREEN Or FOREGROUND_BLUE
ConsoleWriteLine " STANDARD"
ConsoleWritePlaceHolder 2
ConsoleWriteLine "You can use Windows API and VB funcs!"
ConsoleWriteLine "Don't believe it? Let's try to" + _
" invoke Message Box..."
ConsoleWriteLine "Press any key!"
ConsoleReadLine
MessageBox 0, "Вам матерное сообщение" + _
" из консоли Windows!", "Хе-хе!", vbInformation
ConsoleWritePlaceHolder
ConsoleWriteLine "huh, that's all!"
ConsoleWritePlaceHolder
ConsoleWrite "Press any key to die."
'Ожидание нажатия клавиши
ConsoleReadLine
'Скрыть форму
Me.Hide
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Уничтожение консоли
CloseHandle hConsoleOut
CloseHandle hConsoleIn
FreeConsole
End Sub
'вывод данных + перевод строки
Sub ConsoleWriteLine(sInput As String)
ConsoleWrite sInput + vbCrLf
End Sub
'вывод данных
Sub ConsoleWrite(sInput As String)
Dim cWritten As Long
WriteConsole hConsoleOut, ByVal sInput, _
Len(sInput), cWritten, ByVal 0&
End Sub
'ввод данных
Function ConsoleReadLine() As String
Dim ZeroPos As Long
ConsoleReadLine = String(10, 0)
ReadConsole hConsoleIn, ConsoleReadLine, _
Len(ConsoleReadLine), vbNull, vbNull
ZeroPos = InStr(ConsoleReadLine, Chr$(0))
If ZeroPos > 0 Then ConsoleReadLine = _
Left$(ConsoleReadLine, ZeroPos - 3)
End Function
'вывести несколько пустых строк
Sub ConsoleWritePlaceHolder(Optional Count As Long)
Dim lC As Long
If IsMissing(Count) Then Count = 1
For lC = 1 To Count
DoEvents
ConsoleWriteLine ""
Next
End Sub
Этот пример в полном виде можно скачать по адресу:
http://amelso.narod.ru/testing/consoleapp.zip
