Emulating a console on TForms

Problem/Question/Abstract:

Implementing a console within a windows application without resorting to an external console application.

Answer:

Consoles are usefull for giving a user access to an application's more complex features without cluttering the interface. If you've ever coded a windowed console, you realise the "messiness" of the code involved. This class allows you to forget about all input/output routines with a few lines of code. The console supports most of the input/output routines available in console (dos) applications such as WriteLn, ReadLn, ReadKey, GotoXY and many, many more.

Using it is simple, Create a TConsole variable and pass it the form on witch you want to display the console. The console's default colors will be the same as the form's color and font.color.

Simply place a "with Console do begin end;" block and put all your console application code in it. I've placed an example with a string parser at the end of the article.

There are also some great features:

cutomizable width/height(in characters), borders
easily load and copy displays with CopyContext and SetContext
user can copy text by dragging the mouse over it like mIRC
user can paste into a read or readln input with CTRL+V
form's properties are adjusted on Create and restored on Free
form's event handler are still processed

and there are some quirks:

you cannot create a TConsole on it's form's OnCreate event
if the form has visible components they will hide the console
you cannot close the form while a read/readln is in progress
read/readln only allow up to 250 chars to avoid glitches
extended characters are not supported for input
text copying with the mouse provides no visual feedback


NOTES

GotoXY,GotoEndOfLine,GetX,GetY,GetLastLine,GetChar,GetText(y:byte), and ClearLn all refer to x,y coordinates starting at position 1,1 (like in console applications)
TConsole has not been tested with other fonts. If you want to tinker with different fonts you should set all properties of Canvas.Font (in the Create procedure) and constants CONSOLE_FONT_HEIGHT, CONSOLE_FONT_WIDTH accordingly.
I was unable to code a suitable visual feedback such as highlighting for the auto-text-copying feature. The main problem is the TForm.OnMouseMove event is only called once. Running a loop through the OnMouseDown even did not work either. I could have implemented the loop in a seperate thread but that seems like overkill. Besides, I want all TConsole functions suspended until the mouse is released so the user isn't fumbled by the application changing the displayed text. If anyone knows how mIRC did it, please email me and I'll add it in.

Here is unit Console.pas
(please forgive the broken lines)

unit Console;

interface
uses Forms, Graphics, SysUtils, ExtCtrls, Classes, Controls, ClipBrd;

const
  CONSOLE_WIDTH = 70;
  CONSOLE_HEIGHT = 25;
  CONSOLE_CARET_SPEED = 500;
  CONSOLE_OFFSET_X = 5;
  CONSOLE_OFFSET_Y = 5;
  CONSOLE_FONT_HEIGHT = 14;
  CONSOLE_FONT_WIDTH = 7;

type
  TConsoleContext = record
    Name: string;
    Lines: array[0..CONSOLE_HEIGHT - 1] of string[CONSOLE_WIDTH];
    PosX, PosY, CaretPosX, CaretPosY: word;
    LastKey: char;
    ShiftKeys: TShiftState;
    KeyPressed: boolean;
    ShowCaret: boolean;
  end;
  PConsoleContext = ^TConsoleContext;

  TConsole = class
    constructor Create(AForm: TForm);
    destructor Destroy; override;
  private
    Context: PConsoleContext;
    Caret: TTimer;
    Canvas: TCanvas;
    Form: TForm;
    Background, Forground: TColor;
    StartDragX, StartDragY: word;
    PreviousOnPaint: TNotifyEvent;
    PreviousOnKeyPress: TKeyPressEvent;
    PreviousOnMouseDown, PreviousOnMouseUp: TMouseEvent;
    PreviousWidth, PreviousHeight: word;
    procedure PaintLine(y: byte);
    procedure Refresh(Sender: TObject);
    procedure EraseCaret;
    procedure PaintCaret;
    procedure ToggleCaret(Sender: TObject);
    procedure KeyPress(Sender: TObject; var Key: char);
    procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      x, y: Integer);
    procedure OnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x,
      y: Integer);
  public
    procedure CopyContext(var AContext: TConsoleContext);
    procedure SetContext(var AContext: TConsoleContext);
    procedure Update;
    procedure SetColors(FgColor, BgColor: TColor);
    procedure GotoXY(x, y: byte);
    procedure GotoEndOfLine(y: byte);
    function GetX: byte;
    function GetY: byte;
    function GetLastLine: byte;
    function GetChar(x, y: byte): char;
    function GetText(y: byte): string;
    procedure Clear;
    procedure ClearLn(y: byte);
    procedure LineFeed;
    procedure Write(Str: string);
    procedure WriteLn(Str: string);
    function ReadKey: char;
    function ReadLength(Len: byte): string;
    function Read: string;
    function ReadLn: string;
    function ReadLnLength(Len: byte): string;
  end;

