Delphi Programming / Object Pascal
[掲載 2005年02月15日] [更新 2019年06月18日] Delphi サンプルプログラム集 |
520_コンソールアプリケーションを自アプリから操作 |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro |
|
520_Console2.zip [3,064 KB] 2019年06月18日版 (EXE 同梱) |
01_コンソールアプリケーションを自アプリから操作 |
本サンプルは,正確な意味のコンソールアプリケーションではありません.
コンソール関係の関数をフォームのボタンクリックでテストするために,Delphi の通常のプロジェクトでコンソール画面も同時に起動するようにしています.このため,コンソール画面とフォームは同一プロセスとして動作しています.したがって,コンソール画面を閉じても,フォームを閉じてもこのプログラムは終了します.
|
|
図1
設計時画面 |
|
図2
コンソールで文字列入力
- ボタンをクリック
- コンソールで文字列を入力して [Enter]
- ボタンのキャプションがその文字列に変わる
- 3 秒経つと元に戻る
|
|
図3
コンソールに文字列を出力
|
|
図4
コンソールに文字列を出力
- Windows API の関数を使用
- 文字列の表示位置を指定できる
|
リスト1
プロジェクトのソースコード
コンソール画面も同時に表示するために {$APPTYPE CONSOLE} を追加 |
program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
{$APPTYPE CONSOLE}
begin
Application.Initialize;
//Delphi2007以上
{$IF CompilerVersion > 18.49}
Application.MainFormOnTaskbar := True;
{$IFEND}
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
リスト2
コンソールアプリケーション (同一プロセス内で動作) |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private 宣言 }
FConsoleWnd : HWND;
FhStdout : THandle;
FhStdInput : THandle;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// Form作成時の処理
// コンソールの標準出力,標準入力デバイスのハンドルを取得
// タイトルを変更
// コンソール上の[Ctrl]+[C]でアプリが終了しないように設定.
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
FConsoleWnd := FindWindow(nil, PChar(Application.ExeName));
FhStdout := GetStdHandle(STD_OUTPUT_HANDLE);
FhStdInput := GetStdHandle(STD_INPUT_HANDLE);
SetConsoleTitle('コンソールのテスト');
SetConsoleCtrlHandler(nil, True);
end;
//=============================================================================
// ボタンをクリックすると
// (1)コンソール画面にFocus移動
// (2)何か文字列をタイプして[Enter]を押すと
// ボタンのキャプションがその文字列になりFormにFocus移動
// (3)指定秒後にButton1のCaptionを元に戻す
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LOldCaption : String;
LStrText : String;
begin
LOldCaption := Button1.Caption;
SetForegroundWindow(FConsoleWnd);
Write('文字列:');
Readln(LStrText);
Button1.Caption := LStrText;
//このFormを前面に表示
Self.BringToFront;
Update;
Sleep(3000);
Button1.Caption := LOldCaption;
end;
//=============================================================================
// コンソールに文字列を出力 Writeln,Write使用
//
// Writelnは出力後に改行する
// Writeは改行しない
// このコードにはReadlnはないので,実行後直ちにこのFormに制御(Focus)が戻る.
// 最後にReadlnを追加するとコンソール画面に入力Focusが移動し,何かをタイプして
// [Enter]を押下しないと,このFormにFocusが移動しない.
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
Writeln('東西');
Writeln('南北');
Write('東西');
Write('南北');
Writeln;
//FocusをこのFormに戻しておく
Show;
end;
//=============================================================================
// コンソールに文字列を出力 Window APIの関数使用
// Writelnなどと違いFocusがコンソールに移動しない
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LStrText : string;
LStrLen : DWORD;
LlpNumber : DWORD;
LPos : COORD;
LScrBuff : CONSOLE_SCREEN_BUFFER_INFO;
begin
LStrText := 'Delphi'+Char(13)+Char(10);
LStrLen := Length(LStrText);
//現在のカーソル位置を調査
GetConsoleScreenBufferInfo(FhStdout, LScrBuff);
LPos.X := LScrBuff.dwCursorPosition.X;
LPos.Y := LScrBuff.dwCursorPosition.Y;
//その1行下から出力
LPos.X := 0;
LPos.Y := LPos.Y + 1;
//白色で文字列を出力
SetConsoleCursorPosition(FhStdout, LPos);
SetConsoleTextAttribute(FhStdout, $000F);
WriteConsole(FhStdout, PChar(LStrText), LStrLen, LlpNumber, nil);
LPos.X := LPos.X;
LPos.Y := LPos.Y + 3;
//明るい緑で文字列を出力
SetConsoleCursorPosition(FhStdout, LPos);
SetConsoleTextAttribute(FhStdout, FOREGROUND_GREEN or FOREGROUND_INTENSITY);
WriteConsole(FhStdout, PChar(LStrText), LStrLen, LlpNumber, nil);
//文字の色を白に戻しておく
SetConsoleTextAttribute(FhStdout, $000F);
FlushConsoleInputBuffer(FhStdInput);
end;
//=============================================================================
// コンソール画面のクリア
// バッファサイズ(文字数)を空文字で埋めるだけ(文字の属性値は変更されない)
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
LSize : DWORD;
LlpNumber : DWORD;
LPos : COORD;
LPosX : SmallInt;
LPosY : SmallInt;
LScrBuff : CONSOLE_SCREEN_BUFFER_INFO;
begin
//スクリーンバッファの行と列サイズを文字単位で取得
GetConsoleScreenBufferInfo(FhStdout, LScrBuff);
LPosX := LScrBuff.dwSize.X;
LPosY := LScrBuff.dwSize.Y;
//クリア開始位置とサイズ
LPos.X := 0;
LPos.Y := 0;
LSize := LPosX * LPosY;
FillConsoleOutputCharacter(FhStdout, Char(' '), LSize, LPos, LlpNumber);
//開始位置をコンソールの最初に戻しておく
SetConsoleCursorPosition(FhStdout, LPos);
end;
end.
TStartupInfo 構造体の標準入力,標準出力先として,現在の標準入力,標準出力のハンドルを指定して CreateProcess 関数でコマンドを実行すれば,コンソールの画面に結果が表示されます.現在有効な標準入力と標準出力のハンドルは,GetStdHandle 関数で取得できます.
結果は,現在のカーソル位置から表示されます.
本サンプルは,最初のサンプルと同じで,プロジェクトのソースコードに {$APPTYPE CONSOLE} を追加 して,本アプリの EXE とコンソール画面を同時に起動しています.
|
|
図5
cmd.exe の dir コマンドの実行結果 |
リスト3
CreateProcess 関数で実行したコマンドの実行結果をコンソール画面に表示する |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
Edit1.Text := 'cmd.exe /c dir';
end;
//=============================================================================
// コマンドの実行結果をコンソールに出力するサンプル
// CreateProcessを使用する方法
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LCommandLine : string;
LStartupInfo : TStartupInfo;
LProcessInfo : TProcessInformation;
begin
Screen.Cursor := crHourGlass;
//CreateProcessの引数の構造体のメンバを設定
//入出力を標準入出力に設定する
ZeroMemory(@LStartupInfo, SizeOf(TStartupInfo));
ZeroMemory(@LProcessInfo, SizeOf(TProcessInformation));
LStartupInfo.cb := SizeOf(TStartupInfo);
LStartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
LStartupInfo.hStdOutput := GetStdHandle(STD_OUTPUT_HANDLE);
LStartupInfo.hStdError := GetStdHandle(STD_ERROR_HANDLE);
LStartupInfo.dwFlags := STARTF_USESTDHANDLES;
//コマンド実行
try
LCommandLine := Trim(Edit1.Text);
UniqueString(LCommandLine);
if not CreateProcess(nil,
PChar(LCommandLine),
nil,
nil,
True,
0,
nil,
nil,
LStartupInfo,
LProcessInfo) then begin
//CreateProcess失敗
end;
finally
CloseHandle(LProcessInfo.hProcess);
CloseHandle(LProcessInfo.hThread);
end;
Screen.Cursor := crDefault;
end;
end.
ここまでのサンプルは,EXE 起動と同時にコンソール画面を起動しています.
本サンプルでは,実行時に自アプリからコンソール画面を起動して表示します.
コマンドプロンプトの起動は,ShellExecute, ShellExecuteEx, CreateProcess 関数等を使用しますが,コンソール画面の起動には AllocConsole 関数を使用します.AllocConsole 関数でコンソールを起動すれば,コンソール関係の関数類を使用して,コンソール関係の操作が可能になります.
|
|
図6
実行画面 |
リスト4
AllocConsole 関数でコンソール画面を起動 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private 宣言 }
FIsRunConsole : Boolean;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeConsole;
FIsRunConsole := False;
end;
//=============================================================================
// コンソール画面を起動
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LhStdout : THandle;
LColor : Word;
begin
FIsRunConsole := AllocConsole;
if not FIsRunConsole then exit;
SetConsoleTitle('Console Test');
//標準出力のハンドルを取得
LhStdout := GetStdHandle(STD_OUTPUT_HANDLE);
//文字の色を明るい白にする
LColor := FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED or 8;
SetConsoleTextAttribute(LhStdout, LColor);
Writeln('コンソール画面の起動テスト');
end;
//=============================================================================
// コンソール画面を閉じる
// 入力待ちになっている時は閉じることができない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
FormDestroy(nil);
end;
end.
デバッグの時 (IDE 上でコンパイルして実行の時) だけコンソール仮面を起動したい場合は,アプリの起動時にコンソール画面を表示するようにします.以下のように,プロジェクトのソースコードにコンソール画面を起動するコードを記述します.
|
リスト5
デバッグの時だけコンソール画面をアプリの起動時に表示 |
program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
// FIsDebug はクラスのメンバではないグローバル変数
if DebugHook <> 0 then begin
FIsDebug := True;
AllocConsole;
end;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
上のコードではデバッグ時だけコンソール画面を表示するようにしています.必要な時に,EXE を直接実行する時でもコンソール画面を表示したい場合,例えば次のように,キー押下を検出する方法が考えられます.
このコードでは,[Shift] キーと [Ctrl] キーを押した状態で EXE を起動すると,コンソール画面も同時に起動します.
このコードでは [Ctrl] + [C} と [Ctrl] + [Break] の操作でコンソール画面を閉じないようにしています.また,[最小化] と [最大化] のボタンを非表示にして,更に [閉じる] ボタンでコンソール画面を閉じることができはないようにしています.
|
|
図7
デバッグの時だけコンソール画面を起動 |
リスト6
必要な時に,EXE を直接実行した時もコンソール画面を表示する 1 つの方法 |
program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
function GetConsoleWindow: HWND; stdcall; external kernel32;
//----------------------------------------------------------------------------
// SetConsoleCtrlHandler 関数のコールバック関数
//
// 戻り値が True の時
// OS は何もしない
//
// 戻り値が False の時
// イベントは OS が処理する
// ex. [CTRL] + [C] 押下でアプリケーション終了
// ex. [CTRL] + [BREAK] 押下でアプリケーション終了
//----------------------------------------------------------------------------
function HandlerRoutine(dwCtrlType: DWORD): BOOL; stdcall;
begin
Result := True;
end;
var
LKeyFlag : Boolean;
LhConsole : HWND;
LOldStyle : Cardinal;
LNewStyle : Cardinal;
LhSysmenu : hMenu;
begin
LKeyFlag := ((GetKeyState(VK_SHIFT) and $8000) <> 0)
and ((GetKeyState(VK_CONTROL) and $8000) <> 0);
// FIsDebug はクラスのメンバではないグローバル変数
if (DebugHook <> 0) or LKeyFlag then begin
FIsDebug := True;
AllocConsole;
// イベントハンドラルーチンの設定
SetConsoleCtrlHandler(@HandlerRoutine, True);
// コンソールのウィンドウハンドルを取得
LhConsole:= GetConsoleWindow;
// [最小化] [最大化] ボタンを非表示にする
LOldStyle := GetWindowLong(LHConsole, GWL_STYLE);
LNewStyle := LOldStyle and not WS_MINIMIZEBOX and not WS_MAXIMIZEBOX;
SetWindowLong(LhConsole, GWL_STYLE, LNewStyle);
// メニューのハンドルを取得
LhSysmenu := GetSystemMenu(LHConsole, False);
// [閉じる] の機能を無効化
// 終了はあくまでもコンソールを起動したアプリ側で実行
DeleteMenu(LhSysMenu, SC_CLOSE, MF_BYCOMMAND);
end;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
FIsDebug : Boolean;
implementation
{$R *.dfm}
function GetConsoleWindow: HWND; stdcall; external kernel32;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeConsole;
end;
//=============================================================================
// コンソール画面の操作
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LhStdout : THandle;
LColor : Word;
begin
if FIsDebug then begin
SetConsoleTitle('Console Test');
//標準出力のハンドルを取得
LhStdout := GetStdHandle(STD_OUTPUT_HANDLE);
//文字の色を明るい白にする
LColor := FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED or 8;
SetConsoleTextAttribute(LhStdout, LColor);
Writeln('デバック時だけコンソール画面を起動');
end;
end;
//=============================================================================
// コンソール画面の表示・非表示のトグル操作
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LhConsole : HWND;
begin
if FIsDebug then begin
// コンソールのウィンドウハンドルを取得
LhConsole:= GetConsoleWindow;
if IsWindowVisible(LhConsole) then begin
ShowWindow(LhConsole, SW_HIDE);
end else begin
ShowWindow(LhConsole, SW_SHOW);
end;
end;
end;
end.
ここまでのサンプルは,EXE 起動と同時にコンソール画面を起動,あるいは実行時にコンソール画面を起動する例です.本サンプルは,既に起動しているコンソールアプリを操作する例です.
コンソールアプリケーシヨンは,コマンドプロンプト (コマンドプロセッサ) 上で動作するアプリケーションです.以下の参考リンクのサンプルプログラムと同じように,AttachConsole 関数でコンソールアプリのスレッドにアタッチすることで操作可能になります.
本サンプルは,コンソールウィンドウのタイトル (キャプション) を変更して,文字の色を変更するだけの単純な操作例です. |
|
図8
起動中のコンソールアプリにアタッチして操作 |
リスト8
既に起動していいるコンソールアプリを操作する例 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function AttachConsole(dwProcess: DWORD): BOOL; stdcall; external 'kernel32.dll';
//=============================================================================
// 起動中のコンソール画面に対する操作
// 起動中のコンソール画面には AttachConsole でアタッチする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LhConsoleWnd : HWND;
LProcessID : Cardinal;
LhStdout : THandle;
LColor : Word;
begin
// コンソール画面のウインドウハンドルを取得
LhConsoleWnd := FindWindow('ConsoleWindowClass', nil);
// スレッドのプロセスIDを取得
GetWindowThreadProcessId(LhConsoleWnd, @LProcessID);
//コンソールのスレッドにアタッチ
if AttachConsole(LProcessID) then begin
// 標準出力のハンドルを取得
LhStdout := GetStdHandle(STD_OUTPUT_HANDLE);
SetConsoleTitle('コンソールのテスト');
Writeln('文字の色を変更');
// 文字の色を,緑と赤で黄色にする
LColor := FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY;
SetConsoleTextAttribute(LhStdout, LColor);
// FreeConsoleでデアタッチしておく
FreeConsole;
end;
end;
//=============================================================================
// 起動中のコンソール画面を閉じる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LhConsoleWnd : HWND;
begin
// コンソール画面のウインドウハンドルを取得
LhConsoleWnd := FindWindow('ConsoleWindowClass', nil);
if LhConsoleWnd <> 0 then begin
PostMessage(LhConsoleWnd, WM_CLOSE, 0, 0);
end;
end;
end.
{$APPTYPE CONSOLE}
program consoleApp;
uses
Forms,
Windows,
SysUtils;
function GetConsoleWindow: HWND; stdcall; external kernel32;
var
LhConsole : HWND;
LOldStyle : Cardinal;
LNewStyle : Cardinal;
LResult : string;
begin
// [Ctrl] + [C] で閉じないようにする
SetConsoleCtrlHandler(nil, True);
// ウィンドウハンドルを取得
LhConsole := GetConsoleWindow;
// [最小化] [最大化] ボタンを非表示にする
LOldStyle := GetWindowLong(LhConsole, GWL_STYLE);
LNewStyle := LOldStyle and not WS_MINIMIZEBOX and not WS_MAXIMIZEBOX;
SetWindowLong(LhConsole, GWL_STYLE, LNewStyle);
while True do begin
Readln(LResult);
if UpperCase(LResult) = 'EXIT' then Exit;
end;
end.
ウィンドウの閉じるボタン [X] は,次のコードで無効化できます.ウィンドウの閉じるボタンは非表示にできません. |
// ウィンドウのシステムメニューのハンドルを取得
// LhSysmenu は HMENU 型の変数
LhSysmenu := GetSystemMenu(LhConsole, False);
// 閉じるメニューを無効化
DeleteMenu(LhSysMenu, SC_CLOSE, MF_BYCOMMAND);
|