Mega Code Archive
Console Apps Advanced Information (Part I of )
<![CDATA[
Title: Console Apps -Advanced Information (Part I of ???)
Question: I and many other novice Delphi programmers are seeking advanced information on Console API which can be incorporated into standard Delphi console apps. IE: Colours, Window Titles, Cursor Positioning, Screen routines, Keystroke monitoring.
Would request if possible detailed information on how and why these techniques work.
Answer:
Handling the console window is definitly no a big thing. There are a lot of features that can be used but you have to find them. As a first take i wrote a simple class that encapsulates some of the functionality of the console window.
I know that this class treats only a part of the output behavior but it can give a first look at the funktionality.
The most important stuff is commented. You will find a lot of enhanced information in the WIN-API helpfiles.
I'll try to explain in extra articles
general input
console control handlers
capturing mouse events
---------- start of unit uConsoleClass ------
unit uConsoleClass;
interface
uses Windows;
type
TConsoleControl = Class
private
FhStdIn : THandle; // Handle to the standard input
FhStdOut : THandle; // Handle to the standard output
FhStdErr : THandle; // Handle to the standard error (Output)
FbConsoleAllocated : Boolean; // Creation Flag
FBgAttrib : Cardinal; // Currently set BackGround Attribs.
FFgAttrib : Cardinal; // Currently set ForeGround Attribs.
public
constructor Create;
(* Creates a new consolewindow, or connects the current window *)
destructor Destroy;override;
(* Cleanup of the class structures *)
(* Color properties:
The console window does not handle the colors like known form delphi
components. Each color will be created from a red,green,blue and a
intensity part. In fact the resulting colors are the same as the well
known 16 base colors (clwhite .. clBlack).
Black ist if all flags are false, white if all flag are true.
The following two functions will change the color for following writes *)
procedure SetForegroundColor(bRed,bGreen,bBlue,bIntensity : Boolean);
procedure SetBackgroundColor(bRed,bGreen,bBlue,bIntensity : Boolean);
(* Writing functions :
simple wrapper around WriteConsole
*)
procedure WriteText (const s : string);
procedure WriteTextLine( const s : string);
(* Change the Windowtitle of the command window. If the program has been
executed from a CMD-box the title change is only active while the
programs execution time *)
procedure SetWindowTitle (const sTitle : string);
(* some Cursor manipulation functions *)
procedure ShowCursor ( iSize : Integer);
procedure HideCursor;
procedure GetCursorPos( var x,y : integer);
procedure SetCursorTo(x,y : integer);
(* screen operations:
the screen ist the visible part of a cmd window. Behind the window there
is a screenbuffer. The screenbuffer may be larger than the visible
window *)
procedure ClearScreen;
function GetScreenLeft : integer;
function GetScreenTop : Integer;
function GetScreenHeight : integer;
function GetScreenWidth : integer;
(* screenbuffer operations *)
procedure ClearBuffer;
function GetBufferHeight : integer;
function GetBufferWidth : integer;
(* sample to read characters from then screenbuffer *)
procedure GetCharAtPos(x,y : Integer;var rCharInfo : Char);
end;
implementation
{ TConsoleControl }
procedure TConsoleControl.ClearBuffer;
var
SBInfo : TConsoleScreenBufferInfo;
ulWrittenChars : Cardinal;
TopLeft : TCoord;
begin
TopLeft.X := 0;
TopLeft.Y := 0;
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
FillConsoleOutputCharacter(FhStdOut,' ',
SBInfo.dwSize.X * SBInfo.dwSize.Y,
TopLeft,
ulWrittenChars);
FillConsoleOutputAttribute( FhStdOut,
FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_GREEN,
(SBInfo.srWindow.Right - SBInfo.srWindow.Left) *
(SBInfo.srWindow.Bottom - SBInfo.srWindow.Top),
TopLeft,
ulWrittenChars);
end;
procedure TConsoleControl.ClearScreen;
var
SBInfo : TConsoleScreenBufferInfo;
ulWrittenChars : Cardinal;
TopLeft : TCoord;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
TopLeft.X := SBInfo.srWindow.Left;
TopLeft.Y := SBInfo.srWindow.Top;
FillConsoleOutputCharacter(FhStdOut,' ',
(SBInfo.srWindow.Right - SBInfo.srWindow.Left) *
(SBInfo.srWindow.Bottom - SBInfo.srWindow.Top),
TopLeft,
ulWrittenChars);
FillConsoleOutputAttribute(FhStdOut,FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_GREEN,
(SBInfo.srWindow.Right - SBInfo.srWindow.Left) *
(SBInfo.srWindow.Bottom - SBInfo.srWindow.Top),
TopLeft,
ulWrittenChars);
end;
constructor TConsoleControl.Create;
begin
inherited Create;
// A process can be associated with only one console, so the AllocConsole
// function fails if the calling process already has a console.
FbConsoleAllocated := AllocConsole;
// initializing the needed handles
FhStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
FhStdErr := GetStdHandle(STD_ERROR_HANDLE);
FhStdIn := GetStdHandle(STD_INPUT_HANDLE);
end;
destructor TConsoleControl.Destroy;
begin
if FbConsoleAllocated then FreeConsole;
inherited;
end;
function TConsoleControl.GetBufferHeight: integer;
var
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
Result := SBInfo.dwSize.Y;
end;
function TConsoleControl.GetBufferWidth: integer;
var
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
Result := SBInfo.dwSize.X;
end;
procedure TConsoleControl.GetCharAtPos(x, y: Integer; var rCharInfo : Char);
var
CharInfo : array [0..10] of Char;
TopLeft : TCoord;
CharsRead : Cardinal;
begin
TopLeft.x := X;
TopLeft.Y := Y;
ReadConsoleOutputCharacter(FhStdOut,CharInfo,10,TopLeft,CharsRead);
rCharInfo := CharInfo[0];
end;
procedure TConsoleControl.GetCursorPos(var x, y: integer);
var
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
x := SBInfo.dwCursorPosition.X;
y := SBInfo.dwCursorPosition.Y;
end;
function TConsoleControl.GetScreenHeight: integer;
var
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
Result := SBInfo.srWindow.Bottom -SBInfo.srWindow.Top;
end;
function TConsoleControl.GetScreenLeft: integer;
var
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
Result := SBInfo.srWindow.Left;
end;
function TConsoleControl.GetScreenTop: Integer;
var
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
Result := SBInfo.srWindow.Top;
end;
function TConsoleControl.GetScreenWidth: integer;
var
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
Result := SBInfo.srWindow.Right - SBInfo.srWindow.Left;
end;
procedure TConsoleControl.HideCursor;
var
ConsoleCursorInfo : TConsoleCursorInfo;
begin
GetConsoleCursorInfo(FhStdOut,ConsoleCursorInfo);
if ConsoleCursorInfo.bVisible then begin
ConsoleCursorInfo.bVisible := False;
SetConsoleCursorInfo(FhStdOut,ConsoleCursorInfo);
end;
end;
procedure TConsoleControl.SetBackgroundColor(bRed, bGreen, bBlue,
bIntensity: Boolean);
begin
FBgAttrib := 0;
if bRed then FBgAttrib := FBgAttrib or BACKGROUND_RED;
if bGreen then FBgAttrib := FBgAttrib or BACKGROUND_GREEN;
if bBlue then FBgAttrib := FBgAttrib or BACKGROUND_BLUE;
if bIntensity then FBgAttrib := FBgAttrib or BACKGROUND_INTENSITY;
SetConsoleTextAttribute(FhStdOut,FBgAttrib or FFgAttrib);
end;
procedure TConsoleControl.SetCursorTo(x, y: integer);
var
Coords : TCoord;
SBInfo : TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(FhStdOut,SBInfo);
if x if y if x SbInfo.dwSize.X then Exit;
if y SbInfo.dwSize.Y then Exit;
Coords.X := x;
Coords.Y := y;
SetConsoleCursorPosition(FhStdOut,Coords);
end;
procedure TConsoleControl.SetForegroundColor(bRed, bGreen, bBlue,
bIntensity: Boolean);
begin
FFgAttrib := 0;
if bRed then FFgAttrib := FFgAttrib or FOREGROUND_RED;
if bGreen then FFgAttrib := FFgAttrib or FOREGROUND_GREEN;
if bBlue then FFgAttrib := FFgAttrib or FOREGROUND_BLUE;
if bIntensity then FFgAttrib := FFgAttrib or FOREGROUND_INTENSITY;
SetConsoleTextAttribute(FhStdOut,FBgAttrib or FFgAttrib);
end;
procedure TConsoleControl.SetWindowTitle(const sTitle: string);
begin
SetConsoleTitle(PChar(sTitle));
end;
procedure TConsoleControl.ShowCursor(iSize: Integer);
var
ConsoleCursorInfo : TConsoleCursorInfo;
begin
GetConsoleCursorInfo(FhStdOut,ConsoleCursorInfo);
if (not ConsoleCursorInfo.bVisible) or
( ConsoleCursorInfo.dwSize iSize ) then begin
ConsoleCursorInfo.bVisible := True;
ConsoleCursorInfo.dwSize := iSize;
SetConsoleCursorInfo(FhStdOut,ConsoleCursorInfo);
end;
end;
procedure TConsoleControl.WriteText(const s: string);
var
ulLength : Cardinal;
begin
WriteConsole(FhStdOut,PChar(s),Length(s),ulLength,NIL);
end;
procedure TConsoleControl.WriteTextLine(const s: string);
begin
WriteText(s+#13#10);
end;
end.
---------- end of unit uConsoleClass ------
----------- sample main that simulates a "starfield" ----------
program console;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows,
uConsoleClass in 'uConsoleClass.pas';
var
MyConsole : TConsoleControl;
procedure Stars ;
var
x,y,w,h : Integer;
x1,y1 : Integer;
CharInfo: Char;
i : integer;
begin
MyConsole.ClearScreen;
x := MyConsole.GetScreenLeft;
y := MyConsole.GetScreenTop;
h := MyConsole.GetScreenHeight div 4;
w := MyConsole.GetScreenWidth div 4;
for i := 1 to 15000 do begin
x1 := x+Random(w)*4;
y1 := y+Random(h)*4;
MyConsole.SetCursorTo(x1,y1);
MyConsole.GetCharAtPos(x1,y1,CharInfo);
MyConsole.SetForegroundColor(Bool(Random(2)),Bool(Random(2)),Bool(Random(2)),Bool(Random(2)));
if (CharInfo = ' ') or (CharInfo = #0) then begin
MyConsole.WriteText('.');
end
else if CharInfo = '.' then begin
MyConsole.WriteText('+');
end
else if CharInfo = '+' then begin
MyConsole.WriteText('*');
end
else if CharInfo = '*' then begin
MyConsole.WriteText(' ');
end;
sleep (5);
end;
end;
begin
MyConsole := TConsoleControl.Create;
Stars ;
MyConsole.Free;
end.
]]>