ColorCheckbox を StyleElements で実装できるかどうか

DEKO さんの「TCheckBox の文字色と背景色を変えたい (Delphi) 」で、XE3 であれば StyleElements があるので VCL Style 適用時であれば比較的簡単に実装できるのではないかと思い、やってみました。

結論からいうと、そうでもなかったです。

まず、VCL Style を設定しているアプリケーションのメインフォームに、次の画像のように CheckBox1, CheckBox2 を置きました。
そして、CheckBox2 の StyleElements を [] にしました。



これを実行すると以下のようになりました。



CheckBox2 は、VCL Style ではなく、Windows のデフォルトで表示されています。
全ての Style を無効にしたので、当然の結果です。

次に、StyleElements に [seClient, seBorder] を指定して、フォントにはスタイルが要りません！宣言をします。
そして、Font.Color プロパティに clAqua を入れ、実行すると次のようになりました。



このように、フォント色は簡単に変更できることが判ります。

では、ここで StyleElements から seClient を抜いて、Color プロパティに clRed を指定してやれば、クライアント領域が赤で塗りつぶされそうな気がします。

しかし、結果は、下図のようになり、期待した動作にはなりませんでした。



実はクライアント領域は TStyleHook の方で seClient が入っていなければ、元々の動作をするように組まれているのです。

そのため、seClient を抜いても、Color プロパティで背景は描画されません。

TLabel の場合、元々背景色を塗りつぶす機能があるため、StyleElements から seClient を抜き、Transparent プロパティを False に設定すると、指定した色で背景が描画できます。

これを解決するためには、TCheckBox 用の新しい StyleHook を作る他ありません。

そこで、作ってみました。
できあがった StyleHook のソースは以下のようになります。

unit uCheckBoxStyleHookEx;
 
interface
 
uses
  System.Types, Winapi.Messages, System.Classes, Vcl.Graphics, Vcl.Controls,
  Vcl.StdCtrls, Vcl.Themes;
 
type
  TCheckBoxStyleHookEx = class(TCheckBoxStyleHook)
  protected
    procedure PaintBackground(Canvas: TCanvas); override;
    function AcceptMessage(var Message: TMessage): Boolean; override;
  end;
 
implementation
 
{ TCheckBoxStyleHookEx }
 
function TCheckBoxStyleHookEx.AcceptMessage(var Message: TMessage): Boolean;
begin
  // StyleElements が、どのような値であっても描画処理はこちらで行う
  Result := True;
end;
 
procedure TCheckBoxStyleHookEx.PaintBackground(Canvas: TCanvas);
var
  tmpRect: TRect;
  ElementSize: TElementSize;
  BoxSize: TSize;
begin
  // 元の描画処理を呼び出して、チェックボックスの図形などを書いて貰う
  inherited;
 
  // クライアント領域の描画が入っていない場合
  if not (seClient in Control.StyleElements) then begin
    // チェックボックス図形の大きさを求める
    tmpRect := Rect(0, 0, 20, 20);
    ElementSize := esActual;
 
    with StyleServices do
      if
        not GetElementSize(
          Canvas.Handle,
          GetElementDetails(tbCheckBoxCheckedNormal),
          tmpRect,
          ElementSize,
          BoxSize)
      then begin
        BoxSize.cx := 13;
        BoxSize.cy := 13;
      end;
 
    // チェックボックス図形の分を矩形から取り除く
    tmpRect := Control.ClientRect;
    Inc(tmpRect.Left, BoxSize.cx);
 
    // Color プロパティの色で背景を塗りつぶす
    Canvas.Brush.Color := TCheckBox(Control).Color;
    Canvas.FillRect(tmpRect);
  end;
end;
 
initialization
begin
  // TCheckBoxStyleHookEx を TCheckBox の Style Hook とする
  TCustomStyleEngine.RegisterStyleHook(TCheckBox, TCheckBoxStyleHookEx);
end;
 
finalization
begin
 
end;
 
end.

ポイントは、AcceptMessage で返す値を必ず True にして、描画処理をこちらで受け持つ所です。
これにより、必ず PaintBackground が呼び出されるため、背景色を自由に設定できます。
また、元々の描画処理も呼び出しているので、TFont.Color も何もしなくても効きます。
この TCheckBoxStyleHookEx を uses して実行した結果が次の画像です。



