痛 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 として、１個１個値を呼んでいくのが良いでしょう。

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

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

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

ちょっとした値の出力や関数・メソッドのテストに便利な、コンソールアプリケーションについて、述べてみます。

コンソールアプリケーションは、その名の通り、コンソール（コマンドプロンプト）で動作するアプリケーションです。
コンソールアプリケーションは、標準入力から値を受け取り、標準出力へ値を出力します。

標準入力	キーボードなど
標準出力	ディスプレイなど

標準エラー出力という物もあります。
これは、エラーが発生したときにエラー情報を出力する場所です。
基本的には標準出力と同じ「ディスプレイ」となっていることが多いようです。
しかし、これを変更することも可能です。
例えば、標準出力の出力先は「ディスプレイ」、標準エラー出力の出力先は「外部接続」とすることもできます。

なにはともあれ、実際に作ってみます。

「ファイル」→「新規作成」→「その他...」を選んで新規作成ダイアログを開いたところです。



ここで「コンソールアプリケーション」を選びます。
すると、次のようなコードが開きます。

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

例外処理とかが入っているステキなスケルトンができますが、今回の記事には邪魔なのですっきりさせます。
すっきりさせたのが下記です。

program Project1;

{$APPTYPE CONSOLE}

begin
end.

{$APPTYPE CONSOLE} は、コンパイラ指令です。
コンパイラに、このアプリケーションはコンソールアプリケーションであることを指示しています。

これを動かすと、一瞬コマンドプロンプトが開いてすぐに閉じます。
何もしないプログラムなので、当然の動作です。
せっかくなので、なにか表示してみます。

program Project1;

{$APPTYPE CONSOLE}

begin
  Write('Hello, console !');
end.

ここで出てきた Write は、標準出力に値を出力します。

より正確にいうならば、Write は、ファイルに値を出力する関数です。
ファイル変数を省略すると、標準出力に値を出力する、という動作になります。

引数に指定できるのは、文字列などの「値」です。
なので、ここには、Integer や Boolean も書くことができます。

たとえば、こんな風に書けます。

Write('Hello, console !', 123, True);

とりあえず実行させてみましょう。
しかし、やはり一瞬でコマンドプロンプトは閉じてしまい、表示されているか確認できません。

ちなみに、先にコンソールを開いてから、Project1 と入力して起動させれば、当然閉じたりはしません。
ですが、IDE から起動させる方が楽ちんです。
なので、開いたコンソールが勝手に閉じないようにする方法が必要です。
方法はいくつかありますが、今回は Readln を使います。

program Project1;

{$APPTYPE CONSOLE}

begin
  Write('Hello, console !');
  Readln;
end.

すると、下記の様に自動的にコンソールが閉じなくなりました。



コンソールを閉じるためには、「リターンキー/エンターキー」を押します。

さて、ここで出てきた Readln ですが、これは標準入力から値を受け取ります。

より正確にいうならば、Read は、ファイルから値読み出す関数です。
ファイル変数を省略すると、標準入力から値を読み込みます。

Read ではなく Readln なのは、何故でしょう？
実は、Read という関数もあり、こちらも標準入力から値を受け取るものです。

では、Read と Readln は、なにが違うのでしょう？
違いは Read は標準入力から値を読み出すだけですが、Readln は標準入力から「行」を読み出す、ということです。
Readln の "ln" は "Line" のことです。

では、行とは何のことでしょうか？
それは「改行」がある、ということです。
つまり、Readln は改行を受け取るまで、待機します。
そのため、Readln があるとコマンドプロンプトは自動的に閉じなくなり、「リターンキー/エンターキー」を押すと閉じたのです。

では Read では、ダメなのでしょうか？
残念ながら、Read では、ダメなのです。
それは、何も入力が無かったよ、という結果で復帰してしまうためです。
結局すぐに、コンソールは閉じてしまいます。

ところで、入力には Read と Readln がありましたが、出力には無いのでしょうか？
……当然、Write と Writeln があります。
Write は値を出力しますが、Writeln は行を出力します。
つまり、値の最後に「改行」を出力します。

