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 Const CONSOLE_FULLSCREEN = 1 ' fullscreen console
Private Const CONSOLE_FULLSCREEN_HARDWARE = 2 ' console owns the hardware

Private Type COORD
x As Integer
y As Integer
End Type

Private Type CONSOLE_FONT_INFO
nFont As Long
dwFontSize As COORD
End Type

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 GetConsoleDisplayMode Lib "kernel32" (lpModeFlags As Long) As Long
Private Declare Function GetConsoleFontSize Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal nFont As Long) As COORD
Private Declare Function GetCurrentConsoleFont Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal bMaximumWindow As Long, lpConsoleCurrentFont As CONSOLE_FONT_INFO) As Long
Private Declare Function GetConsoleProcessList Lib "kernel32" (lpdwProcessList As Long, ByVal dwProcessCount As Long) As Long
Private hConsoleOut As Long, hConsoleIn As Long, hConsoleErr As Long

Private Sub Form_Load()
'Create console
Dim CurrentFont As CONSOLE_FONT_INFO
Dim Ret As Long, ProcessList() As Long, Cnt As Long
'create the console
If AllocConsole() Then
hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
If hConsoleOut = INVALID_HANDLE_VALUE Then MsgBox "Unable to get STDOUT"
hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
If hConsoleOut = INVALID_HANDLE_VALUE Then MsgBox "Unable to get STDIN"
Else
MsgBox "Couldn't allocate console"
End If
'Get the current display mode
GetConsoleDisplayMode Ret
If Ret = CONSOLE_FULLSCREEN Then
MsgBox "Full-screen console. The console is in this mode as soon as the window is maximized. At this point, the transition to full-screen mode can still fail."
ElseIf Ret = CONSOLE_FULLSCREEN_HARDWARE Then
MsgBox "Full-screen console communicating directly with the video hardware. This mode is set after the console is in CONSOLE_FULLSCREEN mode to indicate that the transition to full-screen mode has completed."
End If
'Get the current console font
GetCurrentConsoleFont hConsoleOut, 0, CurrentFont
'Get the size of the current console font
CurrentFont.dwFontSize = GetConsoleFontSize(hConsoleOut, CurrentFont.nFont)
MsgBox "Current console font dimensions: " & CurrentFont.dwFontSize.x & "x" & CurrentFont.dwFontSize.y
'Create a buffer of Longs
ReDim ProcessList(0 To 9) As Long
'Get the list of process IDs associated with this console
Ret = GetConsoleProcessList(ProcessList(0), 10)
'If the buffer was not large enough...
If Ret > 9 Then
'...create a larger buffer
ReDim ProcessList(0 To Ret - 1) As Long
'and retry
Ret = GetConsoleProcessList(ProcessList(0), Ret + 1)
End If
'Show all associated processes in the debug window
For Cnt = 0 To Ret - 1
Debug.Print "Associated process: " + CStr(ProcessList(Cnt))
Next Cnt
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Delete console
CloseHandle hConsoleOut
CloseHandle hConsoleIn
FreeConsole
End Sub