implementation

constructor TConsole.Create(AForm: TForm);
begin
  Form := AForm;
  Canvas := Form.Canvas;
  Canvas.Font.Name := 'Courier New';
  Canvas.Font.Size := 8;
  Canvas.Font.Height := -11;
  Canvas.Brush.Color := Form.Color;
  Canvas.Font.Color := Form.Font.Color;

  Background := Form.Color;
  Forground := Form.Font.Color;
  PreviousOnPaint := Form.OnPaint;
  PreviousOnKeyPress := Form.OnKeyPress;
  PreviousOnMouseDown := Form.OnMouseDown;
  PreviousOnMouseUp := Form.OnMouseUp;
  Form.OnMouseDown := OnMouseDown;
  Form.OnMouseUp := OnMouseUp;

  GetMem(Context, Sizeof(TConsoleContext));

  PreviousWidth := AForm.ClientWidth;
  PreviousHeight := AForm.ClientHeight;
  Form.ClientWidth := (CONSOLE_OFFSET_X * 2) + (CONSOLE_WIDTH * CONSOLE_FONT_WIDTH);
  Form.ClientHeight := (CONSOLE_OFFSET_Y * 2) + (CONSOLE_HEIGHT *
    CONSOLE_FONT_HEIGHT);
  Form.OnPaint := Refresh;

  Caret := TTimer.Create(nil);
  with Caret do
  begin
    Enabled := false;
    Interval := CONSOLE_CARET_SPEED;
    OnTimer := ToggleCaret;
  end;
  Context^.ShowCaret := false;

  Clear;
end;

destructor TConsole.Destroy;
begin
  Caret.Free;
  FreeMem(Context);
  Form.OnPaint := PreviousOnPaint;
  Form.OnKeyPress := PreviousOnKeyPress;
  Form.OnMouseDown := PreviousOnMouseDown;
  Form.OnMouseUp := PreviousOnMouseUp;
  Form.ClientWidth := PreviousWidth;
  Form.ClientHeight := PreviousHeight;
  inherited;
end;

procedure TConsole.PaintLine(y: byte);
begin
  Canvas.FillRect(Rect(CONSOLE_OFFSET_X, CONSOLE_OFFSET_Y + (y *
    (CONSOLE_FONT_HEIGHT)), CONSOLE_OFFSET_X + (CONSOLE_WIDTH) * (CONSOLE_FONT_WIDTH),
    CONSOLE_OFFSET_Y + (y * (CONSOLE_FONT_HEIGHT)) + CONSOLE_FONT_HEIGHT));
  Canvas.TextOut(CONSOLE_OFFSET_X, CONSOLE_OFFSET_Y + (y * (CONSOLE_FONT_HEIGHT)),
    Context^.Lines[y]);
end;

procedure TConsole.Refresh(Sender: TObject);
var
  y: byte;
