{===============================================================================
TConsolePanel - Embed Console Window Inside Delphi TForm
===============================================================================
Allows embedding a Windows console window as a child of a TForm at runtime.
Similar to IDE integration in Linux environments.
Features:
- Embed console as child window of TForm
- Automatic window sizing and positioning
- Resize with parent form
- Full console input/output redirection
- Process management
- Optional auto-launch on Create
Usage:
ConsolePanel := TConsolePanel.Create(Self);
ConsolePanel.Parent := Form1;
ConsolePanel.Align := alClient;
ConsolePanel.LaunchConsole;
===============================================================================}
unit ConsolePanel;
interface
uses
Windows, Classes, Controls, Forms, Messages, SysUtils;
type
TConsolePanel = class(TCustomControl)
private
FConsoleHandle: HWND;
FProcessHandle: THandle;
FProcessID: DWORD;
FAutoLaunch: Boolean;
FConsoleVisible: Boolean;
FShowFrame: Boolean;
FOnConsoleCreated: TNotifyEvent;
FOnConsoleClosed: TNotifyEvent;
FConsolePath: String;
FConsoleTitle: String;
FInitialWidth: Integer;
FInitialHeight: Integer;
FAlign: TAlign;
procedure SetShowFrame(Value: Boolean);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMShowWindow(var Message: TWMShowWindow); message WM_SHOWWINDOW;
procedure SetParent(AParent: TWinControl); override;
function GetIsConsoleOpen: Boolean;
procedure ResizeConsoleWindow;
procedure UpdateConsoleWindowSize;
procedure SetAlign(Value: TAlign);
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure Resize; override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Launch or kill console }
function LaunchConsole(const AConsolePath: String = ''): Boolean;
procedure CloseConsole;
procedure KillConsole;
function IsConsoleRunning: Boolean;
{ Window operations }
procedure FocusConsole;
procedure ShowConsole;
procedure HideConsole;
procedure SetConsoleTitle(const Title: String);
{ Get handles }
function GetConsoleHandle: HWND;
function GetProcessHandle: THandle;
function GetProcessID: DWORD;
property IsConsoleOpen: Boolean read GetIsConsoleOpen;
property OnConsoleCreated: TNotifyEvent read FOnConsoleCreated write FOnConsoleCreated;
property OnConsoleClosed: TNotifyEvent read FOnConsoleClosed write FOnConsoleClosed;
property ConsoleTitle: String read FConsoleTitle write FConsoleTitle;
property AutoLaunch: Boolean read FAutoLaunch write FAutoLaunch;
property Align: TAlign read FAlign write SetAlign default alNone;
property ShowFrame: Boolean read FShowFrame write SetShowFrame default True;
end;
{===============================================================================
TConsoleManager - Higher-level console management
===============================================================================}
type
TConsoleManager = class(TObject)
private
FConsoleWindow: HWND;
FConsolePanel: TConsolePanel;
FInputHandle: THandle;
FOutputHandle: THandle;
FErrorHandle: THandle;
FBufferSize: Integer;
FIsRedirected: Boolean;
public
constructor Create(AConsolePanel: TConsolePanel);
destructor Destroy; override;
{ Input/Output redirection }
function RedirectInput: Boolean;
function RedirectOutput: Boolean;
procedure RestoreHandles;
{ Console interaction }
procedure Clear;
procedure SetTextColor(Color: Word);
procedure SetBufferSize(Width, Height: Word);
function GetBufferSize: TSize;
{ Console info }
function GetConsoleTitle: String;
procedure SetConsoleTitle(const Title: String);
property ConsoleWindow: HWND read FConsoleWindow;
property IsRedirected: Boolean read FIsRedirected;
property BufferSize: Integer read FBufferSize write FBufferSize;
end;
procedure Register;
implementation
{===============================================================================
TConsolePanel Implementation
===============================================================================}
constructor TConsolePanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
Width := 400;
Height := 300;
FConsoleHandle := 0;
FProcessHandle := 0;
FProcessID := 0;
FAutoLaunch := False;
FConsoleVisible := False;
FShowFrame := True;
FConsolePath := '';
FConsoleTitle := 'Console';
FInitialWidth := Width;
FInitialHeight := Height;
FAlign := alNone;
{ Auto-launch if requested }
if FAutoLaunch then
LaunchConsole;
end;
destructor TConsolePanel.Destroy;
begin
CloseConsole;
inherited Destroy;
end;
procedure TConsolePanel.CreateWnd;
begin
inherited CreateWnd;
end;
procedure TConsolePanel.DestroyWnd;
begin
CloseConsole;
inherited DestroyWnd;
end;
procedure TConsolePanel.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
if AParent <> nil then
begin
if HandleAllocated and (FConsoleHandle <> 0) then
begin
UpdateConsoleWindowSize;
end;
end;
end;
procedure TConsolePanel.WMSize(var Message: TWMSize);
begin
inherited;
ResizeConsoleWindow;
end;
procedure TConsolePanel.WMShowWindow(var Message: TWMShowWindow);
begin
inherited;
if FConsoleHandle <> 0 then
begin
if Message.Show <> 0 then
ShowWindow(FConsoleHandle, SW_SHOW)
else
ShowWindow(FConsoleHandle, SW_HIDE);
end;
end;
procedure TConsolePanel.Paint;
begin
inherited Paint;
{ Draw placeholder if no console }
if FConsoleHandle = 0 then
begin
Canvas.Brush.Color := clBlack;
Canvas.FillRect(ClientRect);
Canvas.Font.Color := clLime;
Canvas.TextOut(10, 10, 'Console not launched. Click or call LaunchConsole().');
end;
end;
procedure TConsolePanel.Resize;
begin
inherited Resize;
ResizeConsoleWindow;
end;
procedure TConsolePanel.ResizeConsoleWindow;
begin
if HandleAllocated and (FConsoleHandle <> 0) then
begin
UpdateConsoleWindowSize;
end;
end;
procedure TConsolePanel.UpdateConsoleWindowSize;
var
ParentHandle: HWND;
R: TRect;
begin
if FConsoleHandle = 0 then Exit;
ParentHandle := Handle;
if ParentHandle = 0 then Exit;
{ Get client rect }
Windows.GetClientRect(ParentHandle, R);
{ Resize console window to fit panel (0,0 since we're using SetParent) }
SetWindowPos(
FConsoleHandle,
0,
0, 0,
R.Right - R.Left, R.Bottom - R.Top,
SWP_NOZORDER or SWP_SHOWWINDOW
);
end;
procedure TConsolePanel.SetAlign(Value: TAlign);
begin
if FAlign <> Value then
begin
FAlign := Value;
{ Apply standard Delphi alignment behavior }
case FAlign of
alNone:
begin
{ Keep current position and size }
end;
alTop:
begin
Align := alTop;
Height := 150; { Default height }
end;
alBottom:
begin
Align := alBottom;
Height := 150; { Default height }
end;
alLeft:
begin
Align := alLeft;
Width := 200; { Default width }
end;
alRight:
begin
Align := alRight;
Width := 200; { Default width }
end;
alClient:
begin
Align := alClient;
end;
alCustom:
begin
{ Custom positioning - user controls position/size }
end;
end;
if HandleAllocated then
ResizeConsoleWindow;
end;
end;
procedure TConsolePanel.SetShowFrame(Value: Boolean);
var
Style: Longint;
begin
if FShowFrame <> Value then
begin
FShowFrame := Value;
if FConsoleHandle <> 0 then
begin
if FShowFrame then
begin
{ Show the window frame/border }
Style := GetWindowLong(FConsoleHandle, GWL_STYLE);
SetWindowLong(FConsoleHandle, GWL_STYLE, Style or WS_CAPTION or WS_BORDER);
SetWindowPos(FConsoleHandle, 0, 0, 0, 0, 0,
SWP_NOZORDER or SWP_NOSIZE or SWP_NOMOVE or SWP_FRAMECHANGED);
end
else
begin
{ Hide the window frame/border, keep only the client area }
Style := GetWindowLong(FConsoleHandle, GWL_STYLE);
SetWindowLong(FConsoleHandle, GWL_STYLE, Style and not (WS_CAPTION or WS_BORDER));
SetWindowPos(FConsoleHandle, 0, 0, 0, 0, 0,
SWP_NOZORDER or SWP_NOSIZE or SWP_NOMOVE or SWP_FRAMECHANGED);
end;
end;
end;
function TConsolePanel.LaunchConsole(const AConsolePath: String = ''): Boolean;
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
ConsolePath: String;
Attempt: Integer;
begin
Result := False;
{ Close existing console first }
if IsConsoleRunning then
CloseConsole;
{ Determine console path }
if AConsolePath <> '' then
ConsolePath := AConsolePath
else if FConsolePath <> '' then
ConsolePath := FConsolePath
else
ConsolePath := 'cmd.exe';
{ Check if file exists }
if not FileExists(ConsolePath) then
begin
ShowMessage('Console application not found: ' + ConsolePath);
Exit;
end;
{ Initialize startup info }
ZeroMemory(@StartupInfo, SizeOf(TStartupInfo));
StartupInfo.cb := SizeOf(TStartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
StartupInfo.wShowWindow := SW_SHOW;
{ Create the process }
if not CreateProcess(
nil,
PChar(ConsolePath),
nil,
nil,
False,
CREATE_NEW_CONSOLE,
nil,
nil,
StartupInfo,
ProcessInfo) then
begin
ShowMessage('Failed to create console process');
Exit;
end;
FProcessHandle := ProcessInfo.hProcess;
FProcessID := ProcessInfo.dwProcessId;
CloseHandle(ProcessInfo.hThread);
{ Try to find the console window }
for Attempt := 1 to 50 do
begin
Sleep(50);
FConsoleHandle := FindWindowEx(0, 0, 'ConsoleWindowClass', nil);
if FConsoleHandle <> 0 then
Break;
end;
if FConsoleHandle <> 0 then
begin
{ Make it a child of our panel }
SetWindowLong(FConsoleHandle, GWL_STYLE, GetWindowLong(FConsoleHandle, GWL_STYLE) and not WS_POPUP);
Windows.SetParent(FConsoleHandle, Handle);
{ Apply ShowFrame setting }
if not FShowFrame then
begin
{ Hide the frame }
var Style: Longint := GetWindowLong(FConsoleHandle, GWL_STYLE);
SetWindowLong(FConsoleHandle, GWL_STYLE, Style and not (WS_CAPTION or WS_BORDER));
SetWindowPos(FConsoleHandle, 0, 0, 0, 0, 0,
SWP_NOZORDER or SWP_NOSIZE or SWP_NOMOVE or SWP_FRAMECHANGED);
end;
{ Resize and position }
UpdateConsoleWindowSize;
FConsoleVisible := True;
SetConsoleTitle(FConsoleTitle);
if Assigned(FOnConsoleCreated) then
FOnConsoleCreated(Self);
Result := True;
Invalidate;
end
else
begin
ShowMessage('Failed to locate console window');
end;
end;
procedure TConsolePanel.CloseConsole;
begin
if FConsoleHandle <> 0 then
begin
{ Restore parent }
Windows.SetParent(FConsoleHandle, 0);
ShowWindow(FConsoleHandle, SW_SHOW);
FConsoleHandle := 0;
FConsoleVisible := False;
end;
if FProcessHandle <> 0 then
begin
{ Send WM_CLOSE to process }
TerminateProcess(FProcessHandle, 0);
WaitForSingleObject(FProcessHandle, INFINITE);
CloseHandle(FProcessHandle);
FProcessHandle := 0;
end;
if Assigned(FOnConsoleClosed) then
FOnConsoleClosed(Self);
Invalidate;
end;
procedure TConsolePanel.KillConsole;
begin
if FProcessHandle <> 0 then
TerminateProcess(FProcessHandle, 1);
if FConsoleHandle <> 0 then
FConsoleHandle := 0;
if FProcessHandle <> 0 then
begin
CloseHandle(FProcessHandle);
FProcessHandle := 0;
end;
end;
function TConsolePanel.IsConsoleRunning: Boolean;
var
ExitCode: DWORD;
begin
Result := False;
if FProcessHandle = 0 then
Exit;
if GetExitCodeProcess(FProcessHandle, ExitCode) then
Result := (ExitCode = STILL_ACTIVE);
end;
procedure TConsolePanel.FocusConsole;
begin
if FConsoleHandle <> 0 then
SetForegroundWindow(FConsoleHandle);
end;
procedure TConsolePanel.ShowConsole;
begin
if FConsoleHandle <> 0 then
begin
ShowWindow(FConsoleHandle, SW_SHOW);
FConsoleVisible := True;
end;
end;
procedure TConsolePanel.HideConsole;
begin
if FConsoleHandle <> 0 then
begin
ShowWindow(FConsoleHandle, SW_HIDE);
FConsoleVisible := False;
end;
end;
procedure TConsolePanel.SetConsoleTitle(const Title: String);
begin
FConsoleTitle := Title;
if FConsoleHandle <> 0 then
SetWindowText(FConsoleHandle, PChar(Title));
end;
function TConsolePanel.GetConsoleHandle: HWND;
begin
Result := FConsoleHandle;
end;
function TConsolePanel.GetProcessHandle: THandle;
begin
Result := FProcessHandle;
end;
function TConsolePanel.GetProcessID: DWORD;
begin
Result := FProcessID;
end;
function TConsolePanel.GetIsConsoleOpen: Boolean;
begin
Result := (FConsoleHandle <> 0) and IsWindow(FConsoleHandle);
end;
{===============================================================================
TConsoleManager Implementation
===============================================================================}
constructor TConsoleManager.Create(AConsolePanel: TConsolePanel);
begin
inherited Create;
FConsolePanel := AConsolePanel;
FConsoleWindow := AConsolePanel.GetConsoleHandle;
FBufferSize := 4096;
FIsRedirected := False;
FInputHandle := GetStdHandle(STD_INPUT_HANDLE);
FOutputHandle := GetStdHandle(STD_OUTPUT_HANDLE);
FErrorHandle := GetStdHandle(STD_ERROR_HANDLE);
end;
destructor TConsoleManager.Destroy;
begin
RestoreHandles;
inherited Destroy;
end;
function TConsoleManager.RedirectInput: Boolean;
begin
{ This is complex in Windows - would require creating pipes and attaching console }
Result := False;
end;
function TConsoleManager.RedirectOutput: Boolean;
begin
{ This is complex in Windows - would require creating pipes and attaching console }
Result := False;
end;
procedure TConsoleManager.RestoreHandles;
begin
{ Restore original handles }
FIsRedirected := False;
end;
procedure TConsoleManager.Clear;
var
hStdOut: THandle;
csbi: TConsoleScreenBufferInfo;
dwConSize: DWORD;
dwCount: DWORD;
dwCellCount: DWORD;
coordScreen: TCoord;
begin
if FConsoleWindow = 0 then Exit;
hStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
if GetConsoleScreenBufferInfo(hStdOut, csbi) then
begin
dwConSize := csbi.dwSize.X * csbi.dwSize.Y;
coordScreen.X := 0;
coordScreen.Y := 0;
FillConsoleOutputCharacter(hStdOut, ' ', dwConSize, coordScreen, dwCellCount);
GetConsoleScreenBufferInfo(hStdOut, csbi);
FillConsoleOutputAttribute(hStdOut, csbi.wAttributes, dwConSize, coordScreen, dwCount);
SetConsoleCursorPosition(hStdOut, coordScreen);
end;
end;
procedure TConsoleManager.SetTextColor(Color: Word);
begin
if FConsoleWindow = 0 then Exit;
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), Color);
end;
procedure TConsoleManager.SetBufferSize(Width, Height: Word);
var
hStdOut: THandle;
Coord: TCoord;
begin
if FConsoleWindow = 0 then Exit;
hStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
Coord.X := Width;
Coord.Y := Height;
SetConsoleScreenBufferSize(hStdOut, Coord);
end;
function TConsoleManager.GetBufferSize: TSize;
var
hStdOut: THandle;
csbi: TConsoleScreenBufferInfo;
begin
ZeroMemory(@Result, SizeOf(TSize));
if FConsoleWindow = 0 then Exit;
hStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
if GetConsoleScreenBufferInfo(hStdOut, csbi) then
begin
Result.cx := csbi.dwSize.X;
Result.cy := csbi.dwSize.Y;
end;
end;
function TConsoleManager.GetConsoleTitle: String;
var
Buffer: array[0..255] of Char;
begin
if FConsoleWindow = 0 then
begin
Result := '';
Exit;
end;
GetWindowText(FConsoleWindow, Buffer, SizeOf(Buffer));
Result := Buffer;
end;
procedure TConsoleManager.SetConsoleTitle(const Title: String);
begin
if FConsoleWindow = 0 then Exit;
SetWindowText(FConsoleWindow, PChar(Title));
end;
procedure Register;
begin
RegisterComponents('CodeBox', [TConsolePanel]);
end;
end.
Recent