たとえば、こんなコードを書くと

program Project1;

{$APPTYPE CONSOLE}

begin
  Write('Hello ');
  Write('world !');
  Writeln('');
  Writeln('Hello world 2!');
  Writeln('Hello world 3!');
  Readln;
end.

結果は、こうなります



最初の Write の "Hello " と "world !" は繋がって表示されていますが、Writeln で表示した物は自動的に改行されています。
ちなみに Writeln('') とすると、改行だけが出力されます。

今回は Write/Writel について詳述しました。
次回は、Read/Readln について紹介してみたいと思います。

Delphi/TurboPascal の歴史（Delphi Advent Calendar 2012-12-01）

Delphi Adevent Calendar 2012 の言い出しっぺとして、ブログを書く予定が！
既に時間を過ぎていた！という失態からスタートです。

Delphi / Turbo Pascal の歴史を下記の年表サイトに記載してみました。

http://pastport.jp/user/freeonterminate/timeline/Delphi%20_%20TurboPascal%20%E3%81%AE%E6%AD%B4%E5%8F%B2


個人的に思い出深いのは

• Turbo Pascal 5.5
• 大学のコンピューター室でひたすら触ってた。
• Delphi 1
• バイトでためたお金を使って買った初めての製品！
• Delphi 3.1
• このバージョンを使って作ったソフトがコミケで大ヒット。初めて最後尾札を作った！
• Delphi 7
• 最も使いまくった Delphi。最高傑作かも知れない。
• Delphi 2007
• Win32 用の最後の製品で、これも結構長い間使った記憶が。
• Delphi XE3
• かなり完成度が高い。いまお気に入りの製品。

ですかね。
逆の意味で思い出深いのは

• Delphi 5
• スプラッシュスクリーン……
• Delphi 8
• .NET 専用……初めて買わなかったバージョン

最も利用した Delphi は、Delphi 7 で、実は今でも VM に保存して使っています。

最近使ってるのは Delphi XE3。
iOS サポートはなくなりましたが、現時点で一番お勧めできる製品だと思います。

今後出てくる RAD Studio Mobile に期待です。
Android のネイティブ開発が早くしたい！

TIdURI を使ってパラメータを取得する

Delphi-ML で GET のパラメータを取得したい、という話を間違えて取らえた際にできたコードです！
TIdURI を使うと URI をパースしてくれるので、↓こんな感じでパラメータを取れます。

uses
  System.SysUtils, System.Classes, IdURI;
 
procedure GetParams(const iURL: String; const iStrings: TStrings);
var
  URI: TIdURI;
  Params: TArray<String>;
  Param: String;
begin
  URI := TIdURI.Create(iURL);
  try
    Params := URI.Params.Split(['&']);
 
    iStrings.Clear;
    for Param in Params do
      iStrings.Add(TIdURI.URLDecode(Param));
  finally
    URI.Free;
  end;
end;

TIdURI の Params は、単純に '?' を探してそれ以降を切り出した物なので、& で split したり、URLDecode したりしています。

FireMonkey2 3D 事始め

そろそろ FireMonkey にも手をつけておかないといけないかな！と思い、ちょっと触ってみました記。

とりあえず、３Dデータを読み込ませて、派手な画面を見たい、ということで、３Dデータを探してみました。
すると、 KINECT 買った時に付いてきた「窓辺ななみ」と「クラウディア窓辺」のデータを発見！

では、 FMX で読み出すぞー！と思って TForm3D を開いて、TModel3D を置いて、MeshCollection の「…」を押してデータ読み込みの画面を開いてみました。

すると、読み込めません！
検索してDEKO さんの所に辿り着きました。
TModel3D で読み込めるのは次の３形式のみということです。

• *.ase
• *.dae
• *.obj

FBX を読み込むためには、別形式にコンバートしないといけないようです。

そこで、また検索してみると Autodesk が FBX Converter を配布していました。



早速ダウンロードして、インストールしてみました。



FBX Converter で変換できる形式で FireMonkey で読み出せるのは「obj」「dae」
で、最初 OBJ 形式に変換してみました。名前に惹かれて……
すると、こんなことに！