begin
  if (CONSOLE_OFFSET_X <> 0) and (CONSOLE_OFFSET_Y <> 0) then
  begin
    Canvas.FillRect(Rect(0, 0, Canvas.ClipRect.Right, CONSOLE_OFFSET_Y));
    Canvas.FillRect(Rect(0, CONSOLE_OFFSET_Y, CONSOLE_OFFSET_X, CONSOLE_OFFSET_Y +
      ((CONSOLE_HEIGHT - 1) * (CONSOLE_FONT_HEIGHT)) + CONSOLE_FONT_HEIGHT));
    Canvas.FillRect(Rect(0, CONSOLE_OFFSET_Y + ((CONSOLE_HEIGHT - 1) *
      (CONSOLE_FONT_HEIGHT)) + CONSOLE_FONT_HEIGHT, Canvas.ClipRect.Right,
      Canvas.ClipRect.Bottom));
    Canvas.FillRect(Rect(CONSOLE_OFFSET_X + (CONSOLE_WIDTH) * (CONSOLE_FONT_WIDTH),
      CONSOLE_OFFSET_Y, Canvas.ClipRect.Right, CONSOLE_OFFSET_Y + ((CONSOLE_HEIGHT - 1)
      * (CONSOLE_FONT_HEIGHT)) + CONSOLE_FONT_HEIGHT));
  end;
  with Context^ do
    for y := 0 to CONSOLE_HEIGHT - 1 do
      PaintLine(y);
  PaintCaret;
  if Assigned(PreviousOnPaint) then
    PreviousOnPaint(Sender);
end;

procedure TConsole.EraseCaret;
begin
  with Context^ do
    if Length(Lines[CaretPosY]) > CaretPosX then
      Canvas.TextOut(CONSOLE_OFFSET_X + (CaretPosX * (CONSOLE_FONT_WIDTH)),
        CONSOLE_OFFSET_Y + (CaretPosY * (CONSOLE_FONT_HEIGHT)), Lines[CaretPosY,
        CaretPosX + 1])
    else
      Canvas.TextOut(CONSOLE_OFFSET_X + (CaretPosX * (CONSOLE_FONT_WIDTH)),
        CONSOLE_OFFSET_Y + (CaretPosY * (CONSOLE_FONT_HEIGHT)), ' ');
end;

procedure TConsole.PaintCaret;
begin
  with Context^ do
  begin
    if Caret.Enabled = false then
      Exit;
    if ShowCaret = true then
    begin
      if (CaretPosX <> PosX) or (CaretPosY <> PosY) then
        EraseCaret;
      Canvas.Brush.Color := Forground;
      Canvas.FillRect(Rect(CONSOLE_OFFSET_X + (PosX * (CONSOLE_FONT_WIDTH)),
        CONSOLE_OFFSET_Y + (PosY * (CONSOLE_FONT_HEIGHT)) + 10, CONSOLE_OFFSET_X + (PosX
        * (CONSOLE_FONT_WIDTH)) + CONSOLE_FONT_WIDTH, CONSOLE_OFFSET_Y + (PosY *
        (CONSOLE_FONT_HEIGHT)) + 13));
      Canvas.Brush.Color := Background;
      CaretPosX := PosX;
      CaretPosY := PosY;
    end
    else
      EraseCaret;
  end;
end;

procedure TConsole.ToggleCaret(Sender: TObject);
begin
  with Context^ do
    ShowCaret := not ShowCaret;
  PaintCaret;
end;

procedure TConsole.KeyPress(Sender: TObject; var Key: char);
begin
  with Context^ do
  begin
    LastKey := Key;
    KeyPressed := true;
  end;
  if Assigned(PreviousOnKeyPress) then
    PreviousOnKeyPress(Form, Key);
end;

procedure TConsole.OnMouseDown(Sender: TObject; Button: TMouseButton; Shift:
  TShiftState; x, y: Integer);
begin
  if Button <> mbLeft then
    Exit;
  StartDragX := (X - CONSOLE_OFFSET_X) div CONSOLE_FONT_WIDTH;
  StartDragY := (Y - CONSOLE_OFFSET_Y) div CONSOLE_FONT_HEIGHT;
  if StartDragX >= CONSOLE_WIDTH then
    StartDragX := CONSOLE_WIDTH - 1;
  if StartDragY >= CONSOLE_HEIGHT then
    StartDragY := CONSOLE_HEIGHT - 1;
  if Assigned(PreviousOnMouseDown) then
    PreviousOnMouseDown(Sender, Button, Shift, x, y);
end;

procedure TConsole.OnMouseUp(Sender: TObject; Button: TMouseButton; Shift:
  TShiftState; x, y: Integer);
var
  EndDragX, EndDragY, Temp: word;
  Str: string;
