Создание консольных приложений

Ответы на вопросы, чаще всего задаваемые в форумах VBStreets. Для тех, кому лень искать.
hCORe
VB - Экстремал
VB - Экстремал
Аватара пользователя
 
Сообщения: 2332
Зарегистрирован: 22.02.2003 (Сб) 15:21
Откуда: parent directory

Создание консольных приложений

Сообщение hCORe » 07.06.2004 (Пн) 16:55

Итак, продолжая эпопею Win32 API, напоминаю бдительным товарищам о необходимости соблюдения конвенций Женевского мирного договора программистов! Во как!

Теперь к делу: многие думают, что консольные приложения для 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
Моду создают модоки, а распространяют модозвоны.

hCORe
VB - Экстремал
VB - Экстремал
Аватара пользователя
 
Сообщения: 2332
Зарегистрирован: 22.02.2003 (Сб) 15:21
Откуда: parent directory

Сообщение hCORe » 07.06.2004 (Пн) 16:57

Преимущества такого подхода - меньше графических ресурсов системы задействуется, а все функции VB и Win32 API - как на ладони 8)
Моду создают модоки, а распространяют модозвоны.


Вернуться в Популярные вопросы

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10

    TopList