ギャア！メタリックでパーツも変なことに！

なので、DAE に変換してみました。



テクスチャが貼れてませんが、上手く行きました（多分）。
と、とりあえず、ここまで到達するのに結構な時間が……

HD アプリケーションに比べて、やることが多いので、ちゃんとしたコードを書けるようになるまでには、まだ時間がかかりそうです

ジェネリクス

Delphi の 2009 から？ジェネリクスに対応しました。
純粋に、そういえば、どういう構造で管理してるのかな？と思ってソースを見てみました。
そうすると、下のようになっており

  TList<T> = class(TEnumerable<T>)
  private
  type
    arrayofT = array of T;

動的配列を使っていました。
なるほど！これならオブジェクトの解放を自分で管理しなくて済みますね！
Delphi の動的配列は解放をコンパイラに任せられるためです。
あって良かった動的配列！

とはいえ、当然のことですが、インスタンスの場合は解放が必要になります。
例えば、以下のコードの様にインスタンスを生成した場合、破棄が必要です。

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  System.Generics.Collections;
 
type
  // TList で管理されるクラス
  TTest = class
  public
    constructor Create(const iIndex: Integer); reintroduce;
  end;
 
  // TTest クラスを型データとする
  TObjectList = TList<TTest>;
 
{ TTest }
 
constructor TTest.Create(const iIndex: Integer);
begin
  Writeln('TTest.Created !, Index = ', iIndex);
end;
 
procedure Test;
var
  List: TObjectList;
  i: Integer;
begin
  List := TObjectList.Create;
  try
    // インスタンスの生成
    for i := 0 to 9 do
      List.Add(TTest.Create(i));
 
    // インスタンスの解放
    for i := 0 to List.Count - 1 do
      List[i].Free;
  finally
    List.Free;
  end;
end;
 
begin
  Test;
  Readln;
end.

そう考えると TList 等のジェネリクス型と相性が良いのは record の様な気がします。
解放を考えなくて済みますから。

ただ、ここで注意したいのは以前書いた記事のように、record はあくまでも record であるという事です。
TList と組み合わせて使うと、この罠に引っかかりやすいので注意が必要です。

TFindDialogEx と class helper

DEKO さんから class helper を使うと private なメンバにアクセスできちゃうよ！という情報をいただきました。
詳細はリンク先の Owl's perspective さんの所でご覧頂くとして、先日記事した TFindDialogEx を、class helper に書き換えてみました。

まず、TCommonDialog と TFindDialog の class helper を書きます。

type
  TCommonDialogHelper = class helper for TCommonDialog
  public
    procedure ReleaseRedirector;
  end;
 
  TFindDialogHelper = class helper for TFindDialog
  public
    procedure ReleaseHandle;
  end;
 
{ TCommonDialogHelper }
 
procedure TCommonDialogHelper.ReleaseRedirector;
begin
  Self.FRedirector.Free;
end;
 
{ TFindDialogHelper }
 
procedure TFindDialogHelper.ReleaseHandle;
begin
  Self.FFindHandle := 0;
end;

TCommonDialog のヘルパが必要なのは FRedirector は TCommonDialog のメンバだからです。

TFindDialog は TCommonDialog と同じ Unit 内にあるので、特に何もせず FRedirector を参照できます。

コードで Self を強調表示してありますが、それは Self を外すとコンパイルが通らないためです。
注意してください。

これらのヘルパメソッドを実際に使う部分は以下のようになります。

function TFindDialogEx.Execute(ParentWnd: HWND): Boolean;
var
  TId: DWORD;
begin
  // 無効なウィンドウハンドルでは 0 が返る
  TId := GetWindowThreadProcessId(Handle);
  if (TId = 0) then begin
    ReleaseHandle;
    ReleaseRedirector;
  end;
 
  Result := inherited;
end;

RTTI を使った場合より大分すっきりしました。

どのメンバを操作しなくてはいけないのかが判っている場合は、class helper の方が良さそうです。

TRichEdit と VCL スタイル

ソースはこちら(GitHub)