begin
  if Button <> mbLeft then
    Exit;
  EndDragX := (x - CONSOLE_OFFSET_X) div CONSOLE_FONT_WIDTH;
  EndDragY := (y - CONSOLE_OFFSET_Y) div CONSOLE_FONT_HEIGHT;
  if EndDragX >= CONSOLE_WIDTH then
    EndDragX := CONSOLE_WIDTH - 1;
  if EndDragY >= CONSOLE_HEIGHT then
    EndDragY := CONSOLE_HEIGHT - 1;
  if (StartDragX = EndDragX) and (StartDragY = EndDragY) then
    Exit;
  if EndDragY < StartDragY then
  begin
    Temp := EndDragX;
    EndDragX := StartDragX;
    StartDragX := Temp;
    Temp := EndDragY;
    EndDragY := StartDragY;
    StartDragY := Temp;
  end
  else if (EndDragY = StartDragY) and (EndDragX < StartDragX) then
  begin
    Temp := EndDragX;
    EndDragX := StartDragX;
    StartDragX := Temp;
  end;
  Inc(StartDragX, 1);
  Inc(EndDragX, 1);

  with Context^ do
  begin
    if StartDragY = EndDragY then
      Str := Copy(Lines[StartDragY], StartDragX, EndDragX - StartDragX + 1)
    else
    begin
      Str := Copy(Lines[StartDragY], StartDragX, CONSOLE_WIDTH - StartDragX);
      if EndDragY - StartDragY > 1 then
        for y := StartDragY + 1 to EndDragY - 1 do
          Str := Str + Lines[y];
      Str := Str + Copy(Lines[EndDragY], 1, EndDragX);
    end;
  end;
  ClipBoard.SetTextBuf(PChar(Str));
  if Assigned(PreviousOnMouseUp) then
    PreviousOnMouseUp(Sender, Button, Shift, x, y);
end;

procedure TConsole.CopyContext(var AContext: TConsoleContext);
begin
  Move(Context^, AContext, Sizeof(TConsoleContext));
end;

procedure TConsole.SetContext(var AContext: TConsoleContext);
begin
  Move(AContext, Context^, Sizeof(TConsoleContext));
  Update;
end;

procedure TConsole.Update;
begin
  Refresh(Form);
end;

procedure TConsole.SetColors(FgColor, BgColor: TColor);
begin
  Forground := FgColor;
  Background := BgColor;
  Canvas.Font.Color := FgColor;
  Canvas.Brush.Color := BgColor;
  Canvas.FillRect(Canvas.ClipRect);
  Update;
end;

procedure TConsole.GotoXY(x, y: byte);
begin
  with Context^ do
  begin
    if x > CONSOLE_WIDTH then
      x := CONSOLE_WIDTH
    else if x = 0 then
      Inc(x, 1);
    if y > CONSOLE_HEIGHT then
      y := CONSOLE_HEIGHT
    else if y = 0 then
      Inc(y, 1);
    PosX := x - 1;
    PosY := y - 1;
  end;
end;

procedure TConsole.GotoEndOfLine(y: byte);
begin
  if y > CONSOLE_HEIGHT then
    y := CONSOLE_HEIGHT
  else if y = 0 then
    Inc(y, 1);
  with Context^ do
  begin
    PosY := y - 1;
    PosX := Length(Lines[PosY]);
  end;
end;

function TConsole.GetX: byte;
begin
  Result := Context^.PosX + 1;
end;

function TConsole.GetY: byte;
begin
  Result := Context^.PosY + 1;
end;

function TConsole.GetLastLine: byte;
begin
  Result := CONSOLE_HEIGHT;
end;

function TConsole.GetChar(x, y: byte): char;
begin
  with Context^ do
  begin
    if (x > CONSOLE_WIDTH) or (x = 0) or (y > CONSOLE_HEIGHT) or (y = 0) then
      Result := #0
    else
    begin
      Dec(y, 1);
      if x > Length(Lines[y]) then
        Result := ' '
      else
        Result := Lines[y - 1, x];
    end;
  end;
end;

function TConsole.GetText(y: byte): string;
begin
  if (y > CONSOLE_HEIGHT) or (y = 0) then
    Result := ''
  else
    Result := Context^.Lines[y - 1];
