Mega Code Archive
Emulating a console on TForms
<![CDATA[
Title: Emulating a console on TForms
Question: 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.
(************ ALL COMMENTS AND RATINGS APPRECIATED ****************)
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;
]]>