TRichEdit と VCL スタイルを併用する場合は注意が必要です。
というのも、TRichEdit は、VCL スタイルをサポートしているとは言いづらいためです。
もしかすると、Vcl.ComCtrls に登録されている Win32 Common Controls は、どれも問題があるのかもしれません。
個人的に TListView や TTreeView は使い方が煩雑なので、使っていないため判りませんが……。

QuolityCentral に送った画像で申し訳ないですが、TRichEdit と VCL スタイルを併用するとこんな事が起こります。


スクロールバーの亡霊が表示される



文字の再描画がおかしい
というか、そもそもフォントの色がおかしい



このように色々と崩れます。
VCL スタイルが適用されているフォームにTRichEdit のインスタンスを作るだけで簡単に確認可能です。

また、画像としては取れていませんが、WM_ERASEBKGND を受け取ると TRichEdit.Color で背景色が塗りつぶされるため、一瞬「白」が見えた後にスタイルの色で塗られます。
これの解決策は、TRicEdit.Color にスタイルの色を設定しておけば大丈夫です。

uses
  Vcl.Themes;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Color := StyleServices.GetStyleColor(scWindow);
end;

この処置を行うと、文字の再描画がおかしい（２番目の画像）、という問題も直ります。

と、色々とおかしいので、TRichEdit と VCL スタイルは、併用しない方が賢明です。
どうしても、という場合は、下記の様にします。

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 背景色をスタイルの色と同じに設定する
  RichEdit1.Color := StyleServices.GetStyleColor(scWindow);
 
  // スクロールバーを消さない
  RichEdit1.HideScrollBars := False;
 
  // フォントは自前でやる
  RichEdit1.StyleElements := [seClient, seBorder]; 
  RichEdit1.Font.Color := 
    StyleServices.GetFontColor(sfEditBoxTextNormal);
 
  // なお上記のコードを別のメソッドに纏めて、
  //スタイルが変更されるとき必ず呼ばれるようにしておく必要がある。
end;

これで、一応、おかしな動作はしなくなります。

TCommnDialog と Style

ソースはこちら(GitHub)

まずは、これをご覧ください。



TOpenTextFileDialog を開いたところです。
みんな、VCL スタイルを使ってないのかな……
いや！ HTML5 Builder を作った時に気づいてるハズなんだが！

……まあそれはそれとして、これを何とかしなくてはなりません。
前回の記事と同様に、拡張 RTTI を使ってコントロールから Style を取り除くコードを書きました。

unit uStyleUtils;
 
interface
 
procedure ClearStyles(const iObj: TObject);
 
implementation
 
uses
  System.Rtti, System.TypInfo, Vcl.Controls;
 
procedure ClearStylesSub(const iControl: TControl);
var
  i: Integer;
begin
  if (iControl <> nil) then begin
    if (iControl is TWinControl) then
      with TWinControl(iControl) do
        for i := 0 to ControlCount - 1 do
          ClearStylesSub(Controls[i]);
 
    iControl.StyleElements := [];
  end;
end;
 
procedure ClearStyles(const iObj: TObject);
var
  Context: TRttiContext;
  Fields: TArray<TRttiField>;
  Field: TRttiField;
  RttiType: TRttiType;
  Obj: TObject;
begin
  Context := TRttiContext.Create;
  try
    try
      Fields := Context.GetType(iObj.ClassType).GetFields;
 
      for Field in Fields do begin
        RttiType := Field.FieldType;
 
        if
          (RttiType = nil) or (RttiType.TypeKind <> tkClass) or
          (Field.Name = 'FOwner') or (Field.Name = 'FParent')
        then
          Continue;
 
        try
          Obj := Field.GetValue(iObj).AsObject;
        except
          Obj := nil;
        end;
 
        if (Obj <> nil) and (Obj is TControl) then
          ClearStylesSub(TControl(Obj));
      end;
    except
    end;
  finally
    Context.Free;
  end;
end;
 
end.

全文引用しても、この程度の長さのものです。
使い方は

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClearStyles(OpenTextFileDialog1);
end;

と最初に一回呼ぶだけです。
これで、キレイに表示できるようになりました。

TFindDialog とスタイル