end;

procedure TConsole.Clear;
var
  y: byte;
begin
  with Context^ do
  begin
    for y := 0 to CONSOLE_HEIGHT - 1 do
      Lines[y] := '';
    PosX := 0;
    PosY := 0;
    KeyPressed := false;
    LastKey := #0;
    Canvas.FillRect(Rect(0, 0, (CONSOLE_OFFSET_X * 2) + (CONSOLE_FONT_WIDTH *
      CONSOLE_WIDTH), (CONSOLE_OFFSET_Y * 2) + (CONSOLE_FONT_HEIGHT * CONSOLE_HEIGHT)));
  end;
end;

procedure TConsole.ClearLn(y: byte);
begin
  if y > CONSOLE_HEIGHT then
    y := CONSOLE_HEIGHT
  else if y = 0 then
    Inc(y, 1);
  Dec(y, 1);
  with Context^ do
  begin
    Canvas.FillRect(Rect(0, CONSOLE_OFFSET_Y + (y * (CONSOLE_FONT_HEIGHT)),
      (CONSOLE_OFFSET_X * 2) + (CONSOLE_WIDTH - 1) * (CONSOLE_FONT_WIDTH + 1),
      (CONSOLE_OFFSET_Y * 2) + (y * (CONSOLE_FONT_HEIGHT)) + CONSOLE_FONT_HEIGHT));
    Lines[y] := '';
    PosX := 0;
    PosY := y;
  end;
end;

procedure TConsole.LineFeed;
var
  y: byte;
begin
  with Context^ do
  begin
    PosX := 0;
    if PosY = CONSOLE_HEIGHT - 1 then
    begin
      for y := 0 to CONSOLE_HEIGHT - 2 do
        Lines[y] := Lines[y + 1];
      Lines[CONSOLE_HEIGHT - 1] := '';
      Update;
    end
    else
      Inc(PosY, 1);
  end;
end;

procedure TConsole.Write(Str: string);
var
  StrLen, SubPos, SubLen, y, StartPosY: word;
begin
  with Context^ do
  begin
    StartPosY := PosY;
    StrLen := Length(Str);
    SubPos := 1;
    if StrLen + PosX < CONSOLE_WIDTH then
    begin
      SetLength(Lines[PosY], PosX + StrLen);
      Move(Str[1], Lines[PosY, PosX + 1], StrLen);
      Inc(PosX, StrLen);
    end
    else if StrLen + PosX = CONSOLE_WIDTH then
    begin
      SetLength(Lines[PosY], CONSOLE_WIDTH);
      Move(Str[1], Lines[PosY, PosX + 1], StrLen);
      LineFeed;
    end
    else
    begin
      SubLen := CONSOLE_WIDTH - Length(Lines[PosY]);
      repeat
        if PosX + 1 + SubLen > Length(Lines[PosY]) then
          SetLength(Lines[PosY], PosX + SubLen);
        Move(Str[SubPos], Lines[PosY, PosX + 1], SubLen);
        Inc(SubPos, SubLen);
        if SubPos < StrLen then
        begin
          LineFeed;
          if (StartPosY <> 0) and (PosY = CONSOLE_HEIGHT - 1) then
            Dec(StartPosY, 1);
        end
        else
          Inc(PosX, SubLen);
        SubLen := StrLen - SubPos + 1;
        if SubLen > CONSOLE_WIDTH then
          SubLen := CONSOLE_WIDTH;
      until ((SubLen + Length(Lines[PosY]) <= CONSOLE_WIDTH) and (SubPos >= StrLen))
        or (SubLen = 0);
      if SubPos < StrLen then
      begin
        SetLength(Lines[PosY], PosX + SubLen);
        Move(Str[SubPos], Lines[PosY, PosX + 1], SubLen);
        Inc(PosX, SubLen);
      end;
    end;
    for y := StartPosY to PosY do
      PaintLine(y);
  end;
end;

procedure TConsole.WriteLn(Str: string);
begin
  Write(Str);
  LineFeed;
end;

