试试这个吧
Console API
Microsoft provides a set of functions, which can be useful when you create
console applications.First we should know that there is at least two handles,
which is associated with console window. The one is for input and other is
for output. Two short functions below shows how to get those handles.
//-----------------------------------------
// Get handle to console input
//-----------------------------------------
function GetConInputHandle : THandle;
begin
Result := GetStdHandle(STD_INPUT_HANDLE)
end;
//-----------------------------------------
// Get handle to console output
//-----------------------------------------
function GetConOutputHandle : THandle;
begin
Result := GetStdHandle(STD_OUTPUT_HANDLE)
end;
Next, since there is no simple functions for positioning cursor, clear the
screen and show/hide cursor (as was in old days with CRT unit) we should to
implement one. Here it is:
//-----------------------------------------
// Position cursor to X, Y
//-----------------------------------------
procedure GotoXY(X, Y : Word);
begin
Coord.X := X
Coord.Y := Y;
SetConsoleCursorPosition(ConHandle, Coord);
end;
//-----------------------------------------
// Clear Screen - fill it with spaces
//-----------------------------------------
procedure Cls;
begin
Coord.X := 0
Coord.Y := 0;
FillConsoleOutputCharacter(ConHandle, ' ', MaxX*MaxY, Coord, NOAW);
GotoXY(0, 0);
end;
//--------------------------------------
// Show/Hide cursor
//--------------------------------------
procedure ShowCursor(Show : Bool);
begin
CCI.bVisible := Show;
SetConsoleCursorInfo(ConHandle, CCI);
end;
As you can see, in previous examples we've used some functions from Console
API: GetStdHandle, SetConsoleCursorPosition, FillConsoleOutputCharacter,
SetConsoleCursorInfo. For example, we use two variables: MaxX and MaxY,
which is of type WORD and holds the maximum horizontal and vertical size
of the screen:
//--------------------------------------
// Initialize global variables
//--------------------------------------
procedure Init;
begin
// Get console output handle
ConHandle := GetConOutputHandle;
// Get max window size
Coord := GetLargestConsoleWindowSize(ConHandle);
MaxX := Coord.X;
MaxY := Coord.Y;
end;
We can even make a "message loop" - for those who start Windows programming
with Delphi - this is a way to make Windows applications with plain API
calls - you need at least WinMain, message loop and window proc. Try this
some day and you'll love visual tools!
Here is the code for "message loop":
SetConsoleCtrlHandler(@ConProc, False);
Cls;
//
// "Message Loop"
//
Continue := True;
While Continue do
Begin
ReadConsoleInput(GetConInputHandle, IBuff, 1, IEvent);
Case IBuff.EventType of
KEY_EVENT : Begin
// Check for ESC Key and terminate program
If ((IBuff.KeyEvent.bKeyDown = True) AND
(IBuff.KeyEvent.wVirtualKeyCode = VK_ESCAPE)) Then
Continue := False;
End;
_MOUSE_EVENT : Begin
With IBuff.MouseEvent.dwMousePosition do
StatusLine(Format('%d, %d', [X, Y]));
End;
end;
End {While}
Also we can implelent an "event handler" and hook such events as Ctrl+C
and Ctrl+Break key combos:
//-----------------------------------------------------
// Console Event Handler
//-----------------------------------------------------
function ConProc(CtrlType : DWord) : Bool
stdcall
far;
var
S : String;
begin
case CtrlType of
CTRL_C_EVENT : S := 'CTRL_C_EVENT';
CTRL_BREAK_EVENT : S := 'CTRL_BREAK_EVENT';
CTRL_CLOSE_EVENT : S := 'CTRL_CLOSE_EVENT';
CTRL_LOGOFF_EVENT : S := 'CTRL_LOGOFF_EVENT';
CTRL_SHUTDOWN_EVENT : S := 'CTRL_SHUTDOWN_EVENT';
else
S := 'UNKNOWN_EVENT';
end;
MessageBox(0, PChar(S + ' detected'), 'Win32 Console', MB_OK);
Result := True;
end;
To show everything in action I've created a short demo program, which uses
routines mentioned below and some other techniques. Here is the full source
of it. Enjoy!
{
[]-----------------------------------------------------------------------[]
CON001 - Show various Console API functions. Checked with Win95
version 1.01
by Alex G. Fedorov, May-July, 1997
alexfedorov@geocities.com
09-Jul-97 some minor corrections (shown in comments)
[]-----------------------------------------------------------------------[]
}
program Con001;
{$APPTYPE CONSOLE}
uses Windows, SysUtils;
const
// Some common colors
YellowOnBlue = FOREGROUND_GREEN OR FOREGROUND_RED OR
FOREGROUND_INTENSITY OR BACKGROUND_BLUE;
WhiteOnBlue = FOREGROUND_BLUE OR FOREGROUND_GREEN OR
FOREGROUND_RED OR FOREGROUND_INTENSITY OR
BACKGROUND_BLUE;
RedOnWhite = FOREGROUND_RED OR FOREGROUND_INTENSITY OR
BACKGROUND_RED OR BACKGROUND_GREEN OR BACKGROUND_BLUE
OR BACKGROUND_INTENSITY;
WhiteOnRed = BACKGROUND_RED OR BACKGROUND_INTENSITY OR
FOREGROUND_RED OR FOREGROUND_GREEN OR FOREGROUND_BLUE
OR FOREGROUND_INTENSITY;
var
ConHandle : THandle
// Handle to console window
Coord : TCoord
// To store/set screen position
MaxX, MaxY : Word
// To store max window size
CCI : TConsoleCursorInfo;
NOAW : LongInt
// To store results of some functions
//-----------------------------------------
// Get handle to console input
//-----------------------------------------
function GetConInputHandle : THandle;
begin
Result := GetStdHandle(STD_INPUT_HANDLE)
end;
//-----------------------------------------
// Get handle to console output
//-----------------------------------------
function GetConOutputHandle : THandle;
begin
Result := GetStdHandle(STD_OUTPUT_HANDLE)
end;
//-----------------------------------------
// Position cursor to X, Y
//-----------------------------------------
procedure GotoXY(X, Y : Word);
begin
Coord.X := X
Coord.Y := Y;
SetConsoleCursorPosition(ConHandle, Coord);
end;
//-----------------------------------------
// Clear Screen - fill it with spaces
//-----------------------------------------
procedure Cls;
begin
Coord.X := 0
Coord.Y := 0;
FillConsoleOutputCharacter(ConHandle, ' ', MaxX*MaxY, Coord, NOAW);
GotoXY(0, 0);
end;
//--------------------------------------
// Show/Hide cursor
//--------------------------------------
procedure ShowCursor(Show : Bool);
begin
CCI.bVisible := Show;
SetConsoleCursorInfo(ConHandle, CCI);
end;
//--------------------------------------
// Initialize global variables
//--------------------------------------
procedure Init;
begin
// Get console output handle
ConHandle := GetConOutputHandle;
// Get max window size
Coord := GetLargestConsoleWindowSize(ConHandle);
MaxX := Coord.X;
MaxY := Coord.Y;
end;
//---------------------------------------
// Draw "status line"
//---------------------------------------
procedure StatusLine(S : String);
begin
Coord.X := 0
Coord.Y := 0;
WriteConsoleOutputCharacter(ConHandle, PChar(S), Length(S)+1, Coord, NOAW);
FillConsoleOutputAttribute (ConHandle, WhiteOnRed, Length(S), Coord, NOAW);
end;
//-----------------------------------------------------
// Console Event Handler
//-----------------------------------------------------
function ConProc(CtrlType : DWord) : Bool
stdcall
far;
var
S : String;
begin
case CtrlType of
CTRL_C_EVENT : S := 'CTRL_C_EVENT';
CTRL_BREAK_EVENT : S := 'CTRL_BREAK_EVENT';
CTRL_CLOSE_EVENT : S := 'CTRL_CLOSE_EVENT';
CTRL_LOGOFF_EVENT : S := 'CTRL_LOGOFF_EVENT';
CTRL_SHUTDOWN_EVENT : S := 'CTRL_SHUTDOWN_EVENT';
else
S := 'UNKNOWN_EVENT';
end;
MessageBox(0, PChar(S + ' detected'), 'Win32 Console', MB_OK);
Result := True;
end;
{
[]---------------------------------------------------------------[]
Main program - shows usage of some subroutines above and some
of console API functions
[]---------------------------------------------------------------[]
}
var
R : TSmallRect;
Color : Word;
OSVer : TOSVersionInfo;
IBuff : TInputRecord;
IEvent : DWord;
Continue : Bool;
begin
// Initialize global variables
Init;
// Position window on screen
With R do
{!! 1.01 !!}
begin
Left := 10
Top := 10
Right := 40
Bottom := 40;
end
{!! 1.01 !!}
SetConsoleWindowInfo(ConHandle, False, R);
// Set event handler
SetConsoleCtrlHandler(@ConProc, True);
// Check event handler
GenerateConsoleCtrlEvent(CTRL_C_EVENT, 0);
// Change window title
SetConsoleTitle('Console Demo');
// Hide cursor
ShowCursor(False);
Coord.X := 0
Coord.Y := 0;
// Set white text on blue
Color := WhiteOnBlue;
FillConsoleOutputAttribute(ConHandle, Color, MaxX*MaxY, Coord, NOAW);
// Console Code Page API is not supported under Win95 - only GetConsoleCP
Writeln('Console Code Page = ', GetConsoleCP);
Writeln('Max X=', MaxX,' Max Y=', MaxY);
Readln
// wait for user input
Cls
// clear screen
ShowCursor(True)
// show cursor
//
// Use some Win32API stuff
//
OSVer.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(OSVer);
With OSVer do
Begin
Writeln('dwMajorVersion = ', dwMajorVersion);
Writeln('dwMinorVersion = ', dwMinorVersion);
Writeln('dwBuildNumber = ', dwBuildNumber);
Writeln('dwPlatformID = ', dwPlatformID);
End;
//
Readln
// wait for user input
// Remove event handler
SetConsoleCtrlHandler(@ConProc, False);
Cls;
//
// "Message Loop"
//
Continue := True;
While Continue do
Begin
ReadConsoleInput(GetConInputHandle, IBuff, 1, IEvent);
Case IBuff.EventType of
KEY_EVENT : Begin
// Check for ESC Key and terminate program
If ((IBuff.KeyEvent.bKeyDown = True) AND
(IBuff.KeyEvent.wVirtualKeyCode = VK_ESCAPE)) Then
Continue := False;
End;
_MOUSE_EVENT : Begin
With IBuff.MouseEvent.dwMousePosition do
StatusLine(Format('%d, %d', [X, Y]));
End;
end;
End {While}
end.