ソースはこちら(GitHub)

TFindDialog に TControl 派生コントロールを乗せる必要があり、TFindDialogEx を実装しました。
TFindDialog に限らず TCommonDialog を継承するダイアログは、Windows のコモンダイアログのラッパーになっています。
そのため、VCL のコントロールを乗せるのは、少しテクニックが必要です。

具体的には、下記の様に TPanel などのコンテナに乗せてやる必要があるのです。

// Vcl.ExtDlg の TOpenTextFileDialog から引用
constructor TOpenTextFileDialog.Create(AOwner: TComponent);
var
  I: Integer;
begin
  (省略)
 
  FPanel := TPanel.Create(Self);
  with FPanel do
  begin
    (省略)
 
    with FLabel do
    begin
      (省略)
      Parent := FPanel;
    end;
 
    FComboBox := TComboBox.Create(Self);
    with FComboBox do
    begin
      (省略)
      Parent := FPanel;
    end;
  end;
end;

もし、TPanel に乗せないとどうなるかというと、フォーカスを受け取れなくなり、マウス・キーボードの操作が効かなくなります。

ということで、まねして TFindDialogEx のコンストラクタでも TPanel のインスタンスを生成します。

constructor TFindDialogEx.Create(iOwner: TComponent);
begin
  inherited;
 
  FPanel := TPanel.Create(Self);
  with FPanel do begin
    BevelInner := bvNone;
    BevelOuter := bvNone;
    StyleElements := [];
    FullRepaint := False;
    TabOrder := 0;
    TabStop := True;
    Color := clBtnFace;
  end;
end;

ここで重要なのは StyleElements です。
Windows のコモンダイアログに乗るので Style による描画は必要ありません。
もし、StyleElements に何もしていないと……



上図のように周りから浮いてしまいます。
次に、ダイアログに乗せるコントロールを追加するメソッドを定義します。

// iControl を FPanel の子供に設定する
procedure TFindDialogEx.AddControl(const iControl: TControl);
begin
  if (FControl <> nil) then
    FControl.Parent := nil;
 
  FControl := iControl;
 
  if (FControl <> nil) then begin
    FControl.Parent := FPanel;
 
    ListupControl(
      FControl,
      procedure (const iControl: TControl)
      begin
        iControl.StyleElements := [];
      end
    );
  end;
end;
 
// ListUpControl は全てのコントロールを列挙する
type
  TListupCallback = reference to procedure (const iControl: TControl);
      
procedure TFindDialogEx.ListupControl(
  const iControl: TControl;
  const iCallback: TListupCallback);
var
  i: Integer;
begin
  if (iControl <> nil) then begin
    if (iControl is TWinControl) then
      with TWinControl(iControl) do
        for i := 0 to ControlCount - 1 do
          ListupControl(Controls[i], iCallback);
 
    iCallback(iControl);
  end;
end;

このように FPanel を Parent に設定しています。
また、FPanel と同様に StyleElements も [] として設定しています。

ListupControl では reference to を使って、無名メソッドを呼び出すようにしています。
これによって、Listup した Control を簡単に処理できます。

次に、ダイアログに FPanel を乗せる処理です。
コモンダイアログは、WM_INITDIALOG メッセージで、初期化処理をします。
TCommonDialog には WM_INITDIALOG メッセージを受信したときに呼ばれる DoShow メソッドがあります。
そこで、これを override して、初期化処理をします。

type
  TFindDialogEx = class(TFindDialog)
  (略)
  protected
    procedure DoShow; override;
  (略)
  end;
 
implementation
 
procedure TFindDialogEx.DoShow;
var
  WndRect: TRect;
  tmpRect: TRect;