function TConsole.ReadKey: char;
begin
  with Context^ do
  begin
    KeyPressed := false;
    repeat
      Application.HandleMessage;
    until KeyPressed = true;
    Result := LastKey;
  end;
end;

function TConsole.ReadLength(Len: byte): string;
var
  StartPosX, StartPosY: byte;
  ClipBoardStr: array[0..255] of char;
  Key: char;
begin
  with Context^ do
  begin
    Form.OnKeyPress := KeyPress;
    Caret.Enabled := true;
    StartPosX := PosX;
    StartPosY := PosY;
    Result := '';
    repeat
      Key := ReadKey;
      if Key = #8 then
      begin
        if PosY > StartPosY then
        begin
          if PosX > 0 then
          begin
            Dec(PosX, 1);
            SetLength(Lines[PosY], Length(Lines[PosY]) - 1);
            SetLength(Result, Length(Result) - 1);
            Canvas.TextOut(CONSOLE_OFFSET_X + (PosX * (CONSOLE_FONT_WIDTH)),
              CONSOLE_OFFSET_Y + (PosY * (CONSOLE_FONT_HEIGHT)), ' ');
          end
          else
          begin
            Lines[PosY] := '';
            Dec(Posy, 1);
            PosX := CONSOLE_WIDTH - 1;
            SetLength(Lines[PosY], CONSOLE_WIDTH - 1);
            SetLength(Result, Length(Result) - 1);
            Canvas.TextOut(CONSOLE_OFFSET_X + (PosX * (CONSOLE_FONT_WIDTH)),
              CONSOLE_OFFSET_Y + (PosY * (CONSOLE_FONT_HEIGHT)), ' ');
          end;
        end
        else if PosX > StartPosX then
        begin
          Dec(PosX, 1);
          SetLength(Lines[PosY], Length(Lines[PosY]) - 1);
          SetLength(Result, Length(Result) - 1);
          Canvas.TextOut(CONSOLE_OFFSET_X + (PosX * (CONSOLE_FONT_WIDTH)),
            CONSOLE_OFFSET_Y + (PosY * (CONSOLE_FONT_HEIGHT)), ' ');
        end;
      end
      else if Key = #22 then
      begin
        ClipBoard.GetTextBuf(@ClipBoardStr, Len - Length(Result));
        Result := Result + StrPas(ClipBoardStr);
        Write(StrPas(ClipBoardStr));
      end
      else if (Key <> #13) and (Length(Result) <= Len) and (Key > #31) and (Key < #127)
        then
      begin
        Result := Result + Key;
        Lines[PosY] := Lines[PosY] + Key;
        Canvas.TextOut(CONSOLE_OFFSET_X + (PosX * (CONSOLE_FONT_WIDTH)),
          CONSOLE_OFFSET_Y + (PosY * (CONSOLE_FONT_HEIGHT)), Key);
        Inc(PosX, 1);
        if PosX = CONSOLE_WIDTH then
        begin
          if StartPosY <> 0 then
            Dec(StartPosY, 1)
          else
            StartPosX := 0;
          LineFeed;
          Refresh(Canvas);
        end;
      end;
      PaintCaret;
    until Key = #13;
    ShowCaret := false;
    Caret.Enabled := false;
    Form.OnKeyPress := PreviousOnKeyPress;
  end;
end;

function TConsole.Read: string;
begin
  Result := ReadLength(250);
end;

function TConsole.ReadLn: string;
begin
  Result := ReadLength(250);
  LineFeed;
end;

function TConsole.ReadLnLength(Len: byte): string;
begin
  if Len > 250 then
    Len := 250;
  Result := ReadLength(Len);
  LineFeed;
end;

end. //UNIT CONSOLE.PAS FINISHED

//*************************************************************************
//*************************** EXAMPLE ***************************************
//*************************************************************************

//Call: AConsole:=TConsole.Create(Form1); before calling TForm1.CommandPrompt;

procedure TForm1.CommandPrompt;
var
  Command: string;
  Parameters: array[0..9] of string;
  ParameterCount: byte;

  procedure ParseLine(c: string);
  var
    i: byte;
    Param: byte;
    Brackets: boolean;
  begin
    try
      Brackets := false;
      Param := 0;
      for i := 0 to 9 do
        Parameters[i] := '';
      for i := 1 to Length(c) do
      begin
        if c[i] = '"' then
        begin
          Brackets := not Brackets;
          if Brackets = false then
            Inc(Param, 1);
        end
        else if Brackets = true then
          Parameters[Param] := Parameters[Param] + c[i]
        else if (c[i] = ' ') and (c[i - 1] <> ' ') then
        begin
          Inc(Param, 1);
          if Param = 10 then
            Exit;
        end
        else
          Parameters[Param] := Parameters[Param] + c[i];
      end;
    finally
      ParameterCount := Param + 1;
      Parameters[0] := LowerCase(Parameters[0]);
    end;
  end;

  procedure CommandRun;
  begin
    with AConsole do
    begin
      if ParameterCount < 2 then
      begin
        Writeln('Use: run <path>');
        Writeln('   ex: run "c:\program files\myprogram.exe"');
        Writeln('');
        Exit;
      end;
      case WinExec(PChar(Parameters[1]), SW_SHOWNORMAL) of
        0: Writeln('The system is out of memory or resources.');
        ERROR_BAD_FORMAT:
          Writeln('The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).');
        ERROR_FILE_NOT_FOUND: Writeln('The specified file was not found.');
        ERROR_PATH_NOT_FOUND: Writeln('The specified path was not found.');
      end;
    end;
  end;

  procedure CommandOpen;
  begin
    with AConsole do
    begin
      if ParameterCount < 2 then
      begin
        Writeln('Use: open <path>');
        Writeln('   ex: open "c:\my documents\finance.doc"');
        Writeln('');
        Exit;
      end;
      case ShellExecute(Application.Handle, 'open', PChar(Parameters[1]), nil, nil,
        SW_NORMAL) of
        0: Writeln('The operating system is out of memory or resources.');
        ERROR_FILE_NOT_FOUND: Writeln('The specified file was not found.');
        ERROR_PATH_NOT_FOUND: Writeln('The specified path was not found.');
        ERROR_BAD_FORMAT:
          Writeln('The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).');
        SE_ERR_ACCESSDENIED:
          Writeln('The operating system denied access to the specified file.');
        SE_ERR_ASSOCINCOMPLETE:
          Writeln('The filename association is incomplete or invalid.');
        SE_ERR_DDEBUSY:
          Writeln('The DDE transaction could not be completed because other DDE transactions were being processed.');
        SE_ERR_DDEFAIL: Writeln('The DDE transaction failed.');
        SE_ERR_DDETIMEOUT:
          Writeln('The DDE transaction could not be completed because the request timed out.');
        SE_ERR_DLLNOTFOUND:
          Writeln('The specified dynamic-link library was not found.');
        SE_ERR_NOASSOC:
          Writeln('There is no application associated with the given filename extension.');
        SE_ERR_OOM: Writeln('There was not enough memory to complete the operation.');
        SE_ERR_SHARE: Writeln('A sharing violation occurred.');
      end;
    end;
  end;

  procedure CommandHelp;
  begin
    with AConsole do
    begin
      Writeln('The following commands are available:');
      Writeln('   run <path>     (starts an application)');
      Writeln('   open <path>    (opens a file with the associated application)');
      Writeln('   help           (displays this message)');
      Writeln('   exit           (ends the console session)');
      Writeln('');
    end;
  end;

begin
  with AConsole do
  begin
    GotoXY(0, GetLastLine);
    WriteLn('Welcome to DrMungkee''s demo console.');
    WriteLn('   Type ''help'' for a list of available commands.');
    repeat
      Write('>');
      Command := ReadLn;
      ParseLine(Command);
      if Parameters[0] = 'clear' then
        Clear
      else if Parameters[0] = 'run' then
        CommandRun
      else if Parameters[0] = 'open' then
        CommandOpen
      else if Parameters[0] = 'help' then
        CommandHelp
      else if Parameters[0] <> 'exit' then
      begin
        Writeln('Unknow Command (' + Parameters[0] + ')');
      end;
    until Parameters[0] = 'exit';
    AConsole.Free;
  end;
end;