期待通り、TForm.Color と Font.Color が効いています。

結局、StyleHook を使わないと簡単にはできないんだね、という結論でした。

上記の例では StyleElements を [seBorder] にして実行しました。
もしも StyleElements を [] にすると、どうなるでしょうか？
StyleElements を [] にして実行すると、素の Windows のコントロールが描画されます。
AcceptMessage が True を返しているにも関わらず、です。
これは、TWinControl.WndProc の中で、StyleElements が [] だったら、スタイル処理を実行しない、という部分(Vcl.Controls.pas 9892 行目)があるためです。
そのため、StyleElements が [] の状態だと、スタイル処理が実行されず、素の Windows のコントロールが描画されてしまうのです。
個人的には、この if 文は要らないと思います（※）が、仕様ともいえるため QuolityCentral には報告していません。

※変更する手段が無いため。
Control.WindowProc でウィンドウプロシージャを変更しても、その時点では StyleHook を設定できない。

管理者権限で起動する CMD

ソースはこちら(GitHub)

開発していると、結構コマンドプロンプト（CMD.exe）を実行することがあります。
普通に CMD.exe を起動すると、普通の権限で起動します。
しかし、管理者権限でのみ動作するようなプログラムなどを起動したい場合に、一々 UAC が開くのは煩わしいものです。
かといって「管理者としてこのプログラムを起動する」っていうチェックをいれるというのも、いまいちです。
というのも、もしも顧客に対して提供するコマンドラインツールがあったとすると、「このコマンドを実行して下さい。このコマンドは管理者権限で～云々」と説明しなくてはならないためです（しかも正しく伝わる確率の方が低い！）。
そこで、管理者権限で起動する CMD.exe を作ってみます。

ポイントは３つ。

１つ目は、CMD.exe のパスの取得です。
CMD.exe のパスの取得はいくつかやり方があります。
まずは SHGetSpecialFolderLocation を使って「Windows\System32」のパスを取得し、そのパスに CMD.exe を結合して実行する方法です。
とても真っ当な方法ですが ItemIDList を取得したりと、何かと面倒です。
そこで、もう１つの方法「環境変数」から取得することにします。
環境変数「ComSpec」は、CMD.exe のパスを示す環境変数です。
取得した環境変数を展開して有効なパスに変換する API が ExpandEnvironmentStrings です。
これを使って「%ComSpec%」という環境変数を「C:\Windows\System32\cmd.exe」に変換します。

２つ目は、管理者権限での実行です。
とても有名なので既にご存じかも知れませんが、ShellExecuteEx の lpVerb に 'runas' を指定して、プログラムを実行すると UAC が開いて管理者権限で実行できます。
これについては過去のデベロッパーキャンプでエンバカデロの高橋さんが説明(pdf)されています。

３つ目は、起動しても自分自身は見せずに CMD.exe だけを実行する方法です。
プログラムを一個起動するだけなので {$APPTYPE CONSOLE} で、コンソールアプリとして実装すれば良さそうに見えますが、そうするとコンソールが開いてしまいます。
そこで、今回は何も指定しない、つまり {$APPTYPE GUI} としてアプリケーションを作る事にします。
こうすることで、開く Window（TForm）が存在しないため、何も表示せずにアプリケーションを実行可能です。

これらを踏まえたコードが下記です。

program AdminCMD;
 
// 自分を表示したくないので指定しない
//{$APPTYPE CONSOLE}
 
uses
  Winapi.Windows, Winapi.ShellApi, System.SysUtils;
 
// 管理者権限で実行する
function RunAsAdmin(const iExeName, iParam: String): Boolean;
var
  SEI: TShellExecuteInfo;
begin
  Result := False;
 
  // runas は、Vista 以降のみ動作する
  if (CheckWin32Version(6)) then begin
    ZeroMemory(@SEI, SizeOf(SEI));
 
    with SEI do begin
      cbSize := SizeOf(SEI);
      Wnd := 0;
      fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
      lpVerb := 'runas';
      lpFile := PChar(iExeName);
      lpParameters := PChar(iParam);
      nShow := SW_SHOW;
    end;
 
    Result := ShellExecuteEx(@SEI);
  end;