begin
  inherited;
 
  GetWindowRect(Handle, WndRect); // Screen 座標の位置。NoClient エリアも含む
  GetClientRect(Handle, tmpRect); // Window 座標の位置。Client エリアのみ
 
  if (FControl <> nil) then begin
    FPanel.ParentWindow := Handle; // Dialog を親に設定
 
    // パネルのサイズを計算
    FPanel.ClientHeight := FControl.Height;
    FPanel.SetBounds(
      0,
      tmpRect.Height - 10, // 10 pixel 位上だと見栄えが良い
      tmpRect.Width,
      FControl.Height);
 
    // パネルの高さ分、ダイアログのウィンドウを伸ばす
    MoveWindow(
      Handle,
      WndRect.Left,
      WndRect.Top,
      WndRect.Width,
      WndRect.Height + FPanel.Height, // FPanel の高さ分伸ばす
      True);
  end;
end;

では、ここまでで動かしてみると……



なんと、コントロールが表示されていません。
ちなみに、マウスをオーバーしたり、Alt キーを押すと表示されます。
これは、Windows のコモンダイアログのメッセージ処理が上手く流れてこないためです。
なので、コモンダイアログの WM_ERASEBKGND メッセージで、コントロールを再描画してやる必要があります。

procedure TFindDialogEx.WMEraseBkGnd(var ioMsg: TWMEraseBkGnd);
begin
  inherited;
 
  ListupControl(
    FControl,
    procedure (const iControl: TControl)
    begin
      iControl.Repaint; // 再描画させる
    end
  );
end;

では、これでもう一度表示させてみると……



上手く表示されました。
で、事はこれで終わりかと思いきや、とんでもないバグが潜んでいたのです。

TFindDialog は他のダイアログと違い、モードレスなダイアログです。
つまり、ダイアログを表示している最中に、ユーザーは任意のフォームを操作できます。
そのため、TFindDialog を出したまま、スタイルを変更することもできるのです。

もし、そうするとどうなるかというと、Execute を呼び出してもダイアログは表示されなくなります。

これは、何故かと言うと下記のコードが Execute に記述されているからです。

function TFindDialog.Execute(ParentWnd: HWND): Boolean;
var
  Option: TFindOption;
begin
  if FFindHandle <> 0 then // 0 かどうかで判断している
  begin
    // 0 じゃなかったら既に表示されていると判断して
    // ウィンドウを前に持ってくる処理を走らせる
    // しかし！ ウィンドウハンドルが無効だった場合、何も起きない！
    BringWindowToTop(FFindHandle);
    Result := True;
  end else
  begin
    (略)
  end;
end;

Style が変更されるとウィンドウは RecreateWnd を使って再生成されます。
そのため、FFindHandle は 0 ではありませんが、無効なウィンドウハンドルになっています。
これによって、Execute を呼び出しても何も起きないのです。

そこで、この不具合を取り除くために拡張 RTTI を使って、FFindHandle を 0 にします。

function TFindDialogEx.Execute(ParentWnd: HWND): Boolean;
var
  TId: DWORD;
  Context: TRttiContext;
  Field: TRttiField;
  Obj: TObject;
begin
  // 無効なウィンドウハンドルでは 0 が返る
  TId := GetWindowThreadProcessId(Handle);
  if (TId = 0) then begin
    Context := TRttiContext.Create;
    try
      try
        Field := Context.GetType(Self.ClassType).GetField('FFindHandle');
        if (Field <> nil) then
          Field.SetValue(Self, 0); // FFindHandle を 0 に
 
        Field := Context.GetType(Self.ClassType).GetField('FRedirector');
        if (Field <> nil) then begin
          Obj := Field.GetValue(Self).AsObject;
          if (Obj <> nil) then
            Obj.Free; // FRedirector を解放
        end;
      except
      end;
    finally
      Context.Free;
    end;
  end;
 
  Result := inherited;
end;

FFindHandle だけではなく FRedirector というコントロールも破棄する必要があるので、それも破棄しています。
このように拡張 RTTI を使うと private として隠蔽されていた変数やメソッドまで呼べてしまいます。

Java を知っている方にはおなじみ？のリフレクションと同じ機能です。
静的型付けのコンパイル型言語で、同じ事ができるとは驚きです。

非常に強力なので、注意が必要です。

拡張 RTTI については、第２３回デベロッパーキャンプの福士さんの資料が詳しいです。

これで、完全に動作するようになりました。

Delphi でコモンダイアログをカスタマイズする方法があまり存在しないので、書いてみました。