end;
 
var
  CmdPath: String;
begin
  // 環境変数から CMD.exe のパスを取得する
  CmdPath := StringOfChar(#0, MAX_PATH);
  ExpandEnvironmentStrings(
    PChar('%ComSpec%'),
    PChar(CmdPath),
    Length(CmdPath));
 
  CmdPath := Trim(CmdPath);
 
  // 管理者権限で実行
  RunAsAdmin(CmdPath, '');
end.

このコードを実行すると……



UAC の確認ダイアログが出た後に



コマンドプロンプトが開きます。
使いどころを誤らなければ、便利なコマンドプロンプトだと思います。

IME が ATOK か見分ける

ごくごく希に IME をいじる時があります。
そして、MS-IME と ATOK で違う動作をさせたいなーという事が、すごっく希にあります。

そんなとき、Screen.Imes や Screen.DefaultIme で IME の名前を取れば、ATOK かそうでないかが見分けられます。

たとえば、次のような関数で ATOK かどうかを見分けられます。

function IsATOK: Boolean;
begin
  Result := (Screen.DefaultIme.IndexOf('ATOK') > -1);
end;

また、Screen.Imes.Objects[] プロパティには「入力ロケール識別子」（旧名：キーボードレイアウト）が入っています。 あるエディットコントロールでは、この識別子、また別の時には別の識別子、を指定して ActiveKeyboardLayout API を呼び出して、IME を指定したりすることもできます。

（Screen.DefaultKbLayout というデフォルトの入力ロケール識別子を返すプロパティもあります。）

痛 VCL Style

ソースはこちら(GitHub)
クラウディアさんはこちら

Delphi Advent Calendar 2012 12/25 の記事です。

タイトルにある通りのことをしてみたいと思ったわけです。
これは、Delphi Advent Calendar 2012 の 12/14 の Lyna さんの記事「IDEにおける背景変更機能の導入による開発効率への影響とその考察。」（痛IDE）に触発されてのことです。

VisualStudio の痛背景画像では開発環境しか変えられないけど、Delphi だったら Style 使えば簡単に「痛アプリ」が作れちゃうもんね！という思いから始めたわけですが、TForm だけ、かなり特殊じゃん……と気づかされました。

手始めに、こんなスタイルを作ってみました。



Metropolis UI の Blue スタイルにクラウディアを追加するという形で。

Images に画像を「追加」することができるのですが、うまくいきませんでした。
様々な例外が上がります。
また、上記のような一体化画像を作った際は「更新」ボタンを使って画像を更新しないと、酷い目に遭います。
Objects 以下のオブジェクトは全部、現在の画像を指しているので「削除」してから「追加」とすると、Objects 以下の全オブジェクトが例外を吐きます……。

それで、Objects/Form/Image/Client にクラウディアを設定してみました。



この結果何が起こるかというと……



思ってたのと違う！！いや合ってるけど！でも違う！
タイリング表示されました……
なんとか右下にクラウディアたんが佇んでくれないかと。
かといって TileStyle には、そんな都合のいい値はありません。

そもそも、tsTile 以外の値を設定すると、再描画が上手くされません。
これは、スタイルの描画方法に起因しています。
このような一部分が他と違うようなものを想定していないためです。

何時間か、弄っていたのですが、これでは拉致があかない！と、方法を改めることにしました。
TClaudiaFormStyleHooke を作る事にしたのです。
しかし、これも簡単にはいきませんでした。
何故かと言うと TCustomForm と TFormStyleHook が完全に癒着していて、TForm に他の StyleHook が設定できる想定がされていなかったためです。

しかし、最終的にはなんとかなりました。



結構苦労しましたが、使い方は簡単です。
uClaudiaFormStyleHook をプロジェクトファイルに uses するだけです。
※アプリケーションに VCL Style が設定されている必要があります。

program Project1;
 
uses
  Vcl.Forms,
  Vcl.Themes,
  Vcl.Styles,
  Unit1 in 'Unit1.pas' {Form1},
  uClaudiaFormStyleHook;
 
{$R *.res}
 
begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  TStyleManager.TrySetStyle('Auric');
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

詳しい構造は、ソース内のコメントをご覧ください。

unit uClaudiaFormStyleHook;
 
interface
 
uses
  Winapi.Windows, Vcl.Controls, Vcl.Graphics, Vcl.Forms, Vcl.Themes,
  Vcl.Imaging.pngimage;
 
type
  // クラウディアたんを右下に表示する Style Hook
  TClaudiaFormStyleHook = class(TFormStyleHook)
  private
    FClaudia: TPngImage;
  protected
    procedure PaintBackground(Canvas: TCanvas); override;
  public
    constructor Create(iControl: TWinControl); override;
    destructor Destroy; override;
  end;
 
implementation
 
uses
  System.Classes, System.SysUtils;
 
{ TClaudiaFormStyleHook }
 
constructor TClaudiaFormStyleHook.Create(iControl: TWinControl);
begin
  inherited;
 
  // PNG Image を生成
  FClaudia := TPngImage.Create;
 
  // クラウディアの画像を読み出す
  FClaudia.LoadFromFile(ExtractFilePath(Application.ExeName) + '\Claudia.png');
end;
 
destructor TClaudiaFormStyleHook.Destroy;
begin
  // PNG Image を破棄
  FClaudia.Free;
 
  inherited;
end;
 
// WM_ERASEBKGND が来たときに呼ばれるメソッド
procedure TClaudiaFormStyleHook.PaintBackground(Canvas: TCanvas);
var
  FormCanvas: TCanvas;
  Back: TBitmap;
begin
  // まず親の PaintBackground を呼び、このフォームに乗っている
  // 子コントロール分の背景を描画する
  inherited;
 
  // 背景用 Bitmap を作る
  Back := TBitmap.Create;
  try
    with Back, Canvas do begin
      // 大きさは、フォームのクライアントエリアと同じ
      SetSize(Control.Width, Control.Height);
 
      // 背景色で塗りつぶす
      Brush.Color := StyleServices.GetStyleColor(scWindow);
      FillRect(Rect(0, 0, Width, Height));
 
      // クラウディアを右下に描画する
      Draw(Width - FClaudia.Width, Height - FClaudia.Height, FClaudia);
    end;
 
    // フォームに描画するための Canvas を作る
    // 引数の Canvas は、TBitmap の Canvas でしかないため
    // Canvas に Draw しても描画されない
    FormCanvas := TCanvas.Create;
    try
      // デバイスコンテキストを取得
      FormCanvas.Handle := GetDC(Control.Handle);
      try
        // 背景用 Bitmap を描画する
        FormCanvas.Draw(0, 0, Back);
      finally
        ReleaseDC(Control.Handle, FormCanvas.Handle);
      end;
    finally
      FormCanvas.Free;
    end;
  finally
    Back.Free;
  end;
end;
 
initialization
begin
  // まず TFormStyleHook を TCustomForm から外さないと
  // TClaudiaFormStyleHook は呼ばれない
  TCustomStyleEngine.UnregisterStyleHook(TCustomForm, TFormStyleHook);
 
  // TClaudiaFormStyleHook を TCustomForm の StyleHook として設定
  TCustomStyleEngine.RegisterStyleHook(TCustomForm, TClaudiaFormStyleHook);
end;
 
finalization
begin
  // TCustomForm はアプリケーションが終わり破棄されるとき TFormStyleHook を
  // UnregisterStyleHook しようとする。
  // そのため、ここで StyleHook に TFormStyleHook を登録してやる。
  // 登録しないと、例外が発生する
  TCustomStyleEngine.RegisterStyleHook(TCustomForm, TFormStyleHook);
end;
 
end.

少し時間が掛かってしまいましたが、Delphi は Style という手法を手に入れたため、uses するだけで簡単に背景を変更できます。
他の環境では、WM_ERASEBKGND を地道に変更したりと、Delphi のように簡単には行かないでしょう。

というわけで、今回は VCL スタイルについて、痛StyleHook を作ってみました。

FireMonkey のスタイルでも同じ物を作ろうと思ったのですが、上手く行きませんでした。
これは、僕がまだ FireMonkey を使いこなしていないためです。
他の方がやってくれるかも知れません……！

ということで、この記事を、Delphi Advent Calendar 2012 のトリとさせていただきます。
２５日間、記事を書いてくださった皆さん、記事をご覧いただいた皆さん、お付き合いくださりありがとうございました！
また、来年もやりたいです！

それでは、皆さん、良いお年を！

コンソールアプリケーション４-コンソールをデバッグに使う（Delphi Advent Calendar 2012-12-2４）

ソースはこちら(GitHub)

Delphi Advent Calendar 2012 12/24 の記事です。

前回までで、コンソールの基礎的な事柄を述べました
今回 GUI アプリケーションで、コンソールを使う方法を紹介します。
（ずっとコンソールについて書いてきましたが、結局これがやりたかった！）

GUI アプリでも、デバッグ時に現在の状態を表示するためにログを出したりする事が多々あります。
その場合、TMemo をアプリに配置して、そこに Lines.Add('メッセージ')などとしている事が多いのでは無いでしょうか？
しかし、Lines.Add だと数字は IntToStr() で文字列に変換しないと表示できないですし、そもそもデバッグの為だけに TMemo を置くのも馬鹿らしいです。

コンソールが使えれば、それらの悩みも一挙解決です。
コンソールを表示するために、何かインスタンスを作る必要も無いですし、Writeln を使えば文字列も数値も一緒くたに表示できるからです。
しかも、コンソールは表示するだけではなく読み取ることもできます。
コンソールから文字列を受け取って、それに応じてアプリの状態を変更したりできます（デバッグ時に非常に役に立つでしょう）。

GUI アプリでコンソールを使うには２つ方法があります。
１つは CreateProcess の引数に CREATE_NEW_CONSOLE を付ける方法、
もう１つは、AllocConsole を使う方法です。

CREATE_NEW_CONSOLE を使う方法は、アプリの起動時（CreateProcess を呼び出した時）に指定する必要があるため、今回は使えません（自分で自分を呼び出すことはできないため）。
そこで、今回は AllocConsole を使います。
FormCreate でコンソールを割り当て、FormDestroy でコンソールの割り当てを解除しています。

procedure TForm1.Button1Click(Sender: TObject);
begin
  // コンソールに文字列を出力
  Writeln('Hello, Console !');
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  // コンソールを割り当て
  AllocConsole;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  // 割り当てたコンソールを開放
  FreeConsole;
end;

Button1 を押すとコンソールに文字列が表示されました！

なお、コンソールが無い状態で Writeln や Readln を呼び出すと「I/O エラー」が発生します。

では、この仕組みを使いやすくライブラリ化し、簡単にデバッグメッセージを出力できるようにしてみます。
それぞれ詳細はコード中のコメントを参照してください。

まず先に使い方です。
コンソールアプリケーションと同様に Writeln/Readln が普通に使えます。
ここでは Readln を使う代わりに、ライブラリ化した関数 ReadConsole を使っています。

procedure TForm1.Button1Click(Sender: TObject);
begin
  // 文字列の表示
  Writeln('Hello, World !');
 
  // 数字や Boolean、文字列などを混在して表示できる
  Writeln(123456789, ' ', True);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  Str: String;
begin
  // 命令をコンソールから読み取る
  Str := ReadConsole('Input Command: ', True);
 
  // exit なら終了
  if (Str = 'exit') then
    Close
  // notepad なら「メモ帳」を起動
  else if (Str = 'notepad') then
    WinExec('notepad.exe', SW_SHOW)
  // それ以外なら不明と表示
  else
    Writeln('Unknown command:', Str);
end;

uConsole.pas

unit uConsole;
 
interface
 
type
  // コンソールイベント
  TConsoleEventType = (
    ceC,       // CTRL + C が押された
    ceBreak,   // CTRL + BREAK が押された
    ceClose,   // コンソールウィンドウが閉じられた
    ceLogOff,  // ログオフされた
    ceShutdown // シャットダウンされた
  );
 
  // コンソールイベント型
  TConsoleEvent = procedure(const iType: TConsoleEventType) of object;
 
// コンソールイベントを受け取るリスナーを追加・解除
procedure AddConsoleEventListener(const iListener: TConsoleEvent);
procedure RemoveConsoleEventListener(const iListener: TConsoleEvent);
 
// コンソールから文字列を読み取る
function ReadConsole(
  const iPrompt: String = '';
  const iToLower: Boolean = False): String;
 
implementation
 
uses
  Winapi.Windows,  Generics.Collections, System.SysUtils;
 
var
  // コンソールウィンドウのハンドル
  GWnd: HWND;
  // イベントリスナを管理するリスト
  GListeners: TList<TConsoleEvent>;
 
// コンソールイベントリスナを追加
procedure AddConsoleEventListener(const iListener: TConsoleEvent);
begin
  if (GListeners.IndexOf(iListener) < 0) then
    GListeners.Add(iListener);
end;
 
// コンソールイベントリスナを削除
procedure RemoveConsoleEventListener(const iListener: TConsoleEvent);
begin
  if (GListeners.IndexOf(iListener) > -1) then
    GListeners.Remove(iListener);
end;
 
// コンソールから文字列を読み取る
// iPrompt  読み取り前に表示する文字列（ex. 'Please input your name: '）
// iToLower 読み取った文字列を小文字にするなら True
function ReadConsole(
  const iPrompt: String = '';
  const iToLower: Boolean = False): String;
begin
  // プロンプトの表示
  if (iPrompt <> '') then
    Write(iPrompt);
 
  // コンソールに入力フォーカスを与える
  ShowWindow(GWnd, SW_SHOW);
  SetForegroundWindow(GWnd);
 
  // 読み込む
  Readln(Result);
 
  // 小文字化
  if (iToLower) then
    Result := LowerCase(Result);
end;
 
// コンソールイベントが起きたときに呼ばれる関数
function HandlerRoutine(dwCtrlType: DWORD): BOOL; stdcall;
var
  Listener: TConsoleEvent;
begin
  Result := True; // False の場合、イベントは OS が適切に処理する
                  //（ex. CTRL + C が押されたらアプリケーションを終了させる）
                  // True の場合、OS は何もしない
 
  for Listener in GListeners do
    Listener(TConsoleEventType(dwCtrlType));
end;
 
// コンソールの初期設定
// ・コンソールの Window Handle の特定
// ・コンソールのタイトルの設定
procedure InitConsole;
var
  Cap: String;
begin
  // Window Caption に GUID を設定する
  Cap := TGUID.NewGuid.ToString;
  SetConsoleTitle(PWideChar(Cap));
 
  Sleep(40); // Caption が確実に設定されるために 40[msec] 待つ
             // http://support.microsoft.com/kb/124103/ja
 
  // GUID でウィンドウを探す
  GWnd := FindWindow(nil, PChar(Cap));
 
  if (GWnd <> 0) then
    // 見つけたらスタイルから System Menu を外す
    //（コンソールを勝手に閉じられないようにするため）
    SetWindowLong(
      GWnd,
      GWL_STYLE,
      GetWindowLong(GWnd, GWL_STYLE) and not WS_SYSMENU);
 
  // コンソールのタイトルをアプリケーションのパスにする
  SetConsoleTitle(PWideChar(ParamStr(0)));
end;
 
// 初期化
initialization
begin
  // イベントハンドラ管理用リストの生成
  GListeners := TList<TConsoleEvent>.Create;
 
  // アプリケーションにコンソールを割り当てる
  AllocConsole;
 
  // コンソールイベントのハンドラを設定する
  SetConsoleCtrlHandler(@HandlerRoutine, True);
 
  // コンソールの初期設定
  InitConsole;
end;
 
// 終了処理
finalization
begin
  // コンソールイベントのハンドラを解除
  SetConsoleCtrlHandler(@HandlerRoutine, False);
 
  // 割り当て済みのコンソールを解除
  FreeConsole;
 
  // イベントハンドラ管理用リストの破棄
  GListeners.Free;
end;
 
end.

実行すると、こんな風になります。

コンソールアプリケーション３（Delphi Advent Calendar 2012-12-21）

ソースはこちら(GitHub)

Delphi Advent Calendar 2012 12/21 の記事です。

前回、コンソールアプリケーションで Read/Write について述べました。
今回は、Read/Write の標準入出力先を変更してみます。
Read/Write にはファイル変数を指定することで、ファイルに値を出力したり、値をファイルから読み出したりできます。
しかし、それはあくまで入出力先を変数として与えただけで、標準入出力先が変わった訳ではありません。
それでは、標準入出力先を変更するにはどうすれば良いのでしょうか？

StartUpInfo に、その鍵があります。

StartUpInfo とは、CreateProcess でプロセスを生成するときに渡すパラメータの１つです。
StartUpInfo は構造体ですが、ここに次の重要なパラメータがあります。

hStdInput	標準入力のハンドル
hStdOutput	標準出力のハンドル
hStdError	標準エラー出力のハンドル

このパラメータの説明にあるとおり、ここにハンドルを指定することで、標準入出力先を変更できるのです！
ちなみに、UNIX では、標準入力のハンドルは 0, 標準出力のハンドルは 1 と、決まった値になっています。
Windows の場合は、ハンドルは決まっていません。
その代わり GetStdHandle という API を使って標準入出力のハンドルを取得できます。

それはそうと、実際に標準入出力先を変更してみます。
ハンドルに指定できるのは CreateFile などで返されるハンドルです。
つまり、ファイルハンドルを指定すれば、ファイルに出力されます。

今回はパイプを使おうと思います。

パイプを作るには CreatePipe という関数を使います。
パイプは WriteHandle に対して書き込まれた値を ReadHandle で読み出すことができる通信路です。

とりあえず、今回のソースを全文記載します。

001 program Project1;
002  
003 {$APPTYPE CONSOLE}
004  
005 uses
006   System.SysUtils, Winapi.Windows;
007  
008 function Exec(const iCommand, iParam: String): String;
009 var
010   ReadHandle, WriteHandle: THandle;
011   SA: TSecurityAttributes;
012   SI: TStartUpInfo;
013   PI: TProcessInformation;
014   Buffer: RawByteString;
015   Len: Cardinal;
016  
017   // パイプから値を読み出す
018   procedure ReadResult;
019   var
020     Count: DWORD;
021     ReadableByte: DWORD;
022     Data: RawByteString;
023   begin
024     // 読み出しバッファをクリア
025     ZeroMemory(PRawByteString(Buffer), Len);
026  
027     // パイプに読み出せるバイト数がいくつあるのか調べる
028     PeekNamedPipe(ReadHandle, PRawByteString(Buffer), Len, nil, nil, nil);
029     ReadableByte := Length(Trim(String(Buffer)));
030  
031     // 読み込める文字列があるなら
032     if (ReadableByte > 0) then begin
033       while
034         (ReadFile(ReadHandle, PRawByteString(Buffer)^, Len, Count, nil))
035       do begin
036         Data := Data + RawByteString(Copy(Buffer, 1, Count));
037  
038         if (Count >= ReadableByte) then
039           Break;
040       end;
041  
042       Result := Result + Data;
043     end;
044   end;
045  
046 begin
047   Result := '';
048  
049   ZeroMemory(@SA, SizeOf(SA));
050   SA.nLength := SizeOf(SA);
051   SA.bInheritHandle := True;
052  
053   // パイプを作る
054   CreatePipe(ReadHandle, WriteHandle, @SA, 0);
055   try
056     // StartInfo を初期化
057     ZeroMemory(@SI, SizeOf(SI));
058     with SI do begin
059       cb := SizeOf(SI);
060       dwFlags := STARTF_USESTDHANDLES; // 標準入出力ハンドルを使います！宣言
061       hStdOutput := WriteHandle;       // 標準出力を出力パイプに変更
062       hStdError := WriteHandle;        // 標準エラー出力を出力パイプに変更
063     end;
064  
065     // プロセスを作成
066     if (not CreateProcess(
067       PChar(iCommand),
068       PChar(iParam),
069       nil,
070       nil,
071       True,
072       0,
073       nil,
074       nil,
075       SI,
076       PI))
077     then
078       Exit;
079  
080     // 読み出しバッファを 4096[byte] 確保
081     SetLength(Buffer, 4096);
082     Len := Length(Buffer);
083  
084     with PI do begin
085       // プロセスが終了するまで、パイプを読み出す
086       while (WaitForSingleObject(hProcess, 100) = WAIT_TIMEOUT) do
087         ReadResult;
088  
089       ReadResult;
090  
091       // プロセスを閉じる
092       CloseHandle(hProcess);
093       CloseHandle(hThread);
094     end;
095   finally
096     // パイプを閉じる
097     CloseHandle(WriteHandle);
098     CloseHandle(ReadHandle);
099   end;
100 end;
101  
102 begin
103   // dir の結果を出力
104   Writeln(Exec('C:\Windows\System32\CMD.exe', '/C dir'));
105   Readln;
106 end.

このソースコードでは、コマンドラインで dir を呼んだ結果を表示します。
結果は、こんな風になります。



重要なのは 60～62 行の StartUpInfo の初期化部です。
前に記載したとおり hStdOutput, hStdError にパイプの書き込みハンドルを入れています。
この hStdOutput と hStdError を有効にするためにフラグに STARTF_USESTDHANDLES を代入しています。
この値を設定しないと標準入出力ハンドルは使用されません。

そして、起動されたコンソールアプリケーションは、設定された書き込み用パイプハンドル（WriteHandle）に値を書き込みます。
値は読み込み用パイプハンドル（ReadHandle）からから読み出すことができます（34行目）。

このようにちょっと手間ですが、標準入出力の値を変更することができました。

次回は、これらの API を使ってコンソールをデバッグ用出力として使う方法を紹介したいと思います。

コンソールアプリケーション２（Delphi Advent Calendar 2012-12-18）

Delphi Advent Calendar 2012 12/18 の記事です。

前回、コンソールアプリケーションで Write/Writeln について述べました。
今回は、Read についても紹介したいと思います。

Read は前回の記事でも紹介したように標準入力から値を読み出す関数です。
ただ、前回は Readln; と書いて、開業を待っただけでした。
今回は、きちんと値を読み込んでいます。
非常に簡単で、次のように書くだけです。

01 program Project1;
02  
03 {$APPTYPE CONSOLE}
04  
05 var
06   Str: String;
07 begin
08   Write('文字列を入力してください: ');
09   Readln(Str);
10   Writeln('入力された文字列は "' + Str + '" です');
11   Readln;
12 end.

上記のコード９行目で行を読み込んでいます。
Readln なのでエンターキー（リターンキー）が入力されるまで読み込みます。
たとえば、上の行を Read に変えるとどうなるかというと……

01 program Project1;
02  
03 {$APPTYPE CONSOLE}
04  
05 var
06   Str: String;
07 begin
08   Write('文字列を入力してください: ');
09   Read(Str); // 改行コードまで文字列を読み込むが、改行コード自体は読み込まない
10   Writeln('入力された文字列は "' + Str + '" です');
11   Readln;    // 9行目で入力された改行コードをここで読み込むのですぐ終わってしまう
12 end.

一瞬でコンソールが閉じます。
というのも、結局 Read は値を読み込む区切りにエンターキーを利用しています。
上のコメントにあるとおり、改行コードを入れないと文字列の読み込みが終わらないからです。

また、Write/Writeln と同じように複数の値を読み込むこともできます。
複数の値を読み込むには、下記の様にします。

program Project1;
 
{$APPTYPE CONSOLE}
 
var
  Str: String;
  Int: Integer;
begin
  Write('文字列と数値を入力してください: ');
  Readln(Str, Int); // こういう入力もできるが、各値を取得するためには改行が必要
  Writeln('入力された文字列は "', Str, '" 数値は "', Int, '" です');
  Readln;
end.

しかし、コメントにあるとおり、値を１つ確定する毎に改行が必要なので、実行結果はこんな風になります。



ですので、結局 Read を使うときは Readln として、１個１個値を呼んでいくのが良いでしょう。

次回は、いままで紹介した標準入出力をプログラムから変更する方法を紹介します。