tag:blogger.com,1999:blog-57672809118670233452024-02-07T21:46:17.397+09:00.delphi maniacsDelphi に関したり関さない事や猫の事を書いていきますAnonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.comBlogger65125tag:blogger.com,1999:blog-5767280911867023345.post-75593107238900528832016-03-23T10:16:00.003+09:002016-03-23T10:16:48.166+09:00今後は Qiita に投稿します<h2>
今後の記事は全て Qiita に投稿します。 </h2>
以前の記事はこのまま置いておきます。<br />
<br />
今後は↓こちらへどうぞ<br />
<h3>
<a href="http://qiita.com/pik" target="_blank">http://qiita.com/pik</a></h3>
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-16766574086013678582014-12-26T19:30:00.000+09:002014-12-26T19:30:00.454+09:00CodeIQ 巨大な整数の演算に挑戦!の解答(TBcd の紹介)<a href="http://qiita.com/advent-calendar/2014/delphi">Delphi / Appmethod Advent Calendar 2014</a> 12/26 の記事です<br />
<br />
<a href="https://codeiq.jp/ace/tomohiro_takahashi/q1154">CodeIQ 巨大な整数の演算に挑戦!</a>の僕の解答です!<br />
<br />
本来は、ちゃんと Advent Calendar 開催中に公開する予定でしたが、この問題の締め切りが 12/21 まで延びたので公開を延期していました。<br />
<br />
<br />
問題の本文は<br />
<pre class="code">
コラッツの問題が巨大な正の整数でも成り立つことを実証しましょう。
コラッツの問題が「9が50個連続する巨大な50桁の整数」でも成り立つこと(最終的に1になること)を確認できるWindows向けコンソールプログラムを作成してください。
ソースコードは、50行以内且つ、DelphiまたはAppmethodに標準搭載されているデータ型、クラス、ライブラリのみを使用して記述してください。
※コラッツの問題・・
自然数nに対して、nが奇数なら3をかけて1を加える。
偶数なら2で割る。
この処理を繰り返すとすべての自然数が1になる。
<a href="http://ja.wikipedia.org/wiki/%E3%82%B3%E3%83%A9%E3%83%83%E3%83%84%E3%81%AE%E5%95%8F%E9%A1%8C">http://ja.wikipedia.org/wiki/コラッツの問題</a>
</pre>
でした。<br />
<br />
これに対して、僕の最初の解答がこちら。<br />
<pre class="code">
<div class="oddline"><b>program</b> CollatzMin;</div>
<div class="evenline"><b>uses</b></div>
<div class="oddline"> Data.FmtBcd;</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> Bcd: TBcd;</div>
<div class="evenline"> Sup: Integer;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Bcd := StrToBcd(StringOfChar(<span class="string">'9'</span>, <span class="number">50</span>));</div>
<div class="oddline"> <b>while</b> (Bcd > <span class="number">1</span>) <b>do</b></div>
<div class="evenline"> <b>begin</b></div>
<div class="oddline"> Sup := Bcd.Precision <b>and</b> <span class="number">1</span>;</div>
<div class="evenline"> <b>if</b></div>
<div class="oddline"> ((Bcd.Fraction[Bcd.Precision <b>shr</b> <span class="number">1</span> + Sup - <span class="number">1</span>] <b>shr</b> (Sup <b>shl</b> <span class="number">2</span>) <b>and</b> <span class="number">1</span>) > <span class="number">0</span>)</div>
<div class="evenline"> <b>then</b></div>
<div class="oddline"> Bcd := Bcd * <span class="number">3</span> + <span class="number">1</span></div>
<div class="evenline"> <b>else</b></div>
<div class="oddline"> Bcd := Bcd / <span class="number">2</span>;</div>
<div class="evenline"> Writeln(BcdToStr(Bcd));</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> Readln;</div>
<div class="oddline"><b>end</b>.</div>
</pre>
Delphi でお手軽に巨大な整数を扱うと言えばでおなじみの <a href="http://docwiki.embarcadero.com/Libraries/XE7/ja/Data.FmtBcd">Data.FmtBcd</a> を使いました。<br />
本来は<a href="http://ja.wikipedia.org/wiki/%E4%BA%8C%E9%80%B2%E5%8C%96%E5%8D%81%E9%80%B2%E8%A1%A8%E7%8F%BE">2進化10進数</a>を扱うためのクラスです(2進化10進数についてはリンク先でどうぞ)。<br />
このクラスを使うと 64 桁までの数に対応できます。<br />
問題の本文にあるように今回は 50 桁なので、TBcd で余裕です。<br />
TBcd には operator が定義されているので普通の数のように加減乗除できます。<br />
<br />
TBcd を使った結果、上の解答になりました。<br />
<br />
ですが、これ 3n + 1 って「必ず偶数になるんじゃね!」→「偶数なら2で割り切れるんじゃね!」と考えて最適化した結果が次のコードです。<br />
<pre class="code">
<div class="oddline"><b>program</b> CollatzBcd;</div>
<div class="evenline"><b>uses</b></div>
<div class="oddline"> Data.FmtBcd;</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> N: TBcd;</div>
<div class="evenline"> Od: Integer;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> N := StrToBcd(StringOfChar(<span class="string">'9'</span>, <span class="number">50</span>));</div>
<div class="oddline"> <b>while</b> (N > <span class="number">1</span>) <b>do</b></div>
<div class="evenline"> <b>begin</b></div>
<div class="oddline"> Od := BcdPrecision(N) <b>and</b> <span class="number">1</span>;</div>
<div class="evenline"> Od := N.Fraction[BcdPrecision(N) <b>shr</b> <span class="number">1</span> + Od - <span class="number">1</span>] <b>shr</b> (Od <b>shl</b> <span class="number">2</span>) <b>and</b> <span class="number">1</span>;</div>
<div class="oddline"> N := (N * (<span class="number">1</span> + Od <b>shl</b> <span class="number">1</span>) + Od) / <span class="number">2</span>;</div>
<div class="evenline"> Writeln(BcdToStr(N));</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> Readln;</div>
<div class="oddline"><b>end</b>.</div>
</pre>
結構スッキリしました。<br />
ただ、こちらのコードは最初の一回目の演算結果が表示されないのですが…<br />
とはいえ、解答としてはオッケーでした。<br />
<br />
Data パッケージにあるからなのか、あまり知られていない <a href="http://docwiki.embarcadero.com/Libraries/XE7/ja/Data.FmtBcd.TBcd">TBcd クラス</a>。<br />
かなり簡単に使えるので、知って置いて損は無いと思います。<br />
<br />
:<br />
:<br />
<br />
最後に蛇足。<br />
自前で整数演算を実装した物も提出していました。<br />
こちらは、普通に乗算をして繰り上がりや繰り下がりの演算をするものです。<br />
<pre class="code">
<div class="oddline"><b>program</b> CollatzBytes;</div>
<div class="evenline"><b>uses</b></div>
<div class="oddline"> System.SysUtils;</div>
<div class="evenline"><b>const</b></div>
<div class="oddline"> COUNT = <span class="number">50</span>;</div>
<div class="evenline"> DIGIT = <span class="number">9</span>;</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> Bytes: TBytes;</div>
<div class="oddline"> i, H, L: Integer;</div>
<div class="evenline"><b>function</b> ToString: <b>String</b>;</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> i: Integer;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Result := <span class="string">''</span>;</div>
<div class="oddline"> <b>for</b> i := High(Bytes) <b>downto</b> Low(Bytes) <b>do</b></div>
<div class="evenline"> Result := Result + Bytes[i].ToString;</div>
<div class="oddline"> Result := Result.TrimLeft([<span class="string">'0'</span>]);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> SetLength(Bytes, COUNT * <span class="number">2</span>);</div>
<div class="oddline"> <b>for</b> i := <span class="number">0</span> <b>to</b> COUNT - <span class="number">1</span> <b>do</b></div>
<div class="evenline"> Bytes[i] := DIGIT;</div>
<div class="oddline"> </div>
<div class="evenline"> <b>while</b> (ToString.Length > <span class="number">1</span>) <b>or</b> (Bytes[<span class="number">0</span>] > <span class="number">1</span>) <b>do</b></div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> <b>if</b> (Odd(Bytes[<span class="number">0</span>])) <b>then</b></div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> H := <span class="number">1</span>;</div>
<div class="oddline"> <b>for</b> i := Low(Bytes) <b>to</b> High(Bytes) <b>do</b></div>
<div class="evenline"> <b>begin</b></div>
<div class="oddline"> L := Bytes[i] * <span class="number">3</span> + H;</div>
<div class="evenline"> H := L <b>div</b> <span class="number">10</span>;</div>
<div class="oddline"> Bytes[i] := L - H * <span class="number">10</span>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> <b>end</b></div>
<div class="evenline"> <b>else</b> <b>begin</b></div>
<div class="oddline"> L := <span class="number">0</span>;</div>
<div class="evenline"> <b>for</b> i := High(Bytes) <b>downto</b> Low(Bytes) <b>do</b></div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> H := Bytes[i];</div>
<div class="oddline"> Bytes[i] := Bytes[i] <b>shr</b> <span class="number">1</span> + L;</div>
<div class="evenline"> L := (H <b>and</b> <span class="number">1</span>) * <span class="number">5</span>;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> Writeln(ToString);</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> Readln;</div>
<div class="oddline"><b>end</b>.</div>
</pre>
こちらは49行でギリギリでした!<br />
{$APPTYPE CONSOLE} を入れたら50行ちょうどでした!あぶない!<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-8153063955618308162014-12-24T00:00:00.000+09:002014-12-24T00:53:55.881+09:00FireMonkey の Interface で提供されている機能をオーバーライドする方法<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/blob/master/FMXInterfaceOverride/FMX.SystemFontService.pas">サンプルソースはこちら(GitHub)</a>
</div>
<a href="http://qiita.com/advent-calendar/2014/delphi">Delphi / Appmethod Advent Calendar 2014</a> 12/24 の記事です<br />
<br />
<hr>
12/24 00:43 頃追記!<br />
inline 指令が意味ないとのことです!<br />
ソース内に書きました!<br />
<hr>
<br />
みなさん! FireMonkey 使ってますか!?<br />
FireMonkey 使ってみると解るんですけど、痒いところに手が届かない事ありますよね!!<br />
とはいえ、FireMonkey ではプラットフォームに依存するクラスは implementation の下に書いて、外出ししてないから置き換えられないよお!って事、良くありますよね。<br />
<br />
ですが! FireMonkey には、サービスを置き換えるための仕組みがあります。<br />
クラスそのものを置き換える事はできないのですが、その実体を提供している IFMXxxxx として提供されているサービスを置き換えられます!<br />
今回は、その手法を紹介します。<br/>
<br />
基本的にはどのサービスも置き換えられるのですが、ここでは簡単のために IFMXSystemFontService を置き換えてみました(必要なメソッドが2つしかないので)。<br />
デフォルトのフォント名を書き換えることで、下記の図のように設計時と実行時のフォントが変わります。<br />
(上が設計時、下が実行時)<br />
わ、解りづらいwww<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiwiuYiD6bH0PKRNcSM9RiwxJPlF0N0-lgd69kLLrJSFLLV8yW4hVhF6lIvn-N8kfpCCXQEdz5cuU9628g9s_pn2mm9BwLfQT_homGJoOL5JfxzSbigfWyz7VD2yk1XL5iTr_mjj-x4MoZg/s1600/SystemFontChanged.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiwiuYiD6bH0PKRNcSM9RiwxJPlF0N0-lgd69kLLrJSFLLV8yW4hVhF6lIvn-N8kfpCCXQEdz5cuU9628g9s_pn2mm9BwLfQT_homGJoOL5JfxzSbigfWyz7VD2yk1XL5iTr_mjj-x4MoZg/s320/SystemFontChanged.png" /></a><br />
<br />
詳しくは下記のソース内のコメントを参照してください!<br />
<br />
<pre class="code">
<div class="oddline"><b>unit</b> FMX.SystemFontService;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> FMX.<b>Platform</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>type</b></div>
<div class="oddline"> <span class="comment">// TInterfacedObject と目的のサービスのインターフェースを継承する</span></div>
<div class="evenline"> TFMXSystemFontServiceHook = <b>class</b>(TInterfacedObject, IFMXSystemFontService)</div>
<div class="oddline"> <b>private</b> <b>var</b></div>
<div class="evenline"> <span class="comment">// 元々 FMX が登録していたサービスを保持する変数</span></div>
<div class="oddline"> FOrgFMXSystemFontService: IFMXSystemFontService;</div>
<div class="evenline"> <b>protected</b></div>
<div class="oddline"> <span class="comment">// コンストラクタの中でサービスを置き換える</span></div>
<div class="evenline"> <b>constructor</b> Create;</div>
<div class="oddline"> <b>public</b></div>
<div class="evenline"> <span class="comment">// 置き換えたいサービスが実装すべきメソッド</span></div>
<div class="oddline"> <span class="comment">{ IFMXSystemFontService }</span></div>
<div class="evenline"> <b>function</b> GetDefaultFontFamilyName: <b>String</b>;</div>
<div class="oddline"> <b>function</b> GetDefaultFontSize: Single; <b>inline</b>; <span class="comment">// inline ついてはメソッド内に</span></div>
<div class="evenline"> <b>public</b></div>
<div class="oddline"> <span class="comment">// これを呼ぶとコンストラクタを呼べる!</span></div>
<div class="evenline"> <span class="comment">// 今回は Initialization で呼ぶ</span></div>
<div class="oddline"> <b>class</b> <b>procedure</b> RegistService;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>implementation</b></div>
<div class="oddline"> </div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> <span class="comment">// このサービスのインスタンスを保持する</span></div>
<div class="evenline"> SystemFontServiceHook: TFMXSystemFontServiceHook = <b>nil</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TFMXSystemFontServiceHook }</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>constructor</b> TFMXSystemFontServiceHook.Create;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>inherited</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// オリジナルの Interface を取り出して自分自身と置き換えてしまう!</span></div>
<div class="oddline"> <b>if</b></div>
<div class="evenline"> TPlatformServices.Current.SupportsPlatformService( <span class="comment">// 取り出し</span></div>
<div class="oddline"> IFMXSystemFontService,</div>
<div class="evenline"> IInterface(FOrgFMXSystemFontService))</div>
<div class="oddline"> <b>then</b> <b>begin</b></div>
<div class="evenline"> <span class="comment">// オリジナルを削除</span></div>
<div class="oddline"> TPlatformServices.Current.RemovePlatformService(IFMXSystemFontService);</div>
<div class="evenline"> <span class="comment">// 自分を登録しちゃう</span></div>
<div class="oddline"> TPlatformServices.Current.AddPlatformService(IFMXSystemFontService, Self);</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>function</b> TFMXSystemFontServiceHook.GetDefaultFontFamilyName: <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// 元々のサービスが返す値を変えちゃう!</span></div>
<div class="evenline"> Result := <span class="string">'メイリオ'</span>;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>function</b> TFMXSystemFontServiceHook.GetDefaultFontSize: Single;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// 元々のサービスの値を返すこともできる</span></div>
<div class="evenline"> <span class="comment">// 置き換える予定の無いメソッドについては inline 指定をすると</span></div>
<div class="oddline"> <span class="comment">// 呼び出しオーバーヘッドが少なくなる</span></div>
<div class="evenline"> <span class="comment">// と思ったのですが、そんなことは無いそうです!!</span></div>
<div class="oddline"> <span class="comment">// 詳しくは、Lyna さんのこのツイートをご覧ください</span></div>
<div class="evenline"> <span class="comment"><span class="comment">// <a href="https://twitter.com/lynatan/status/547410499164336128">https://twitter.com/lynatan/status/547410499164336128</a></span></div>
<div class="oddline"> Result := FOrgFMXSystemFontService.GetDefaultFontSize;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// Initialization で↓このメソッドを呼んでコンストラクタを呼び出す</span></div>
<div class="oddline"><span class="comment">// class constractor でも可能</span></div>
<div class="evenline"><span class="comment">// これによって、このユニットをプロジェクトを追加するだけで自動的に置き換わる!</span></div>
<div class="oddline"><b>class</b> <b>procedure</b> TFMXSystemFontServiceHook.RegistService;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>if</b> (SystemFontServiceHook = <b>nil</b>) <b>then</b></div>
<div class="evenline"> SystemFontServiceHook := TFMXSystemFontServiceHook.Create;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>initialization</b></div>
<div class="evenline"> TFMXSystemFontServiceHook.RegistService;</div>
<div class="oddline"> </div>
<div class="evenline"><b>end</b>.</div>
</pre>
<br />
ということで、本日はクリスマスイブです!<br />
なのに、こんなブログを書きました!書いたのは23日だけど!!<br />
<br />
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-30207710893778203692014-12-22T00:00:00.000+09:002014-12-22T00:00:01.501+09:00Delphi だけで、Android の Broadcast Receiver を実装する方法<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/tree/master/BroadcastReceiver">サンプルソースはこちら(GitHub)</a>
</div>
<a href="http://qiita.com/advent-calendar/2014/delphi">Delphi / Appmethod Advent Calendar 2014</a> 12/22 の記事です<br />
<br />
Delphi で Android 開発をしている3000万人の皆さん!こんにちは!<br/>
今回は Delphi だけで Broadcast Receiver を実装する方法です。<br/>
思ってるより簡単に作れますが、はまりポイントも。<br/>
<br/>
ソースにコメントを書いたので、詳しくは実際のソースをご覧ください!<br/>
<br/>
<h3>uBroadcastReceiver ソース</h3>
<pre class="code">
<div class="oddline"><b>unit</b> uBraodcastReceiver;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> System.Classes</div>
<div class="oddline"> , System.Generics.Collections</div>
<div class="evenline"> , FMX.<b>Platform</b></div>
<div class="oddline"> , Androidapi.JNIBridge</div>
<div class="evenline"> , Androidapi.JNI.App</div>
<div class="oddline"> , Androidapi.JNI.Embarcadero</div>
<div class="evenline"> , Androidapi.JNI.GraphicsContentViewText</div>
<div class="oddline"> , Androidapi.JNI.JavaTypes</div>
<div class="evenline"> , Androidapi.Helpers <span class="comment">// XE6 では FMX.Helpers.Android にしてください</span></div>
<div class="oddline"> ;</div>
<div class="evenline"> </div>
<div class="oddline"><b>type</b></div>
<div class="evenline"> <span class="comment">// 直接 class(TJavaLocal, JFMXBroadcastReceiverListener) を定義するとダメ!</span></div>
<div class="oddline"> <span class="comment">// グローバル変数にインスタンスをつっこんでも削除されて、Broadcast 受信で</span></div>
<div class="evenline"> <span class="comment">// アプリが落ちる!</span></div>
<div class="oddline"> <span class="comment">// なので、TInterfacedObject を継承していないクラスから派生したクラスの</span></div>
<div class="evenline"> <span class="comment">// インナークラスとして JFMXBroadcastReceiverListener を定義する</span></div>
<div class="oddline"> <span class="comment">// このクラスは自動的に削除されないため、上手く動作する!</span></div>
<div class="evenline"> TBroadcastReceiver = <b>class</b></div>
<div class="oddline"> <b>public</b> <b>type</b></div>
<div class="evenline"> <span class="comment">// Broadcast Receiver を通知するイベント</span></div>
<div class="oddline"> <span class="comment">// JString にしているので、Intent.ACTION_XXX と equals で比較可能</span></div>
<div class="evenline"> TBroadcastReceiverEvent = <b>procedure</b>(<b>const</b> iAction: JString) <b>of</b> <b>object</b>;</div>
<div class="oddline"> <span class="comment">// JFMXBroadcastReceiver を実装した JavaClass として Listener を定義</span></div>
<div class="evenline"> TBroadcastReceiverListener =</div>
<div class="oddline"> <b>class</b>(TJavaLocal, JFMXBroadcastReceiverListener)</div>
<div class="evenline"> <b>private</b> <b>var</b></div>
<div class="oddline"> FBroadcastReceiver: TBroadcastReceiver;</div>
<div class="evenline"> <b>public</b></div>
<div class="oddline"> <b>constructor</b> Create(<b>const</b> iBroadcastReceiver: TBroadcastReceiver);</div>
<div class="evenline"> <span class="comment">// Broadcast Receiver から呼び出されるコールバック</span></div>
<div class="oddline"> <b>procedure</b> onReceive(context: JContext; intent: JIntent); <b>cdecl</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> <b>private</b> <b>var</b></div>
<div class="evenline"> <span class="comment">// つぎの2つは保存しないと消えて無くなる!</span></div>
<div class="oddline"> FBroadcastReceiverListener: JFMXBroadcastReceiverListener;</div>
<div class="evenline"> FReceiver: JFMXBroadcastReceiver;</div>
<div class="oddline"> <span class="comment">// 通知対象の ACTION を保持している変数</span></div>
<div class="evenline"> FActions: TList<<b>String</b>>;</div>
<div class="oddline"> <span class="comment">// イベントハンドラ</span></div>
<div class="evenline"> FOnReceived: TBroadcastReceiverEvent;</div>
<div class="oddline"> <b>protected</b></div>
<div class="evenline"> <b>constructor</b> Create;</div>
<div class="oddline"> <span class="comment">// Broadcast Receiver の設定と解除</span></div>
<div class="evenline"> <b>procedure</b> SetReceiver;</div>
<div class="oddline"> <b>procedure</b> UnsetReceiver;</div>
<div class="evenline"> <b>public</b></div>
<div class="oddline"> <b>destructor</b> Destroy; <b>override</b>;</div>
<div class="evenline"> <span class="comment">// 通知して欲しい ACTION の登録と削除</span></div>
<div class="oddline"> <b>procedure</b> AddAction(<b>const</b> iActions: <b>array</b> <b>of</b> JString);</div>
<div class="evenline"> <b>procedure</b> RemoveAction(<b>const</b> iAction: JString);</div>
<div class="oddline"> <b>procedure</b> ClearAction;</div>
<div class="evenline"> <span class="comment">// Boradcast Receiver を受け取った時のイベント</span></div>
<div class="oddline"> <b>property</b> OnReceived: TBroadcastReceiverEvent</div>
<div class="evenline"> <b>read</b> FOnReceived <b>write</b> FOnReceived;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// Boradcast Receiver のインスタンスを返す</span></div>
<div class="evenline"><b>function</b> BroadcastReceiver: TBroadcastReceiver;</div>
<div class="oddline"> </div>
<div class="evenline"><b>implementation</b></div>
<div class="oddline"> </div>
<div class="evenline"><b>uses</b></div>
<div class="oddline"> System.UITypes</div>
<div class="evenline"> , Androidapi.NativeActivity</div>
<div class="oddline"> , FMX.Forms</div>
<div class="evenline"> ;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// Braodcast Receiver の唯一のインスタンス</span></div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> GBroadcastReceiver: TBroadcastReceiver = <b>nil</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>function</b> BroadcastReceiver: TBroadcastReceiver;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>if</b> (GBroadcastReceiver = <b>nil</b>) <b>then</b></div>
<div class="oddline"> GBroadcastReceiver := TBroadcastReceiver.Create;</div>
<div class="evenline"> </div>
<div class="oddline"> Result := GBroadcastReceiver;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TBroadcastReceiver.TBroadcastReceiverListener }</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>constructor</b> TBroadcastReceiver.TBroadcastReceiverListener.Create(</div>
<div class="oddline"> <b>const</b> iBroadcastReceiver: TBroadcastReceiver);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>inherited</b> Create;</div>
<div class="evenline"> FBroadcastReceiver := iBroadcastReceiver;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>procedure</b> TBroadcastReceiver.TBroadcastReceiverListener.onReceive(</div>
<div class="evenline"> context: JContext;</div>
<div class="oddline"> intent: JIntent);</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> JStr: <b>String</b>;</div>
<div class="evenline"> Str: <b>String</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <b>procedure</b> CallEvent;</div>
<div class="oddline"> <b>var</b></div>
<div class="evenline"> Action: <b>String</b>;</div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> <span class="comment">// Broadcast は Delphi のメインスレッドで届くわけでは無いので</span></div>
<div class="oddline"> <span class="comment">// Synchronize で呼び出す</span></div>
<div class="evenline"> Action := JStr;</div>
<div class="oddline"> TThread.CreateAnonymousThread(</div>
<div class="evenline"> <b>procedure</b></div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> TThread.Synchronize(</div>
<div class="oddline"> TThread.CurrentThread,</div>
<div class="evenline"> <b>procedure</b></div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> <b>if</b> (Assigned(FBroadcastReceiver.FOnReceived)) <b>then</b></div>
<div class="oddline"> FBroadcastReceiver.FOnReceived(StringToJString(Action));</div>
<div class="evenline"> <b>end</b></div>
<div class="oddline"> );</div>
<div class="evenline"> <b>end</b></div>
<div class="oddline"> ).Start;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// Broadcast を受け取ったら、このメソッドが呼ばれる!</span></div>
<div class="evenline"> JStr := JStringToString(intent.getAction);</div>
<div class="oddline"> </div>
<div class="evenline"> <b>for</b> Str <b>in</b> FBroadcastReceiver.FActions <b>do</b></div>
<div class="oddline"> <b>if</b> (Str = JStr) <b>then</b></div>
<div class="evenline"> CallEvent;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">{ TReceiverListener }</span></div>
<div class="evenline"> </div>
<div class="oddline"><b>procedure</b> TBroadcastReceiver.AddAction(<b>const</b> iActions: <b>array</b> <b>of</b> JString);</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> Str: <b>String</b>;</div>
<div class="evenline"> JStr: <b>String</b>;</div>
<div class="oddline"> Action: JString;</div>
<div class="evenline"> OK: Boolean;</div>
<div class="oddline"> Changed: Boolean;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> Changed := False;</div>
<div class="evenline"> </div>
<div class="oddline"> <b>for</b> Action <b>in</b> iActions <b>do</b></div>
<div class="evenline"> <b>begin</b></div>
<div class="oddline"> OK := True;</div>
<div class="evenline"> </div>
<div class="oddline"> JStr := JStringToString(Action);</div>
<div class="evenline"> </div>
<div class="oddline"> <b>for</b> Str <b>in</b> FActions <b>do</b></div>
<div class="evenline"> <b>if</b> (Str = JStr) <b>then</b></div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> OK := False;</div>
<div class="oddline"> Break;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <b>if</b> (OK) <b>then</b> <b>begin</b></div>
<div class="oddline"> FActions.Add(JStr);</div>
<div class="evenline"> Changed := True;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <b>if</b> (Changed) <b>then</b></div>
<div class="oddline"> SetReceiver;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> TBroadcastReceiver.ClearAction;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> FActions.Clear;</div>
<div class="oddline"> UnsetReceiver;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>constructor</b> TBroadcastReceiver.Create;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>inherited</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> FActions := TList<<b>String</b>>.Create;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// Boardcast Receiver を設定</span></div>
<div class="oddline"> SetReceiver;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>destructor</b> TBroadcastReceiver.Destroy;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// Broadcast Receiver を解除</span></div>
<div class="oddline"> UnsetReceiver;</div>
<div class="evenline"> </div>
<div class="oddline"> FActions.DisposeOf;</div>
<div class="evenline"> </div>
<div class="oddline"> <b>inherited</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> TBroadcastReceiver.RemoveAction(<b>const</b> iAction: JString);</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> i: Integer;</div>
<div class="oddline"> JStr: <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> JStr := JStringToString(iAction);</div>
<div class="evenline"> </div>
<div class="oddline"> <b>for</b> i := <span class="number">0</span> <b>to</b> FActions.Count - <span class="number">1</span> <b>do</b></div>
<div class="evenline"> <b>if</b> (FActions[i] = JStr) <b>then</b></div>
<div class="oddline"> <b>begin</b></div>
<div class="evenline"> FActions.Delete(i);</div>
<div class="oddline"> SetReceiver;</div>
<div class="evenline"> Break;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> TBroadcastReceiver.SetReceiver;</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> Filter: JIntentFilter;</div>
<div class="oddline"> Str: <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>if</b> (FReceiver <> <b>nil</b>) <b>then</b></div>
<div class="evenline"> UnsetReceiver;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// Intent Filter を作成</span></div>
<div class="oddline"> Filter := TJIntentFilter.JavaClass.init;</div>
<div class="evenline"> </div>
<div class="oddline"> <b>for</b> Str <b>in</b> FActions <b>do</b></div>
<div class="evenline"> Filter.addAction(StringToJString(Str));</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// TBroadcastReceiverListener を実体とした BroadcastReceiver を作成</span></div>
<div class="oddline"> FBroadcastReceiverListener := TBroadcastReceiverListener.Create(Self);</div>
<div class="evenline"> FReceiver :=</div>
<div class="oddline"> TJFMXBroadcastReceiver.JavaClass.init(FBroadcastReceiverListener);</div>
<div class="evenline"> </div>
<div class="oddline"> <b>try</b></div>
<div class="evenline"> <span class="comment">// レシーバーとして登録</span></div>
<div class="oddline"> SharedActivityContext.getApplicationContext.registerReceiver(</div>
<div class="evenline"> FReceiver,</div>
<div class="oddline"> Filter);</div>
<div class="evenline"> <b>except</b></div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> TBroadcastReceiver.UnsetReceiver;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// アプリケーションが終了中でなければ、BroadcastReceiver を解除</span></div>
<div class="oddline"> <b>if</b></div>
<div class="evenline"> (FReceiver <> <b>nil</b>) <b>and</b></div>
<div class="oddline"> (<b>not</b> (SharedActivityContext <b>as</b> JActivity).isFinishing)</div>
<div class="evenline"> <b>then</b></div>
<div class="oddline"> <b>try</b></div>
<div class="evenline"> SharedActivityContext.getApplicationContext.unregisterReceiver(FReceiver);</div>
<div class="oddline"> <b>except</b></div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> FReceiver := <b>nil</b>;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>initialization</b></div>
<div class="evenline"><b>finalization</b></div>
<div class="oddline"> <b>if</b> (GBroadcastReceiver <> <b>nil</b>) <b>then</b></div>
<div class="evenline"> GBroadcastReceiver.DisposeOf;</div>
<div class="oddline"> </div>
<div class="evenline"><b>end</b>.</div>
</pre>
<br/>
<h3>使用方法</h3>
<pre class="code">
<div class="oddline"><b>type</b></div>
<div class="evenline"> <span class="comment">// JString は Androidapi.JNI.JavaTypes に</span></div>
<div class="oddline"> <span class="comment">// JIntent は Androidapi.JNI.GraphicsContentViewText に</span></div>
<div class="evenline"> <span class="comment">// JStringToString は Androidapi.Helpers に</span></div>
<div class="oddline"> <span class="comment">// それぞれ定義されています</span></div>
<div class="evenline"> TForm1 = <b>class</b>(TForm)</div>
<div class="oddline"> <b>procedure</b> FormCreate(Sender: TObject);</div>
<div class="evenline"> <b>private</b></div>
<div class="oddline"> <b>procedure</b> Received(<b>const</b> iAction: JString);</div>
<div class="evenline"> <b>public</b></div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> Form1: TForm1;</div>
<div class="oddline"> </div>
<div class="evenline"><b>implementation</b></div>
<div class="oddline"> </div>
<div class="evenline"><b>uses</b></div>
<div class="oddline"> uBraodcastReceiver;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">{$R *.fmx}</span></div>
<div class="evenline"> </div>
<div class="oddline"><b>procedure</b> TForm1.FormCreate(Sender: TObject);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> BroadcastReceiver.OnReceived := Received;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// スクリーン ON / OFF を受け取るように設定</span></div>
<div class="evenline"> BroadcastReceiver.AddAction(</div>
<div class="oddline"> [</div>
<div class="evenline"> TJIntent.JavaClass.ACTION_SCREEN_OFF,</div>
<div class="oddline"> TJIntent.JavaClass.ACTION_SCREEN_ON</div>
<div class="evenline"> ]</div>
<div class="oddline"> );</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> TForm1.Received(<b>const</b> iAction: JString);</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Log.d(<span class="string">'Broadcast Received = '</span> + JStringToString(iAction));</div>
<div class="oddline"><b>end</b>;</div>
</pre>
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com2tag:blogger.com,1999:blog-5767280911867023345.post-16436156762902622202014-12-15T00:00:00.000+09:002014-12-15T12:19:50.517+09:00CodeIQ 第7回デスマコロシアムの解(Pascal でのショートコーディング)<a href="http://qiita.com/advent-calendar/2014/delphi">Delphi / Appmethod Advent Calendar 2014</a> 12/15 の記事です<br>
<br>
<a href="https://codeiq.jp/">CodeIQ</a> というリクルートのサイトで、<a href="https://twitter.com/tbpgr">@tbpgr さん</a>によって不定期開催されている「<a href="https://codeiq.jp/magazine/tag/deathma/">デスマコロシアム</a>」という<a href="http://ja.wikipedia.org/wiki/%E3%82%B3%E3%83%BC%E3%83%89%E3%82%B4%E3%83%AB%E3%83%95">コードゴルフ</a>(短いコードを競うもの)大会があります。<br>
このデスマコロシアムは <a href="http://ideone.com">ideone</a> で採点されるので、なんと! Free Pascal(fpc)が言語に入っているのです。<br>
CodeIQ で Pascal が使えるのは非常に珍しい…<br>
<br>
ちなみに fpc は Object Pascal というか Delphi 互換(を目指している)なので、Delphi を持っている場合は ideone よりも簡単に try & error で色々チャレンジできます。<br>
しかし!Pascal はとても解りやすく書けるためショートコーディングには向きません!<br>
/(^o^)\<br>
まあ、そんなこと言っても始まらないので、ショートコーディングのポイントをいくつか紹介します。<br>
<br>
<h3>デスマコロシアムの問題</h3>
今回の問題は…<br>
<pre class="code">
下記の文字列を標準出力せよ
>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.
</pre>
でした。<br>
解る人には解りますが、これは brainf*ck のコードです。<br>
なので、これを brainf*uck で走らせると<br>
<pre class="code">
deathma colosseum
</pre>
という文字列を出力するコードだと解ります。<br>
なので、これは
<pre class="code">
">"+(文字コード分の"+")+"."
</pre>
を出力すればいいという事になります。<br>
<br>
より詳しい解説はオフィシャルの <a href="https://codeiq.jp/magazine/2014/12/19179/">CodeIQ MAGAZIN</a> をご覧ください。<br>
<br>
<h3>解答</h3>
僕の解答は次の通り。<br>
fpc で 77 文字に纏まりました。<br>
そのコードがこちら。<br>
<pre class="code">
<div class="oddline"><b>for</b> PChar(@argc)^<b>in</b><span class="string">'deathma colosseum'</span><b>do</b> <b>Write</b>(<span class="string">^~</span>,StringOfChar(<span class="string">'+'</span>,argc),<span class="string">'.'</span>)</div>
</pre>
<br>
<h3>0.文字の字詰め</h3><br>
これは当然ですが出来る限り字を詰めて書きます。<br>
文字列のシングルクオートの後は空白をいれずに予約語を書けたり、ポインタ逆参照演算子でも予約語を書けます。<br>
他にも整数などの数についてもできます。<br>
これは前提条件なので0番です。<br>
<br>
<h3>1.for-in-do</h3><br>
fpc なので for-in-do 文が使えます(GNU Pascal や Pure Pascal では使えません)。<br>
コードにあるように即値で文字列を書けるので、それだけでも短くなります。<br>
ただ、1つ注意が必要なのは Delphi では、PChar(@argc)^ とは書けません!<br>
Delphi のコンパイラの方が厳格なので E1019 が発生します。<br>
Delphi 使うと簡単に書けるよ!っていっておきながらコレ!<br>
<br>
<h3>2.定義済み変数</h3><br>
Delphi では System.pas などに定義済み変数がいくつか定義されています。<br>
それと同じように fpc にも定義済み変数があります。<br>
使い出がありそうなのは…<br>
<br>
<table class="tb1">
<tr>
<td>変数名</td>
<td>型</td>
<td>本来の意味</td>
</tr>
<tr>
<tr>
<td>argc</td>
<td>Integer</td>
<td>引数の数</td>
</tr>
<tr>
<td>argv</td>
<td>PPChar</td>
<td>引数へのポインタ(256 byte 確保済み)</td>
</tr>
<tr>
<td>envp</td>
<td>PPChar</td>
<td>環境ブロックへのポインタ(256 byte 確保済み)</td>
</tr>
</table>
<br>
これらを使うと var ブロックを書く必要がありません!<br>
ただ変数名が長いので変数がたくさん出てくる場合は var ブロックを書いた方が短くなるかもしれません。<br>
<br>
<h3>3.コントロールコードの記述</h3><br>
Pascal にはコントロールコードを直接記述する記法が存在します。<br>
プレフィクスとして "^" を付けると、その後に続く文字の ASCII コードから $40 を引いたものが、その値となります。<br>
たとえば ^A とすると #$01 が返ります。<br>
現在の実装だと文字コードから単純に $40 引くだけなので、上手くいけば 1byte コードを短くできます。<br>
今回は運良く ">" が "~" の $40 前だったのでコレを使いました。<br>
<br>
<h3>4.標準関数の使用</h3><br>
fpc では System.pas に StringOfChar が定義されているので、そのまま使えます。<br>
また、System.pas に定義されていないもの、他のユニットに定義されているものも使えます。<br>
他のコードゴルフでは解りませんが、デスマコロシアムでは include, import はコードの文字数に入らないため、uses も文字数に入りません!<br>
なので、実は uses StrUtils; としておけば、StringOfChar より2文字短い DupeString が使えます。<br>
これを忘れて、そのまま出してしまいましたが…<br>
<br>
<h3>5.型名</h3><br>
今回は var ブロックを使いませんでしたが、使う場合は型名に気をつけます。<br>
たとえば Integer は7文字ですが、Byte, Word は4文字です。<br>
このように型名だけで3文字も変わるので、必要なとき以外は Integer を使わないようにします。<br>
<br>
<h3>6.関数名への代入</h3><br>
今回は関数・手続きを使いませんでしたが、使う場合は戻り値の返し方にもテクニックがあります。<br>
元々 Pascal の関数が値を返す方法は Result 変数ではなく、関数名に戻り値を代入する方法でした。<br>
ただ、これだと再帰関数を作るのが難しかったため、Result 変数が Turbo Pascal で導入されました。<br>
ですが、関数名に戻り値を代入するのは、未だに有効な書き方です。<br>
これを使うと…
<br>
<pre class="code">
<div class="oddline"><b>function</b> p: Byte;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> p := <span class="number">1</span>;</div>
<div class="evenline"><b>end</b></div>
</pre>
<br>
このように書けるため Result を使うよりも短く書けます。<br>
<br>
<h3>7.文字列の取り出し方</h3><br>
Delphi だと次のように文字列の一部を取り出せます。<br>
<br>
<pre class="code">
<div class="oddline">Writeln(<span class="string">'deathma colosseum'</span>[<span class="number">1</span>]);</div>
</pre>
<br>
ですが fpc では、このコードはエラーになります。<br>
では、文字列をいったん const や var に入れないと使えないのか、というと、そうでもありません。<br>
fpc では、こんな風にするとコンパイルが通ります。<br>
<br>
<pre class="code">
<div class="oddline">Writeln((<span class="string">'deathma colosseum'</span>)[<span class="number">1</span>]);</div>
</pre>
<br>
<h3>8.Delphi だけの技</h3>
Delphi では、function / procedure をクロージャとしていきなり書けます。<br>
括弧の使い方の妙技ですね!
これを使うとコードを短く出来る可能性があります。<br>
<br>
<pre class="code">
<div class="oddline">Writeln((<b>function</b>:<b>String</b> <b>begin</b> Result:=<span class="string">'deathma colosseum'</span><b>end</b>)());</div>
</pre>
<br>
もう1つ class / record helper が使えます。<br>
fpc も将来的に使えるようになるっぽいです。<br>
<br>
<h3>GNU Pascal での解</h3>
GNU Pascal (gpc) での解も載せて起きます。<br>
<br>
<pre class="code">
<div class="oddline"><b>var</b> i,j:Byte;</div>
<div class="evenline"><b>for</b> i:=<span class="number">1</span>to <span class="number">17</span>do <b>begin</b> <b>Write</b>(<span class="string">'>'</span>);<b>for</b> j:=<span class="number">1</span>to Ord((<span class="string">'deathma colosseum'</span>)[i])<b>do</b> <b>Write</b>(<span class="string">'+'</span>);<b>Write</b>(<span class="string">'.'</span>);<b>end</b></div>
</pre>
デスマコロシアムでは元々書いてある部分(program ideone; begin end.)は文字数に入りません。<br>
なので、上記のコードも、それらは省いてあります。<br>
gpc 版でも上記の5番と7番のテクニックを使っています。<br>
<br>
<h3>まとめ</h3>
と、僕が知る限りのショートコーディングのテクニックを紹介しました!<br>
コードゴルフで Pascal が躍進するきっかけになればいいなと思っています!<br>
<br>
ちなみに、現在(2014/12/15)<a href="https://codeiq.jp/ace/tbpgr_colosseum_manager/q1220">デスマコロシアム第8回</a>が開催されています。<br>
腕に自信のある方々は、ご参加されてみたらいかがでしょう?<br>
多くの言語があるので、Pascal 以外でも楽しいと思いますよ!<br>
<br>Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-45117430605944049912014-12-01T00:00:00.000+09:002014-12-16T10:41:27.814+09:00OSX / iOS のデリゲートを全部取得する!<div style="text-align: right;">
</div><a href="http://qiita.com/advent-calendar/2014/delphi">Delphi Advent Calendar 2014</a> 12/01 の記事です。<br />
<br/>
<h3>2014/12/16 追記!</h3>
<br/>
Twitter で @wyvern77 氏に <a href="https://twitter.com/wyvern77/status/539417060371996672">"MethodNameAttribute" 属性を使えば Objective-C 本来の名前を指定できるぞ!</a>と教えていただきました。<br/>
また、@owlsperspective 氏に、<a href="http://owlsperspective.blogspot.jp/2014/09/attributes-defined-in-rtl.html">属性をまとめたページ</a>を教えてもらいました!<br>
これによると、Macapi.ObjectiveC ユニットに MethodNameAttribute 属性が定義されていて、それをメソッドの属性にしてやればいいようです。<br>
実は、まだ試していないのですが、とりあえず追記です!<br>
もっといい方法を教えてください、と書いたかいがあった!<br>
----- 追記ここまで ------------------------------<br>
<br/>
<br/>
<br/>
OSX / iOS 開発で必須になるのが Delegate。<br />
もちろん FireMonkey だけでことが足りるなら必要ありませんが!<br />
<br />
いわゆるデリゲートは、Delphi のメソッドポインタ(イベント)と同じで、オブジェクトへのポインタと関数へのポインタの両方を持つものとして、定義されてるみたい(<a href="http://ja.wikipedia.org/wiki/%E3%83%87%E3%83%AA%E3%82%B2%E3%83%BC%E3%83%88_%28%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%9F%E3%83%B3%E3%82%B0%29">wikipedia</a>)です。<br />
<br />
でも、OSX / iOS ではデリゲートは「委譲」(delegation)の方の意味合いが大きいです。<br />
実際に、どういう時に使われるかというと OS が提供している機能の拡張手段だったりオブジェクト同士の通信だったりします。<br />
そして、もちろんイベントにも使われる訳です。<br />
たとえば、UIWebView のイベントハンドラとしての UIWebViewDelegate は<br />
<pre class="code">
<div class="oddline">-webView:shouldStartLoadWithRequest:navigationType:</div>
<div class="evenline">-webViewDidStartLoad:</div>
<div class="oddline">-webViewDidFinishLoad:</div>
<div class="evenline">-webView:didFailLoadWithError:</div>
</pre>
こんなメソッド(メッセージ)が定義されています。<br />
で、こういった Delegate を Delphi で実装するのは、Interface の定義と TOCLocal から継承した2つのクラスが必要です。<br />
FireMonkey では、こんな感じで定義されてます。<br />
<pre class="code">
<div class="oddline">UIWebViewDelegate = <b>interface</b>(IObjectiveC)</div>
<div class="evenline"> [<span class="string">'{25E7C20B-68A2-4011-9D7F-B97647BD48C0}'</span>]</div>
<div class="oddline"> <b>procedure</b> webView(webView: UIWebView; didFailLoadWithError: NSError); </div>
<div class="evenline"> <b>cdecl</b>; <b>overload</b>;</div>
<div class="oddline"> <b>function</b> webView(</div>
<div class="evenline"> webView: UIWebView;</div>
<div class="oddline"> shouldStartLoadWithRequest: NSURLRequest; </div>
<div class="evenline"> navigationType: UIWebViewNavigationType): Boolean; <b>cdecl</b>; <b>overload</b>;</div>
<div class="oddline"> <b>procedure</b> webViewDidFinishLoad(webView: UIWebView); <b>cdecl</b>;</div>
<div class="evenline"> <b>procedure</b> webViewDidStartLoad(webView: UIWebView); <b>cdecl</b>;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> </div>
<div class="evenline">TiOSWebViewDelegate = <b>class</b> (TOCLocal, UIWebViewDelegate)</div>
<div class="oddline"><b>public</b></div>
<div class="evenline"> <b>procedure</b> webView(webView: UIWebView; didFailLoadWithError: NSError); </div>
<div class="oddline"> <b>overload</b>; <b>cdecl</b>;</div>
<div class="evenline"> <b>function</b> webView(</div>
<div class="oddline"> webView: UIWebView; </div>
<div class="evenline"> shouldStartLoadWithRequest: NSURLRequest; </div>
<div class="oddline"> navigationType: UIWebViewNavigationType): Boolean; <b>overload</b>; <b>cdecl</b>;</div>
<div class="evenline"> <b>procedure</b> webViewDidFinishLoad(webView: UIWebView); <b>cdecl</b>;</div>
<div class="oddline"> <b>procedure</b> webViewDidStartLoad(webView: UIWebView); <b>cdecl</b>;</div>
<div class="evenline"><b>end</b>;</div>
</pre>
で、あとは、下記のようにすればイベントが呼ばれます。
<pre class="code">
<div class="oddline">FDelegate := TiOSWebViewDelegate.Create;</div>
<div class="evenline">FWebView.setDelegate(FDelegate.GetObjectID);</div>
</pre>
というか一般的なデリゲートの作り方と使い方は、むしろ <a href="http://blogs.embarcadero.com/teamj/2013/05/09/3817/">Team J の「FireMonkey iOS - event delegateの使い方のサンプル」</a>の記事の方が詳しいので、そちらをご覧ください。<br />
<br />
<span class="extra">ここからが本題。</span><br />
<br />
実はですね、上記の方法では特定のデリゲートしか使えないのです。<br />
ここで、問題になるのは、Object Pascal と Objective-C の文法・実行方法の違いです。<br />
どういうことかというと、Objective-C では、メソッドとして見えるものはメッセージであり、メッセージは、そのパラメータを含めて1つのメッセージを構成しているということです。<br />
つまり、引数の名前さえ違っていれば、別のメソッドとしてとらえられるということです。
たとえば、上記の UIWebViewDelegate でいえば<br />
<br />
■Objective-C
<pre class="code">
<div class="oddline">- (BOOL)webView:(UIWebView *)</span>webView</div>
<div class="evenline"> shouldStartLoadWithRequest:(NSURLRequest *)</span>request</div>
<div class="oddline"> navigationType:(UIWebViewNavigationType)navigationType</div>
<div class="evenline"> </div>
<div class="oddline">-(void)webView:(UIWebView *)</span>webView</div>
<div class="evenline"> didFailLoadWithError:(NSError *)</span>error</div>
<div class="oddline"> </div>
</pre>
こんな風に定義されているものが<br />
<br />
■Object Pascal
<pre class="code">
<div class="oddline"><b>procedure</b> webView(</div>
<div class="evenline"> webView: UIWebView; </div>
<div class="oddline"> didFailLoadWithError: NSError); <b>cdecl</b>; <span class="extra">overload</span>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>function</b> webView(</div>
<div class="evenline"> webView: UIWebView; </div>
<div class="oddline"> shouldStartLoadWithRequest: NSURLRequest; </div>
<div class="evenline"> navigationType: UIWebViewNavigationType): Boolean; <b>cdecl</b>; <span class="extra">overload</span>;</div>
</pre>
こうなるわけですが、ここで見てほしいのが "overload" です。<br />
Objective-C では、メッセージはパラメータの引数の型ではなく、メッセージの名前とパラメータの名前で特定されます。<br />
ですが、Object Pascal では、同じメソッド名の場合、引数の型が異なっている必要があります。<br />
で、この違いがもたらす結果ですが…もうおわかりでしょうか。<br />
<br />
たとえば、WebViewFrameDelegate は<br />
<pre class="code">
<div class="oddline">-webView:didStartProvisionalLoadForFrame:</div>
<div class="evenline">-webView:didFinishLoadForFrame:</div>
<div class="oddline">-webView:didCommitLoadForFrame:</div>
<div class="evenline">-webView:willCloseFrame:</div>
<div class="oddline">-webView:didChangeLocationWithinPageForFrame:</div>
</pre>
こんな感じで、引き数名は全部違うものの型は全部 WebViewFrame です!!<br />
Object Pascal で実装すると…<br />
<pre class="code">
<div class="oddline">WebFrameLoadDelegate = <b>interface</b>(IObjectiveC)</div>
<div class="evenline"> <b>procedure</b> webView(</div>
<div class="oddline"> sender: WebView;</div>
<div class="evenline"> didStartProvisionalLoadForFrame: WebFrame); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="oddline"> <b>procedure</b> webView(</div>
<div class="evenline"> sender: WebView;</div>
<div class="oddline"> didFinishLoadForFrame: WebFrame); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="evenline"> <b>procedure</b> webView(</div>
<div class="oddline"> sender: WebView;</div>
<div class="evenline"> didCommitLoadForFrame: WebFrame); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="oddline"> <b>procedure</b> webView(</div>
<div class="evenline"> sender: WebView;</div>
<div class="oddline"> willCloseFrame: WebFrame); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="evenline"> <b>procedure</b> webView(</div>
<div class="oddline"> sender: WebView;</div>
<div class="evenline"> didChangeLocationWithinPageForFrame: WebFrame); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="oddline"><b>end</b></div>
</pre>
こうなります。しかし、引数の型が全部同じなので、コンパイラに怒られます!<br />
これは困った…<br />
FireMonkey では、どうやってるんだ!と思って調べたところ<br />
<pre class="code">
<div class="oddline">UIPickerViewDelegate = <b>interface</b>(IObjectiveC)</div>
<div class="evenline"><span class="comment">// procedure pickerView(</span></div>
<div class="oddline"><span class="comment">// pickerView: UIPickerView;</span></div>
<div class="evenline"><span class="comment">// didSelectRow: NSInteger;</span></div>
<div class="oddline"><span class="comment">// inComponent: NSInteger); cdecl; overload;</span></div>
<div class="evenline"><span class="comment">// function pickerView(</span></div>
<div class="oddline"><span class="comment">// pickerView: UIPickerView;</span></div>
<div class="evenline"><span class="comment">// rowHeightForComponent: NSInteger): Single; cdecl; overload;</span></div>
<div class="oddline"> <b>function</b> pickerView(</div>
<div class="evenline"> pickerView: UIPickerView; </div>
<div class="oddline"> titleForRow: NSInteger; </div>
<div class="evenline"> forComponent: NSInteger): NSString; <b>cdecl</b>; <span class="extra">overload</span>;</div>
<div class="oddline"><span class="comment">// function pickerView(</span></div>
<div class="evenline"><span class="comment">// pickerView: UIPickerView;</span></div>
<div class="oddline"><span class="comment">// viewForRow: NSInteger;</span></div>
<div class="evenline"><span class="comment">// forComponent: NSInteger;</span></div>
<div class="oddline"><span class="comment">// reusingView: UIView): UIView; cdecl; overload;</span></div>
<div class="evenline"><b>end</b>;</div>
</pre>
まさかのコメントアウト!!! oh...<br />
<br />
で、ググったりしたものの解決策がなかったため、いろいろ考えました末に思いついたのが<br />
<br />
<span class="extra">type TBar = type TFoo;</span><br />
<br />
構文!<br />
この構文を使うと、<a href="http://docwiki.embarcadero.com/RADStudio/XE7/ja/%E5%9E%8B%E3%81%AE%E4%BA%92%E6%8F%9B%E6%80%A7%E3%81%A8%E5%90%8C%E4%B8%80%E6%80%A7#.E5.9E.8B.E3.81.AE.E5.90.8C.E4.B8.80.E6.80.A7">別の型として同じ型を定義できます</a>。<br />
そう!これを使えば!<br />
<br />
<pre class="code">
<div class="oddline"><b>type</b></div>
<div class="evenline"> WebFrame2 = <b>type</b> WebFrame;</div>
<div class="oddline"> WebFrame3 = <b>type</b> WebFrame;</div>
<div class="evenline"> WebFrame4 = <b>type</b> WebFrame;</div>
<div class="oddline"> WebFrame5 = <b>type</b> WebFrame;</div>
<div class="evenline"> </div>
<div class="oddline"> WebFrameLoadDelegate = <b>interface</b>(IObjectiveC)</div>
<div class="evenline"> <b>procedure</b> webView(</div>
<div class="oddline"> sender: WebView;</div>
<div class="evenline"> didStartProvisionalLoadForFrame: WebFrame); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="oddline"> <b>procedure</b> webView(</div>
<div class="evenline"> sender: WebView;</div>
<div class="oddline"> didFinishLoadForFrame: WebFrame2); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="evenline"> <b>procedure</b> webView(</div>
<div class="oddline"> sender: WebView;</div>
<div class="evenline"> didCommitLoadForFrame: WebFrame3); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="oddline"> <b>procedure</b> webView(</div>
<div class="evenline"> sender: WebView;</div>
<div class="oddline"> willCloseFrame: WebFrame4); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="evenline"> <b>procedure</b> webView(</div>
<div class="oddline"> sender: WebView;</div>
<div class="evenline"> didChangeLocationWithinPageForFrame: WebFrame5); <span class="extra">overload</span>; <b>cdecl</b>;</div>
<div class="oddline"> <b>end</b></div>
</pre>
こんな感じで定義できます!<br />
もちろん、コンパイラに怒られません!<br />
そして、ちゃんと OS からコールバックされます。<br />
<br />
これで、全部のデリゲートを受け取れる!と思いきや、もう1つ問題がある事お気づきでしょうか?<br />
<br />
それは、<span class="extra">予約語の問題</span>、です。<br />
<br />
Object Pascal では様々な言葉が予約語になっていますが、その中で群を抜いて他の言語で使われるのが<br />
<br />
<span class="extra">type</span><br />
<br />
です。<br />
OSX / iOS でもパラメータ名として type が使われている事があります(もちろん他の予約語が使われている事も)。<br />
たとえば、NSEvent には<br />
<pre class="code">
<div class="oddline">@property(readonly) NSEventType <span class="extra">type</span></div>
</pre>
というプロパティが定義されています。<br />
<br />
ですが、これにはとても簡単に対処できます。<br />
Object Pascal には、予約語を予約語として認識させないプレフィクスがあります。<br />
<br />
それは、<span class="extra">&</span> です。<br />
<br />
& を予約語の前につければ、コンパイラは予約語として扱いません。<br />
先ほどの NSEvent の FireMonkey での実装は<br />
<pre class="code">
<div class="oddline">NSEvent = <b>interface</b>(NSObject)</div>
<div class="evenline"> <b>function</b> <span class="extra"=>&<b>type</b></span>: NSEventType; <b>cdecl</b>;</div>
<div class="oddline"><b>end</b>;</div>
</pre>
こうなっています。<br />
これで、予約語の問題も簡単に回避できました!<br />
<br />
で、これらを駆使して <a href="https://github.com/freeonterminate/delphi/blob/master/TWebBrowser/Macapi.WebView.pas">Macapi.WebView.pas</a> ができあがりました。<br />
このソースの中の WevViewFrameDelegate の部分で type 構文が使われています。<br />
<br />
これで全部のデリゲートを使用可能になりました。<br />
<br />
ちなみに、ググっても見つからなかったのですが、これよりもよい方法をご存じでしたら教えてください!<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-34536655310086754962013-12-25T00:00:00.000+09:002013-12-25T00:00:01.703+09:00チラ裏(個人的な事を振り返る)<a href="http://qiita.com/advent-calendar/2013/delphi" target="_blank">Delphi Advent Calendar 2013</a> の 12/25 の記事です。<br />
<br />
ということで、ブログで初めて個人的な事を書くよ!!<br />
Delphi Advent Calendar の最後の記事がチラ裏でごめんね!!<br />
<br />
今年あった大きな事は<br />
<ol>
<li>Delphi iOS の本を出した</li>
<li>Embarcadero MVP になった</li>
<li>LL祭りに出た</li>
</ol>
<div>
ってことです。</div>
<div>
<br /></div>
<div>
まず、本については、非常に僥倖でした。</div>
<div>
お話を頂いて、毎晩+土日を使って書いたんですけど、まだベータ版の段階だったので、メソッドが変わったり、動作が変わるwww</div>
<div>
何度、書き直した事か……!</div>
<div>
そして、査読してくださった方々や、エンバカデロの皆さん、CUTT SYSTEM の皆さんのご協力があって、完成しました。</div>
<div>
人生で本を出すのは2度目ですが、やっぱり、大変な作業でしたよ…。</div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
次は、エンバカデロ MVP になりました、というお話です。</div>
<div>
エンバカデロ MVP になるためには、デベロッパーキャンプなどのイベントに出演していること、ブログなどで情報を発信していること、などがあります。</div>
<div>
そして、誰かが推薦して認められると、MVPになります。<br />
MVP は年に1回9月に任命されます。</div>
<div>
<br /></div>
<div>
ここで、凄いのは、エンバカデロ本社の MVP 担当部署から直接連絡が来るところです。</div>
<div>
エンバカデロ日本法人は関与していません!</div>
<div>
<br /></div>
<div>
僕は英語のメールは全部 SPAM だと思っているので、危うく MVP 任命のメールを捨てるところでした!</div>
<div>
ちなみに、推薦してくれたのもエンバカデロの人では無いですし、MVP 担当部署は僕の知らない所ですし、誰かが便宜を図ってくれたとかは無いです。</div>
<div>
<br /></div>
<div>
で、多分誰も知らないと思うので、MVPに任命されると何が起こるのか、を言えるところだけ言うと</div>
<div>
<ul>
<li>RAD Studio Enterprise 版の1年間限定ライセンスが貸与される</li>
<li>MVP オンライン・ミーティングに出席のお願いがくる(基本向こうの時間なので厳しい)</li>
<li>CodeRage などのイベントがあると、イベントの宣伝のお願いが来る</li>
<li>FieldTest のお願いがくる</li>
</ul>
</div>
<div>
といったところです。</div>
<div>
あとは、言えない部分でいくつかありますが、そこは察して!!<br />
あ、ちなみに、悪口を言ってはいけないとかも無いです。<br />
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
3つめは「<a href="http://ll.jus.or.jp/2013/" target="_blank">LL まつり</a><span id="goog_122530445"></span><span id="goog_122530446"></span><a href="http://www.blogger.com/"></a>」という、Lightweight Language のイベントに出席したことです。</div>
<div>
Delphi なんで、いままでクライアントサイドのイベントにしか出たこと無かったですが、ちょっとしたご縁により、出させて貰いました。</div>
<div>
これで、Delphi について話せたのが個人的には凄く嬉しい出来事でした。</div>
<div>
というのも、Delphi 知らない人にも Delphi という言葉を伝えられたのと、昔 Delphi 使ってた人達に Delphi を思い出して貰えたからです!</div>
<div>
<br /></div>
<div>
今の Delphi は、iOS / Android / Win / OS X と4つのプラットフォームに対応していますが、これを伝えられたのは本当に大きくて、色々と反響をいただきました。</div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
最後に、来年のこと。</div>
<div>
LL まつりの縁で、来年の<a href="http://www.cross-party.com/" target="_blank"> CROSS 2014</a> にも登壇します。これも、どちらかといえば LL 系言語のイベントですが、言語同士のバトルが見たいwwwということでお話を頂きました。</div>
<div>
が、バトルはしません!宗教戦争になるので!それぞれの言語について、色々紹介するイベントになります。</div>
<div>
<br /></div>
<div>
さらに、その後「<a href="http://event.shoeisha.jp/devsumi/20140213/" target="_blank">Developers Summit</a>」にも出ます!</div>
<div>
こちらでは、モバイル開発に対して、ちょっと話してきます。</div>
<div>
<br /></div>
<div>
と、いうことで、2014年も色々活動できたらなーと思っています。</div>
<div>
<br /></div>
<div>
あ、そうそう、Delphi Android の本も書いているので、今しばらくお待ちを……</div>
<div>
<br /></div>
<div>
それでは、良いお年を!!</div>
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-2680272778952525682013-12-23T00:00:00.000+09:002014-06-30T13:02:36.224+09:00FireMonkey の TWebBrowser を Win/Mac で使えるようにする!<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/tree/master/TWebBrowser">ソースはこちら(GitHub)</a>
</div>
<a href="http://qiita.com/advent-calendar/2013/delphi">Delphi Advent Calendar 2013</a> 12/23 の記事です。<br />
<br />
なんだか、結構需要があるっぽい FireMonkey 用の TWebBrowser を作りました!というお話です。<br />
<br />
FireMonkey で複数 Platform に対応するコントロールを作るためには「共通の要素を Interface 化する」という作業が必要になります。<br />
そして、それぞれの Platform で、その Interface を実装してやります。<br />
今回は、iOS / Android 用の TWebBrowser が継承しているのと同じ ICustomBrowser を継承して、Win/Mac 用の TWebBrowser を作りました。<br />
<br />
また、FireMonkey のファイル名は、FMX.コントロール名.Platform.pas とする慣習があります。<br />
ということで、今回は<br />
<ul>
<li>FMX.WebBrowser.Win.pas</li>
<li>FMX.WebBrowser.Mac.pas</li>
</ul>
という名前にしました。<br />
<br />
また、元々の TWebBrowser は iOS / Android 用なので Parent を設定するという処理がありません。<br />
Parent が設定されたら ICustomBrowser を継承した WebBrowser を表示する必要があるので、それらを処理する TWebBrowserEx というコンポーネントも作りました。<br />
<br />
また、もう一つ FireMonkey の慣習があって、各プラットフォーム用の Interface は、implementation 部に書き、interface 部には、それを登録する関数だけ宣言する、というモノがあります。<br />
あまり好きでは無いのですが、今回は、それに習って Win/Mac 用のユニットには RegisterWebBrowserService と UnregisterWebBrowserService という関数だけ用意しました。<br />
<br />
<pre class="code"><div class="oddline">
<b>unit</b> FMX.WebBrowser.Win;</div>
<div class="evenline">
</div>
<div class="oddline">
<b>interface</b></div>
<div class="evenline">
</div>
<div class="oddline">
<b>procedure</b> RegisterWebBrowserService;</div>
<div class="evenline">
<b>procedure</b> UnRegisterWebBrowserService;</div>
<div class="oddline">
</div>
<div class="evenline">
<b>implementation</b></div>
</pre>
<br />
<pre class="code"><div class="oddline">
<b>unit</b> FMX.WebBrowser.Mac;</div>
<div class="evenline">
</div>
<div class="oddline">
<b>interface</b></div>
<div class="evenline">
</div>
<div class="oddline">
<b>procedure</b> RegisterWebBrowserService;</div>
<div class="evenline">
<b>procedure</b> UnRegisterWebBrowserService;</div>
<div class="oddline">
</div>
<div class="evenline">
<b>implementation</b></div>
</pre>
<br />
この関数を呼ぶと、TPlatformServices に Win/Mac 用の WebBrowser コントロールを「生成するクラスのインスタンス」が登録される仕組みです。<br />
ここで、WebBrowser コントロールのインスタンスを登録してはいけません!そうすると1個しかインスタンスが作れませんからね!<br />
WebBrowser コントロールを生成するクラスのインスタンスを登録しておけば、そのインスタンスを取り出して、いくらでも WebBrowser を生成できます。<br />
<br />
登録したインスタンスは TPlatformServices.Current.SupportsPlatformService メソッドで取り出せます。<br />
<br />
RegisterWebBrowserService は initialization で呼ぶようにします。<br />
<br />
<pre class="code"><div class="oddline">
<b>initialization</b></div>
<div class="evenline">
RegisterWebBrowserService;</div>
<div class="oddline">
</div>
<div class="evenline">
<b>end</b>.</div>
</pre>
<br />
これで、それぞれの Platform 用のユニットを読み込むと、Platform に適したコンポーネントが使えるようになります。<br />
もちろん、それぞれの Platform 用のユニットは IFDEF を使って、どれを読み込むか制御します。<br />
今回は、Win/Mac 用なので、下記のように制御しました。<br />
<br />
<pre class="code"><div class="oddline">
<b>uses</b></div>
<div class="evenline">
System.Rtti</div>
<div class="oddline">
<span class="comment">{$IFDEF MSWINDOWS}</span></div>
<div class="evenline">
, FMX.WebBrowser.Win</div>
<div class="oddline">
<span class="comment">{$ENDIF}</span></div>
<div class="evenline">
<span class="comment">{$IFDEF MACOS}</span></div>
<div class="oddline">
, FMX.WebBrowser.Mac</div>
<div class="evenline">
<span class="comment">{$ENDIF}</span></div>
<div class="oddline">
;</div>
</pre>
<br />
これで、Win/Mac 用の WebBrowser を使えるようになりました。<br />
しかし、WebBrowserEx には、WebBrowser を生成しているコードはありません!<br />
生成するコードは、親の親である TCustomWebBrowser の Create で生成されています。<br />
TPlatformServices に登録してあるので、こちらでは何もせずに、正しいインスタンスが生成されます。すばらしい!<br />
<br />
ちなみに、軽く各 Platform の実装を説明すると、<br />
<br />
Windows 用は、VCL の TWebBrowser を使っています。<br />
IWebBrowserX を取り出したりとか、めんどくさいから!!<br />
FireMonkey でも別に VCL のコントロールも使えてしまうのです。<br />
FireMonkey は TForm だけが Window Handle を持っています。<br />
Windows 用 WebBrowser は、VCL なので、独自に WindowHandle を持っています。<br />
そのため、VCL の TWebBrowser より 上に FireMonkey のコントロールを載せることはできません!<br />
今回は、TForm の指定された(Parent で)場所にコントロールが載っているように見せています。<br />
単純に、Parent の Left,Top,Right,Bottom に合致するように TWebBrowser を作っているだけです。<br />
<br />
OS X 用も基本的には同じ仕組みです。<br />
ただ、こちらは VCL の TWebBrowser などないので、自分で WebView を実装しました…超大変だった…<a href="https://github.com/freeonterminate/delphi/blob/master/TWEbBrowser/Macapi.WebView.pas">Obj-C から Delphi 用のファイルを作るのが</a>。<br />
これができたら、あとは実直に WebView を作るだけです。<br />
で、結構はまってる人が居るみたいですが、<a href="http://stackoverflow.com/questions/9731817/webview-not-displaying-in-macos-using-delphi-xe2">StackOverflow に提示してあるコードは間違っています</a>。<br />
なぜか <a href="https://developer.apple.com/library/mac/documentation/cocoa/Reference/WebKit/Classes/WebView_Class/Reference/Reference.html#//apple_ref/occ/instm/WebView/setHostWindow:">setHostWindow</a> を使っていますが、これはレシーバ用の Host を決めるためのもので、Parent を設定するモノではありません!<br />
実際には、下記のように addSubView を使って親を設定します。<br />
<br />
<pre class="code"><div class="oddline">
<b>procedure</b> TMacWebBrowserService.UpdateContentFromControl;</div>
<div class="evenline">
<b>var</b></div>
<div class="oddline">
View: NSView;</div>
<div class="evenline">
Bounds: TRectF;</div>
<div class="oddline">
<b>begin</b></div>
<div class="evenline">
<b>if</b> (FWebView <> <b>nil</b>) <b>then</b> <b>begin</b></div>
<div class="oddline">
<b>if</b></div>
<div class="evenline">
(FWebControl <> <b>nil</b>)</div>
<div class="oddline">
<b>and</b> <b>not</b> (csDesigning <b>in</b> FWebControl.ComponentState)</div>
<div class="evenline">
<b>and</b> (FForm <> <b>nil</b>)</div>
<div class="oddline">
<b>then</b> <b>begin</b></div>
<div class="evenline">
Bounds := GetBounds;</div>
<div class="oddline">
</div>
<div class="evenline">
View := WindowHandleToPlatform(FForm.Handle).View;</div>
<div class="oddline">
View.addSubview(FWebView);</div>
<div class="evenline">
</div>
<div class="oddline">
<b>if</b> (SameValue(Bounds.Width, <span class="number">0</span>)) <b>or</b> (SameValue(Bounds.Height, <span class="number">0</span>)) <b>then</b></div>
<div class="evenline">
FWebView.setHidden(True)</div>
<div class="oddline">
<b>else</b> <b>begin</b></div>
<div class="evenline">
FWebView.setFrame(GetNSBounds);</div>
<div class="oddline">
FWebView.setHidden(<b>not</b> FWebControl.ParentedVisible);</div>
<div class="evenline">
<b>end</b>;</div>
<div class="oddline">
<b>end</b></div>
<div class="evenline">
<b>else</b></div>
<div class="oddline">
FWebView.setHidden(True);</div>
<div class="evenline">
<b>end</b>;</div>
<div class="oddline">
<b>end</b>;</div>
</pre>
<br />
これで、表示されるようになります。<br />
<br />
実際に使うと、こんな感じ!<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEilq1vbiGvFXvmzM_ocG-PLZ1X4rCLNwj6HSph2a6Rg54e6ZBlnQ2_XXSFlEmzLntwE1P_HFzjS6v-X0nQ-KAXqfViY0CfEyd3H9MG27N7noRa8KQO4JFavjcCQJc7jFfrQ7eGSng2ywX8l/s1600/1.png" imageanchor="1"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEilq1vbiGvFXvmzM_ocG-PLZ1X4rCLNwj6HSph2a6Rg54e6ZBlnQ2_XXSFlEmzLntwE1P_HFzjS6v-X0nQ-KAXqfViY0CfEyd3H9MG27N7noRa8KQO4JFavjcCQJc7jFfrQ7eGSng2ywX8l/s320/1.png" /></a><br />
<br />
<br />
<br />
<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com30tag:blogger.com,1999:blog-5767280911867023345.post-4965128506065888002013-12-22T00:00:00.000+09:002013-12-22T00:00:02.556+09:00FireMonkey で閉じるボタン付きの TabItem を作る<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/tree/master/FMX.TabItemWithClose">ソースはこちら(GitHub)</a>
</div><a href="http://qiita.com/advent-calendar/2013/delphi">Delphi Advent Calendar 2013</a> 12/22 の記事です。<br />
<br/>
FireMonkey で「閉じるボタン付きの TabItem」を作ってみました。<br />
これは、そもそもは facebook の Delphi Talks グループで田中さんが<a href="https://www.facebook.com/groups/delphitalks/permalink/537586329660037/">「格好いい?「PageControl 」を探しています」</a>というスレッドを立てたので、僕が FireMonkey で作るのはいかがですか!とオススメした所から始まっています。<br />
ということで、FireMonkey でコンポーネントをるのは大変ではないので、作りました<br />
でも、うかうかしているうちに、<a href="http://i65000.blogspot.jp/2013/12/nixie.html">やましょうさんの前日の Advent Calendar</a> で<br />
<br />
<div class="column">
> Fmxで作成してみるとわかるのですが、<br />
> delphi+fmxって<br />
> 本当に凄い!! <br />
> <br />
> だってこんなコンポーネントが簡単にできるんですよ。。<br />
> しかも、携帯端末(iosなど)で動くのですから。。<br />
</div>
<br />
と、言いたいことを言われてしまいました!!/(^o^)\<br />
これが Delphi Advent Calendar の怖いところ!!早い者勝ちなので、来年からは書きたいことがあったら、もっと早く書こう…<br/>
<br/>
まあ、それはそれとして、FireMonkey で、コンポーネントを作る方法は大きく分けて次の3段階が必要です。<br/>
<ol>
<li>スタイルを作る</li>
<li>コンポーネントを作る</li>
<li>コンポーネントエディタを作る</li>
</ol>
VCL のコンポーネントと大きく違うのは1番目のスタイルを作る部分です。<br/>
FireMonkey の場合、見た目の制御は、ほとんど全部スタイルに任せます。<br />
ですが!スタイルを1から作るのはメンドクサイ!<br />
大体が <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/FMX.Objects.TShape">TShape</a> から派生した <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/FMX.Objects.TRectangle">TRectangle</a> とか <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/FMX.Objects.TCircle">TCircle</a> とか <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/FMX.Objects.TText">TText</a> とかを組み合わせて作るのですが、そういった簡単な図形以外は <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/FMX.Objects.TPath">TPath</a> を使って作ります。<br />
TPath は SVG とか XAML のパスデータを描画してくれるコントロールです。<br />
今回の「閉じるボタン」は「×」の形をしているので、単純な Shape を組み合わせて作るのは大変です!<br />
なので、今回はズルします!<br />
既に「×」ボタンを持っているコントロールからスタイルを盗みましょう。<br />
そのコントロールとは TClearingEdit です。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh30wYECtFYfDDIDxOdk3KrbMyc0fdcR5iXyMBD59-wmULtz7jExUIrt2CfPDi8vZhDFL3a0dQPeAMINJmbCXa4SivnFXfGjcgaUGRbylyP3j5Vh0kqKuE6XD3g-fAtcxMEihk8bzMpCEnH/s1600/21.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh30wYECtFYfDDIDxOdk3KrbMyc0fdcR5iXyMBD59-wmULtz7jExUIrt2CfPDi8vZhDFL3a0dQPeAMINJmbCXa4SivnFXfGjcgaUGRbylyP3j5Vh0kqKuE6XD3g-fAtcxMEihk8bzMpCEnH/s320/21.png" /></a>
<br />
<br />
ということで、方針が定まったのでスタイルを作っていきます。まずは、TStyleBook をフォームに貼ります。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhwsIFASmqVdvhFw7EtO5GpUxd97LwuEBPr1CNQBn009SNT3kiFdkuDTgqBKDK6Ek3LSFazVGqT-pSeBBjnqm6Ht80kqvOZ_QmhxsY4uRPl-ASwPXYmKksW9UTSkAAj34C4K5mrMvXNlYpR/s1600/1.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhwsIFASmqVdvhFw7EtO5GpUxd97LwuEBPr1CNQBn009SNT3kiFdkuDTgqBKDK6Ek3LSFazVGqT-pSeBBjnqm6Ht80kqvOZ_QmhxsY4uRPl-ASwPXYmKksW9UTSkAAj34C4K5mrMvXNlYpR/s320/1.png" /></a><br/>
<br/>
そして、TStyleBook をダブルクリックしてスタイルエディタを開きます。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhSzvnWYUzTfBeXo8xhFmp4rOafwwU6XhGfBScVQNuslnPB14mDDl9z1251-GylICAaH0P930MlsXjjjW5kOywHlhhcVzzkzS2moGA7EWzKdjfLnSpcVXxdt_DRP1zameaXd9ykLSAnmr_f/s1600/2.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhSzvnWYUzTfBeXo8xhFmp4rOafwwU6XhGfBScVQNuslnPB14mDDl9z1251-GylICAaH0P930MlsXjjjW5kOywHlhhcVzzkzS2moGA7EWzKdjfLnSpcVXxdt_DRP1zameaXd9ykLSAnmr_f/s320/2.png" /></a><br/>
<br/>
そして、デフォルトのスタイルから、まあ、なんでもいいんですが、ここでは構造が簡単な Dark スタイルを読み込みました。<br/>
<br/>
「適用して閉じる」を押して、Style エディタを閉じます。<br/>
そして、TForm の StyleBook に StyleBook1 を設定します。<br />
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiiRqolQmC_j71zE7BRpMrLdsDeRwv-qltQcU0-SSHQND7o8F24DSkqC2_x3cnfgEfVlpEqzkHc3x9wqUQEmyAogAG7wLhlKUtXhoAPSxB_zLxv7XkdTtUAts-HixrsEel7XGN0hhNuMozL/s1600/22.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiiRqolQmC_j71zE7BRpMrLdsDeRwv-qltQcU0-SSHQND7o8F24DSkqC2_x3cnfgEfVlpEqzkHc3x9wqUQEmyAogAG7wLhlKUtXhoAPSxB_zLxv7XkdTtUAts-HixrsEel7XGN0hhNuMozL/s320/22.png" /></a><br/>
<br/>
次に TTabControl を Form に貼ります。TTabControl は Common Controls にあります。<br/>
貼ったら右クリックしてコンポーネントエディタを開いて TTabItem を1つ作りましょう。<br/>
そして、できた TTabItem を右クリックして「カスタムスタイルの編集...」を押します。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEij8JU5IxtDopj4NcJjZXBenDTrEFk5ohafJ-kg6msJL2Ng5MkYtmj3UywncCMBLn4_j_70rwdUNQDWd3KsbjkyacrJRpsXgf-ViiZAv6L5z1wotsMiHyJHTObwbKrv33oEvSlhyphenhyphen5vXIa7d/s1600/3.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEij8JU5IxtDopj4NcJjZXBenDTrEFk5ohafJ-kg6msJL2Ng5MkYtmj3UywncCMBLn4_j_70rwdUNQDWd3KsbjkyacrJRpsXgf-ViiZAv6L5z1wotsMiHyJHTObwbKrv33oEvSlhyphenhyphen5vXIa7d/s320/3.png" /></a><br/>
<br/>
すると!先ほど作った TabItem1 専用の Style が自動的に作られます。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhOjOwuiUkTQqSM2kGaS9RGKBxwfIqs0HEXYPRnEnSo-zB-x3gpOpnxEsNq0FcKNNrMxjFnRh42dWx7vKQ_WpknxbpJfNDTeZBBb3vtXbhUUGuzLVE0z5yf_tR3XSVMvJ_5jp9fyTkqhxtM/s1600/4.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhOjOwuiUkTQqSM2kGaS9RGKBxwfIqs0HEXYPRnEnSo-zB-x3gpOpnxEsNq0FcKNNrMxjFnRh42dWx7vKQ_WpknxbpJfNDTeZBBb3vtXbhUUGuzLVE0z5yf_tR3XSVMvJ_5jp9fyTkqhxtM/s320/4.png" /></a><br/>
<br/>
これを編集していきます。<br/>
そして、先ほど盗んでくる!と言った TClearingEdit の「×」印を盗みます!<br />
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiP8n91zCYKu3d4RwADS8ro2R_87nI5zp-rxtTAQXH7AS2g94c3cXX-3QK6c86P0N6dYyHf7tW4Dr5QvkA9ezb719ERMbKR-y-sWzhfYzReXKByBH45NztksMXn9IZYK5fCN-puV7VxP1HF/s1600/5.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiP8n91zCYKu3d4RwADS8ro2R_87nI5zp-rxtTAQXH7AS2g94c3cXX-3QK6c86P0N6dYyHf7tW4Dr5QvkA9ezb719ERMbKR-y-sWzhfYzReXKByBH45NztksMXn9IZYK5fCN-puV7VxP1HF/s320/5.png" /></a><br/>
<br/>
これを、そのまま TTabItem に移動しちゃいます。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiiVvydRaZhZcEEfc3tZY_IQ-YcIx36IlLsDp9CG7Qbe4-8TtNDWVEBwhnj-vJ_R1956t5nzvVvP8ZOo8DVoBVrGBhAMa8sNPhjDPsMuMDtR5Px05Ax0lvLa4vxWhmdjv8ElXxNijA8QPlO/s1600/6.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiiVvydRaZhZcEEfc3tZY_IQ-YcIx36IlLsDp9CG7Qbe4-8TtNDWVEBwhnj-vJ_R1956t5nzvVvP8ZOo8DVoBVrGBhAMa8sNPhjDPsMuMDtR5Px05Ax0lvLa4vxWhmdjv8ElXxNijA8QPlO/s320/6.png" /></a><br/>
<br/>
そして、「適用して閉じる」を押して、スタイルエディタを閉じます。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi64cxD6Q1HZsVJ9_wyFUemG3FJBLczEyA4l3zXw0u3GQLga0ra_BUQ6neLqvJtLeUZe0KTH13LN3IBjW06LhPqdCVKr7GPukSomvRa-K9d3VlVWOXOvBvRZJ7nbBA7FMvKnB5ZxJ3rZ4W8/s1600/7.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi64cxD6Q1HZsVJ9_wyFUemG3FJBLczEyA4l3zXw0u3GQLga0ra_BUQ6neLqvJtLeUZe0KTH13LN3IBjW06LhPqdCVKr7GPukSomvRa-K9d3VlVWOXOvBvRZJ7nbBA7FMvKnB5ZxJ3rZ4W8/s320/7.png" /></a><br/>
<br/>
フォームに戻ってみると……切れてる!!<br/>
そうです。「×」印が増えた分、文字が切れてしまったのです。<br/>
<br/>
これは、ソースを修正しないと直せないので、スタイルの編集はここまでにして、次にソースを作っていきます……と、その前に作った Style を保存します。<br/>
<br/>
StyleBook をダブルクリックして、スタイルエディタを開き、「保存」ボタンを押します。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhr-R0z6OzWuNwyu2VETfJmfvzhVjy0wf7RciQsiLrEyyEYVKSAKayTSPNyIh46-O4RN9Y2l2BwJHQcTzSJNQb9zMi0lWcZMwQRf0-aBX0MySHfz9SCTroxcQIvsHjkqSJ8W3ILYY1pd7LO/s1600/25.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhr-R0z6OzWuNwyu2VETfJmfvzhVjy0wf7RciQsiLrEyyEYVKSAKayTSPNyIh46-O4RN9Y2l2BwJHQcTzSJNQb9zMi0lWcZMwQRf0-aBX0MySHfz9SCTroxcQIvsHjkqSJ8W3ILYY1pd7LO/s320/25.png" /></a><br/>
<br/>
すると、Style がテキストで保存されます。<br/>
なので、できあがった tabitem1style1 の "object TLayer" で表されるブロックを残して、あとは消します。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgI9iuv7MROKsepHSFiQbVIr6LdI7q4N4-5u6JJV-VjXEA_utLw_kOJsOxPMLuDqcnoJ3RndP1LoB8-sw4AlgQGDzgvsn2hPQ01LLmkNuqd0di2IDY4iNNgV2JBpP-_f58Pj2kywtz4m6VM/s1600/26.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgI9iuv7MROKsepHSFiQbVIr6LdI7q4N4-5u6JJV-VjXEA_utLw_kOJsOxPMLuDqcnoJ3RndP1LoB8-sw4AlgQGDzgvsn2hPQ01LLmkNuqd0di2IDY4iNNgV2JBpP-_f58Pj2kywtz4m6VM/s320/26.png" /></a><br/>
<br/>
そして、これを保存しておきます。<br/>
<br/>
さて、ではソースを作っていきます。<br/>
閉じるボタンが付いている TabItem を、TTabItemWithClose という名前にしました。<br/>
<br/>
<pre class="code">
<div class="oddline"><b>unit</b> FMX.TabItemWithClose;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> System.Classes</div>
<div class="oddline"> , FMX.Controls</div>
<div class="evenline"> , FMX.TabControl</div>
<div class="oddline"> , FMX.StdCtrls</div>
<div class="evenline"> ;</div>
<div class="oddline"> </div>
<div class="evenline"><b>type</b></div>
<div class="oddline"> [ComponentPlatformsAttribute(pidWin32 <b>or</b> pidWin64 <b>or</b> pidOSX32)]</div>
<div class="evenline"> TTabItemWithClose = <b>class</b>(TTabItem)</div>
<div class="oddline"> <b>public</b> <b>type</b></div>
<div class="evenline"> TCloseEvent = <b>procedure</b> (Sender: TObject; <b>var</b> ioDoClose: Boolean) <b>of</b> <b>object</b>;</div>
<div class="oddline"> <b>private</b> <b>const</b></div>
<div class="evenline"> STYLE_COLOR_BUTTON = <span class="string">'closebutton'</span>;</div>
<div class="oddline"> STYLE_TEXT = <span class="string">'text'</span>;</div>
<div class="evenline"> STYLE_TABITEM = <span class="string">'tabitemstyle'</span>;</div>
<div class="oddline"> <b>private</b> <b>var</b></div>
<div class="evenline"> FCloseBtn: TCustomButton;</div>
<div class="oddline"> FTabControl2: TTabControl;</div>
<div class="evenline"> FOnClose: TCloseEvent;</div>
<div class="oddline"> <b>protected</b></div>
<div class="evenline"> <b>procedure</b> ChangeParent; <b>override</b>;</div>
<div class="oddline"> <b>procedure</b> ApplyStyle; <b>override</b>;</div>
<div class="evenline"> <b>procedure</b> FreeStyle; <b>override</b>;</div>
<div class="oddline"> <b>procedure</b> DoCloseBtnClick(Sender: TObject);</div>
<div class="evenline"> <b>function</b> DoSetWidth(</div>
<div class="oddline"> <b>var</b> ioValue: Single;</div>
<div class="evenline"> iNewValue: single;</div>
<div class="oddline"> <b>var</b> ioLastValue: Single): boolean; <b>override</b>;</div>
<div class="evenline"> <b>public</b></div>
<div class="oddline"> <b>class</b> <b>function</b> Make(<b>const</b> iParent: TTabControl): TTabItemWithClose;</div>
<div class="evenline"> <b>property</b> TabControl: TTabControl <b>read</b> FTabControl2;</div>
<div class="oddline"> <b>published</b></div>
<div class="evenline"> <b>property</b> OnClose: TCloseEvent <b>read</b> FOnClose <b>write</b> FOnClose;</div>
<div class="oddline"> <b>end</b>;</div>
</pre>
一番最初の「[ComponentPlatformsAttribute」はこのコンポーネントがどのプラットフォームで動作するのかを示すモノです。<br/>
ここでは、Win32, Win64, OSX32 で動作するとしています。<br/>
<br/>
あとは、閉じるボタンが押されたときのイベントとか、必要な変数・メソッドを定義しています。<br/>
<br/>
<div class="column">
ちなみに、StyleLookup をクリックすると出てくるデフォルトの Style は TStyledControl.GetDefaultStyleLookupName で取得します。<br/>
なので、ここを Override すると、デフォルトの名前も変わります。<br />
今回の TTabItemWithClose は GetDefaultStyleLookupName を Override しないので、<br />
<br />
TabItemWithCloseStyle<br />
<br />
という名前のスタイルがデフォルトになり、このスタイルを StyleBook から探すようになります。<br />
なので、先ほど作った Style の名前を TabItemWithCloseStyle とする必要があります。<br />
</div>
<br/>
それでは、まず、DoSetWidth というメソッドを見てみます。<br/>
ここを修正すると Tab の大きさを変更できます。<br/>
<br/>
<pre class="code">
<div class="oddline"><b>function</b> TTabItemWithClose.DoSetWidth(<b>var</b> ioValue: Single; iNewValue: single;</div>
<div class="evenline"> <b>var</b> ioLastValue: Single): boolean;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>if</b> (FCloseBtn <> <b>nil</b>) <b>then</b></div>
<div class="oddline"> iNewValue := iNewValue + FCloseBtn.Width * <span class="number">1.5</span>;</div>
<div class="evenline"> </div>
<div class="oddline"> Result := <b>inherited</b>;</div>
<div class="evenline"><b>end</b>;</div>
</pre>
<br/>
このように変更すると CloseButton の幅の 1.5 倍が足された幅が新しい Tab の幅になります。<br/>
それでは、CloseButton はどこで取得するかというと ApplyStyle で取得します。<br/>
<br/>
<pre class="code">
<div class="oddline"><b>procedure</b> TTabItemWithClose.ApplyStyle;</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> CloseBtn: TFmxObject;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>inherited</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> CloseBtn := FindStyleResource(STYLE_COLOR_BUTTON);</div>
<div class="evenline"> <b>if</b> (CloseBtn <> <b>nil</b>) <b>and</b> (CloseBtn <b>is</b> TCustomButton) <b>then</b> <b>begin</b></div>
<div class="oddline"> FCloseBtn := TCustomButton(CloseBtn);</div>
<div class="evenline"> FCloseBtn.OnClick := DoCloseBtnClick;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
</pre>
<br/>
ApplyStyle は、スタイルを適用するときに呼ばれるメソッドです。<br/>
そして、FindStyleResource を使うことで、指定したスタイルを「コントロールとして」取得できます。<br/>
なので、ソースのように TCustomButton にキャストしてやって、閉じるボタンのインスタンスを保存します。<br/>
<br/>
あとは、FreeStyle メソッドが呼ばれると Style が無効になるので、ここで FCloseButton に nil を代入しています。
<br/>
また、initialization 部でコンポーネントを登録します。<br/>
<br/>
<pre class="code">
<div class="oddline"><b>initialization</b></div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> RegisterFmxClasses([TTabItemWithClose], [TTabControl]);</div>
<div class="evenline"><b>end</b>;</div>
</pre>
<br/>
登録しないと、IDE で作成された TTabItemWithClose が起動時やプロジェクト読み込み時にエラーになります。<br />
<br/>
基本的には、これでできあがりです。<br/>
<br/>
他のメソッドは、僕が Style を一々作り直すのがメンドクサイので、そのための機構が入っています。<br/>
これについては、ソースをご覧ください。<br/>
<br/>
そして、最後に、コンポーネントエディタを作らなくてはなりません。<br/>
作らないと、IDE で編集すると、TTabItemWithClose は作成されず TTabItem しか作成されません!<br/>
<br/>
ということで、コンポーネントエディタを作りますが……これも <a href="http://ht-deko.minim.ne.jp/delphiforum/?vasthtmlaction=viewtopic&t=1312.2#postid-1938">DEKO さんが Advent Calendar で発表されているので、そちらをご覧ください!</a>!<br/>
僕が書くより、よっぽど詳しいです!!<br/>
コンポーネントとして登録する方法なども、リンクがあります!<br />
<br/>
では、できたコンポーネントが登録されたとして、これを使うためには、先ほど保存した TabItemWithCloseStyle を StyleBook に「追加」を押して、読み込ませます。<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEigxyRydRrkZM6Wxdu_2nQ9PaUq0AlTBf0Iq9twRphYwFKhy-D0UlJ3tCpl2xmA5m9-ArjdsoDW6MPgg1lgHmL2rRbOMgD22OyZRjU_YIpCvsPAPlfFPq3eEDHgyVIW9sk_ecCxNDdUSWuH/s1600/27.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEigxyRydRrkZM6Wxdu_2nQ9PaUq0AlTBf0Iq9twRphYwFKhy-D0UlJ3tCpl2xmA5m9-ArjdsoDW6MPgg1lgHmL2rRbOMgD22OyZRjU_YIpCvsPAPlfFPq3eEDHgyVIW9sk_ecCxNDdUSWuH/s320/27.png" /></a><br/>
<br/>
それで、適用して閉じたあと、コンポーネントエディタから TTabItemWithClose を作ると……<br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgKnkB-dJQpAbzP_Oe4HP3LlitnztrQ6BRF3V89J58eH4ny06X04iq8WXHfMaGnq2AvrujDLDMoVPDUkNlPDHIjI7fS4QVsH58jN-NvrGTO9R_lzcyE7blsM5iQZsLA15EdULTf1ujewJBx/s1600/24.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgKnkB-dJQpAbzP_Oe4HP3LlitnztrQ6BRF3V89J58eH4ny06X04iq8WXHfMaGnq2AvrujDLDMoVPDUkNlPDHIjI7fS4QVsH58jN-NvrGTO9R_lzcyE7blsM5iQZsLA15EdULTf1ujewJBx/s320/24.png" /></a><br/>
<br/>
できました!!!<br/>
<br/>
ちょっと駆け足になったり、はしょったりしましたが、こんな感じで FireMonkey のコンポーネントを作り出せます!<br/>
また、記事にすると長いですが、このコンポーネントを作るのに、実質1時間も掛かっていません!<br/>
<br/>
簡単に作れるので、みなさんも、是非 FireMonkey でコンポーネントを作ってみて下さい!<br/>Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-51162209117220829502013-12-19T00:00:00.000+09:002013-12-20T14:44:20.310+09:00Delphi の Interface<a href="http://qiita.com/advent-calendar/2013/delphi">Delphi Advent Calendar 2013</a> 12/19 の記事です。<br />
<br/>
<span class="extra">※本文最後に追記あり(2013-12-20)</span><br/>
<br/>
Delphi の Interface が使えないとほざいているのは誰だぁっ!<br />
<br/>
ということで、とりあえず<a href="http://docwiki.embarcadero.com/RADStudio/XE5/ja/%E3%82%A4%E3%83%B3%E3%82%BF%E3%83%BC%E3%83%95%E3%82%A7%E3%82%A4%E3%82%B9%E3%81%AE%E5%AE%9F%E8%A3%85">できることを、つらつらっと書いてみました</a>よ。<br />
詳しくは、コメントを見てください!<br />
<br/>
<pre class="code">
<div class="oddline"><b>program</b> Project1;</div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> System.SysUtils;</div>
<div class="oddline"> </div>
<div class="evenline"><b>type</b></div>
<div class="oddline"> <span class="comment">// GUID を指定すると Interface と GUID を結びつけることができます。</span></div>
<div class="evenline"> <span class="comment">// これは主に COM をサポートするための機能です。</span></div>
<div class="oddline"> <span class="comment">// (COM は Interface を GUID で管理します)</span></div>
<div class="evenline"> <span class="comment">// にも関わらず GUID を付けることが推奨されています。</span></div>
<div class="oddline"> <span class="comment">// 例えば GUID をキーに Dictionary として管理したりするためです。</span></div>
<div class="evenline"> <span class="comment">// <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/FMX.Platform.TPlatformServices.AddPlatformService">TPlatformServices.AddPlatformService</a> のソースが参考になります。</span></div>
<div class="oddline"> IFoo = <b>interface</b></div>
<div class="evenline"> [<span class="string">'{174C7089-888D-4B3A-A348-DBAEC0AA70A5}'</span>]</div>
<div class="oddline"> <span class="comment">// Property も宣言できますが、Interface は変数を宣言できないので</span></div>
<div class="evenline"> <span class="comment">// reader / writer はメソッドのみ指定できます</span></div>
<div class="oddline"> <b>function</b> GetBar: <b>String</b>;</div>
<div class="evenline"> <b>property</b> Bar: <b>String</b> <b>read</b> GetBar;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> IDummy = <b>interface</b></div>
<div class="evenline"> [<span class="string">'{7820C3D8-0DBC-4506-81FF-4FB9B21F6959}'</span>]</div>
<div class="oddline"> <b>function</b> GetBar: <b>String</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// IFoo を実装するクラス</span></div>
<div class="oddline"> <span class="comment">// <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/System.TAggregatedObject">TAggregatedObject</a> は後述する TInterfacedObject の Reference Counter を</span></div>
<div class="evenline"> <span class="comment">// 共有するクラスです</span></div>
<div class="oddline"> TFooImpl = <b>class</b>(TAggregatedObject, IFoo)</div>
<div class="evenline"> <b>private</b></div>
<div class="oddline"> <b>function</b> GetBar: <b>String</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// IFoo を実装するクラス2</span></div>
<div class="oddline"> <span class="comment">// IDummy という実験のためのダミークラスも実装してみています。</span></div>
<div class="evenline"> <span class="comment">// 異なる Interface が同じメソッド名を持つ場合は、こんな風に解決できます。</span></div>
<div class="oddline"> TFooImpl2 = <b>class</b>(TAggregatedObject, IFoo, IDummy)</div>
<div class="evenline"> <b>private</b></div>
<div class="oddline"> <b>function</b> IFooGetBar: <b>String</b>;</div>
<div class="evenline"> <b>function</b> IDummyGetBar: <b>String</b>;</div>
<div class="oddline"> <b>function</b> IFoo.GetBar = IFooGetBar; <span class="comment">// IFoo と IDummy の GetBar に</span></div>
<div class="evenline"> <b>function</b> IDummy.GetBar = IDummyGetBar; <span class="comment">// それぞれの実装を代入している</span></div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// TFooImpl か TFooImpl2 に IFoo の実装を委譲してるクラス</span></div>
<div class="evenline"> <span class="comment">// 委譲すると自身は IFoo を実装しなくていい!</span></div>
<div class="oddline"> <span class="comment">// <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/System.TInterfacedObject">TInterfacedObject</a> を継承すると RefCounter によって自動的に破棄されるよ</span></div>
<div class="evenline"> <span class="comment">// 流行りの ARC と同じ仕組みを随分前から実装してたんだよ!</span></div>
<div class="oddline"> <span class="comment">// (COM がそうなんだけど)</span></div>
<div class="evenline"> TBaz = <b>class</b>(TInterfacedObject, IFoo)</div>
<div class="oddline"> <b>private</b></div>
<div class="evenline"> FFoo: IFoo;</div>
<div class="oddline"> <b>public</b></div>
<div class="evenline"> <b>constructor</b> Create; <b>reintroduce</b>;</div>
<div class="oddline"> <b>property</b> FooIntf: IFoo <b>read</b> FFoo <b>implements</b> IFoo;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TFooImple }</span></div>
<div class="oddline"><b>function</b> TFooImpl.GetBar: <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> Result := <span class="string">'Bar'</span>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TFooImple2 }</span></div>
<div class="oddline"><b>function</b> TFooImpl2.IDummyGetBar: <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> Result := <span class="string">'Dummy !'</span>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>function</b> TFooImpl2.IFooGetBar: <b>String</b>;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Result := <span class="string">'Bar 2!'</span>;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TBaz }</span></div>
<div class="oddline"><b>constructor</b> TBaz.Create;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>inherited</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> Randomize;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// (ここではランダムだけど)目的に応じて委譲先を変更できる!</span></div>
<div class="evenline"> <b>if</b> (Random(<span class="number">2</span>) = <span class="number">0</span>) <b>then</b></div>
<div class="oddline"> FFoo := TFooImpl.Create(Self) <span class="comment">// TAggregatedObject は RefCounter を</span></div>
<div class="evenline"> <b>else</b> <span class="comment">// 共有するインスタンスを要求するよ</span></div>
<div class="oddline"> FFoo := TFooImpl2.Create(Self);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ Main }</span></div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> Foo: IFoo;</div>
<div class="oddline"> GUID: TGUID;</div>
<div class="evenline"> Obj: TObject;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// Inteface に代入, TBaz 自体は IFoo を実装していないのに代入できる!</span></div>
<div class="oddline"> Foo := TBaz.Create;</div>
<div class="evenline"> Writeln(Foo.Bar);</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// Inteface を TGUID に代入できる!</span></div>
<div class="oddline"> GUID := IFoo;</div>
<div class="evenline"> Writeln(GUIDToString(GUID));</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// Inteface から元の型を調べてみる</span></div>
<div class="oddline"> Writeln((Foo <b>as</b> TObject).ClassName); <span class="comment">// Implements からでも元の型が取れる!</span></div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// Inteface から元の型を取りだして、再生成したりもできちゃう</span></div>
<div class="evenline"> <span class="comment">// (まあこれは Inteface 関係ないけど…)</span></div>
<div class="oddline"> Obj := (Foo <b>as</b> TObject).ClassType.Create;</div>
<div class="evenline"> Writeln(Obj.ClassName);</div>
<div class="oddline"> </div>
<div class="evenline"> Readln;</div>
<span class="comment">
<div class="oddline"> (* 実行結果 - Bar 2! と出ているところは Bar と出ることもあるよ</div>
<div class="evenline"> </div>
<div class="oddline"> Bar 2!</div>
<div class="evenline"> {174C7089-888D-4B3A-A348-DBAEC0AA70A5}</div>
<div class="oddline"> TBaz</div>
<div class="evenline"> TBaz</div>
<div class="oddline"> </div>
<div class="evenline"> *)</div>
</span>
<div class="oddline"><b>end</b>.</div>
</pre>
<br/>
個人的に面白いなあと思うのは「委譲」の仕組みと「Interface から元の型を取り出せる」ところかな-。<br/>
<strike>Java では Interface から元の Class を取り出すなんて不可能だからね!</strike>(間違ってました。本文最後に追記)<br/>
※ヘルプには「委譲は Win32 のみ」と書いてあるけど、普通に Win/OSX/iOS/Android で動作しました。<br/>
<br/>
あと、今回の iOS / Android 対応で TinterfacedObject の仕組みが非常に活きているのが感慨深い…<br/>
COM のために実装した様々なことがここに来てすごく活きている!<br/>
同じく COM のために実装した dispinterface は、プラットフォーム依存ですと警告が出るようになってたよ…<br/>
ちなみに、Interface は FireMonkey でも使われまくっていてるんですよ!!<br/>
各 Platform 依存部と、それを一般化する部分では Interface 無しには実装できませんぜ!
<br/>
<br/>
追記:0213-12-20<br/>
Java でも、次のようにすれば Interface から元の Class を取り出せるよ!と教えていただきました。<br/>
<pre>
MyInterface intf = new MyClass();
System.out.println(((Object)intf).getClass().getName());
</pre>
僕の Java スキルもまだまだです……<br/>Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-78743797484901533592013-12-01T00:00:00.000+09:002013-12-01T03:35:44.194+09:00VCL も地味に進化しているんですよ!
<a href="http://qiita.com/advent-calendar/2013/delphi">Delphi Advent Calendar 2013</a> 12/01 の記事です。<br />
<br/>
FireMonkey にばかり目が行きがちですが、VCL も地味に進化しているんですよ!!<br />
<br/>
ということで、2007 以降に追加された機能で、僕がつい最近まで知らなかった機能をランキングでご紹介!<br/>
<br/>
<hr>
<span class="extra">第3位</span><br/>
<a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/Vcl.ExtCtrls.TLinkLabel">TLinkLabel</a><br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhyudhCUfVfXozPOEOQ6FQRHhWgd5DGHSFOKwgMWmDjchwQLxrREftWcsQqxq0WjnGRuyxVwHpk0JymPY91UWBMRCVljAKvYVwsjCpEs1HAYoxgzb_p_rfGAWVCECSke3UV8QNuvm1IlYOE/s1600/TLinkLabel.png"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhyudhCUfVfXozPOEOQ6FQRHhWgd5DGHSFOKwgMWmDjchwQLxrREftWcsQqxq0WjnGRuyxVwHpk0JymPY91UWBMRCVljAKvYVwsjCpEs1HAYoxgzb_p_rfGAWVCECSke3UV8QNuvm1IlYOE/s320/TLinkLabel.png" /></a><br/>
<br/>
HTML リンク形式でクリックできるラベル!<br/>
みんな自分で作っていたよね!!<br/>
いつ追加されたのか、ちょっと判りませんでしたが……<br/>
<br/>
使い方はすごく簡単で、Caption プロパティに A タグを使ってリンク先を書くだけです。<br/>
例えば…<br/>
<pre class="code">
<div class="oddline">" 右をクリック→ <a href="http://www.serialgames.co.jp/">株式会社シリアルゲームズ</a>"</div>
</pre>
こんな感じです。<br/>
下線部をクリックすると OnLinkClick イベントが発生するので、そこに↓こんな感じの処理を記述してやればOKです。<br/>
<pre class="code">
<div class="oddline"><b>procedure</b> TForm1.LinkLabel1LinkClick(</div>
<div class="evenline"> Sender: TObject;</div>
<div class="oddline"> <b>const</b> Link: <b>string</b>;</div>
<div class="evenline"> LinkType: TSysLinkType); </div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// Link は id か href の中身</span></div>
<div class="oddline"> <span class="comment">// LinkType は Link の種類</span></div>
<div class="evenline"> <span class="comment">// sltID は id 属性が指定されていた場合</span></div>
<div class="oddline"> <span class="comment">// sltURL は id 以外</span></div>
<div class="evenline"> </div>
<div class="oddline"> ShellExecute(</div>
<div class="evenline"> Handle,</div>
<div class="oddline"> <span class="string">'open'</span>,</div>
<div class="evenline"> PChar(Link),</div>
<div class="oddline"> <b>nil</b>,</div>
<div class="evenline"> <b>nil</b>,</div>
<div class="oddline"> SW_SHOW);</div>
<div class="evenline"><b>end</b>;</div>
</pre>
ここでは、ブラウザを開くようにしましたが、もちろんアプリケーションのナビゲートにも使えるわけです!<br/>
<br />
※<a href="https://twitter.com/ht_deko/status/406849607193210880">DEKO 氏よりご指摘を頂きました</a>ので、追記いたします!<br />
TLinkLabel が追加されたのは Delphi 2009 からとのこと!<br />
そして、Xp でも使えるけど、テーマが有効である必要があるということです。<br />
テーマは、プロジェクトオプション→アプリケーション→ランタイムテーマ→ランタイムテーマを有効にする、ですね!<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjTN-EiVbd6A7KeV8sbzp3dlKFe9NvJe1hUW8GiENRcwC_CE3IEydBWDQkBVP6dY3zzJLcCsrc7Wx0H7X5Cq0MRxSWTDMLj5fzIwbyphrrlNu0N-Ey37_cn24PFwyl7Jq8qSB_Pa76b4rKV/s1600/te.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjTN-EiVbd6A7KeV8sbzp3dlKFe9NvJe1hUW8GiENRcwC_CE3IEydBWDQkBVP6dY3zzJLcCsrc7Wx0H7X5Cq0MRxSWTDMLj5fzIwbyphrrlNu0N-Ey37_cn24PFwyl7Jq8qSB_Pa76b4rKV/s200/te.png" /></a>
<br/>
<hr>
<span class="extra">第2位</span><br/>
<a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/Vcl.StdCtrls.TButton">TButton 驚愕の進化!</a><br/>
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj_xnJGo8oZDqB3S_ix7OioRX08av92J9alYubG25M2tDqdttuD1gbbfv_CKDgKP8yvkbE9mpLyGy-FQuWxWFCl-XdlPN7woCJyZmO1Tn-su964EEA1tIM0DpKehYpi5stfyKdQr_X2LNMn/s1600/Button.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj_xnJGo8oZDqB3S_ix7OioRX08av92J9alYubG25M2tDqdttuD1gbbfv_CKDgKP8yvkbE9mpLyGy-FQuWxWFCl-XdlPN7woCJyZmO1Tn-su964EEA1tIM0DpKehYpi5stfyKdQr_X2LNMn/s320/Button.png" /></a><br/>
<br/>
VCL のボタンは色が変えられないだとか、画像が載せられないだとか、そんな時代は終わっていました!(色については後述の1位をご覧ください)<br/>
むしろ、TBitButton の時代が終わっていた!<br/>
上の画像を見ていただければ一目瞭然ですが、色々と機能が拡張されています。<br/>
<br/>
これらは、<span class="extra"><a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/Vcl.StdCtrls.TButton.Style">TButton.Style</a></span>プロパティで実現されています。<br/>
TButton.Style は<a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/Vcl.StdCtrls.TCustomButton.TButtonStyle">TButtonStyle 型</a>になっていて以下の3つがあります。<br/>
<br/>
<table>
<tr>
<td>bsPushButton</td>
<td>いわゆる普通のボタン</td>
</tr>
<tr>
<td>bsCommandLink </td>
<td>コマンドアイコンが付くボタン(インストーラなんかで見ます)</td>
</tr>
<tr>
<td>bsSplitButton</td>
<td>右側をクリックすると TPopupMenu を表示するボタン</td>
</tr>
</table>
<br/>
そして、その他にも <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/Vcl.StdCtrls.TButton.Images">Images プロパティ</a> と <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/Vcl.StdCtrls.TButton.ImageIndex">ImageIndex プロパティ</a>を組み合わせると画像を表示できます!(他のプロパティで画像の位置を指定したり、Disable 時の画像を指定したりできます)<br/>
しかも画像をご覧頂くとわかるとおり、きちんとα値(透明度)も効きます!<br/>
<br />
FireMonkey を使わなくても、かなり美麗なアプリケーションを組めますね。<br/>
<span class="extra">ただし!Vista 以降で有効!つまり! Xp では使えません!!</span><br/>
<strike>あれぇ…じゃあ VCL の機能というより Windows 機能なんじゃあ…</strike><br/>
<br/>
<hr>
<span class="extra">第1位</span><br/>
<a href="http://docwiki.embarcadero.com/RADStudio/XE5/ja/VCL_%E3%82%B9%E3%82%BF%E3%82%A4%E3%83%AB%E3%81%AE%E6%A6%82%E8%A6%81">当然の VCL Style!</a><br/>
<br/>
以下をご覧ください<br/>
<ul>
<li><a href="http://delphimaniacs.blogspot.jp/2012/10/style.html">2012年10月23日 Style を外部ファイルから読み込む</a></li>
<li><a href="http://delphimaniacs.blogspot.jp/2012/11/tfinddialog.html">2012年11月7日 TFindDialog とスタイル</a></li>
<li><a href="http://delphimaniacs.blogspot.jp/2012/11/tcommndialog-style.html">2012年11月8日 TCommnDialog と Style</a></li>
<li><a href="http://delphimaniacs.blogspot.jp/2012/11/trichedit-vcl.html">2012年11月9日 TRichEdit と VCL スタイル</a></li>
<li><a href="http://delphimaniacs.blogspot.jp/2012/12/vcl-style.html">2012年12月25日 痛 VCL Style</a></li>
<li><a href="http://delphimaniacs.blogspot.jp/2013/01/colorcheckbox-styleelements.html">2013年1月31日 ColorCheckbox を StyleElements で実装できるかどうか</a></li>
</ul>
えええええー!最後それえええええ!?<br/>
知らなかった機能を、って書いてあったのに、知ってる機能だしいいいいい!<br/>
<br/>
そんなこんなで、2013年もあと少し。<br/>
今後とも、僕とブログと男と女、Delphi をよろしくお願いいたします。<br/>Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-25375837130052510502013-09-19T11:47:00.001+09:002013-09-19T13:12:06.194+09:00Hello world maniacs !CodeIQ の <a href="https://twitter.com/cielavenir">@cielavenir</a> さんからの言語指定の問題「<a href="https://codeiq.jp/ace/cielavenir/q431">Restricted Words - 出力したい値をどうやって手に入れるか?</a>」に挑戦しました。<br />
<br />
問題は<br />
<pre class="code">
標準出力に
Hello World
と出力するプログラムを作成して下さい。
ただし、数値、文字及び文字列リテラルを解答に含めることはできません。
Perlのqqやqw、Rubyの%Q、%q、%wなども避けたほうが評価が高くなります。
言語仕様をフル活用して下さい!
</pre>
というものです。<br />
ここで注目したいのが!!<br />
<pre class="code">
プログラミング言語は
AppleScript(osascript)/C/C++/C#/Clojure/D/Erlang/Fortran/Go/Groovy/Haskell/
Hello Algorithm/HSP/Java/JavaScript(Node.js)/Kuin/Lisp/Lua/OCaml/<span class="extra">Pascal</span>/
Perl/PHP/Pike/Python/R/Ruby/Scala/Scheme/Smalltalk/VB.Net
のいずれかを使用して下さい。指定された言語以外での解答は評価されません。
</pre>
<br />
<span class="extra">Pascal</span> キター!!!!!<br />
いままで CodeIQ では Pascal / Delphi は全く相手にされてなかったのに!!<br />
ということで、軽く挑戦してみることにしました。<br />
<br />
すぐに思いついた方法は3通り<br />
<br />
<ol>
<li><a href="http://ja.wikipedia.org/wiki/Brainfuck">brainf*ck</a> のような<a href="http://ja.wikipedia.org/wiki/%E3%83%81%E3%83%A5%E3%83%BC%E3%83%AA%E3%83%B3%E3%82%B0%E3%83%9E%E3%82%B7%E3%83%B3">チューリングマシン</a>的な方法</li>
<li><a href="http://docwiki.embarcadero.com/RADStudio/XE5/ja/RTTI_%E3%81%AE%E6%93%8D%E4%BD%9C%EF%BC%9A%E3%82%A4%E3%83%B3%E3%83%87%E3%83%83%E3%82%AF%E3%82%B9">リフレクション</a>を使ってクラスやメソッド名から抽出する方法</li>
<li>文字コードを列挙型で表す方法</li>
</ol>
<br />
このうち、1の方法は簡単すぎてつまらないので却下。<br />
2の方法もあくまで言語指定が Pascal なので却下。<br />
ということで、3の方法で行くことにしました。<br />
<br />
ここで面倒だったのが言語指定が Pascal であること。<br />
Pure Pascal では type とか var といったブロックは位置が決まっているし、Program には input / output を付けないといけないとか、const 指定子が使えないとか色々あります。<br />
ということで、1回 Delphi でコンパイルした後 <a href="http://www.gnu-pascal.de/gpc/h-index.html">gpc</a> 使ってコンパイルを試しました……ところが!!<br />
gpc は最早 Pure Pascal ではなく <a href="http://www.gnu-pascal.de/gpc/h-news.html">Borland 拡張……つまり Delphi の文法</a>が多分に採り入れられていたのです!!<br />
すごいすんなりコンパイルされちゃう!! \(^o^)/<br/>
といっても、これが <a href="http://www.iso.org/iso/catalogue_detail.htm?csnumber=13802">ISO 標準</a>であり、これこそが Pure Pascal なのかなあなんて思ったりもしたのですが、 Pure Pascal は初版の物だろう!!ファースト以外は認めない!!……ということで、僕の頭の中にある Pure Pascal 文法で書きました。<br />
それが以下になります。<br />
<br />
<pre class="code">
<div class="oddline"><b>program</b> HelloWorld(Output);</div>
<div class="evenline"> </div>
<div class="oddline"><b>type</b></div>
<div class="evenline"> THex = (</div>
<div class="oddline"> hx00, hx01, hx02, hx03, hx04, hx05, hx06, hx07,</div>
<div class="evenline"> hx08, hx09, hx0a, hx0b, hx0c, hx0d, hx0e, hx0f,</div>
<div class="oddline"> hxCount</div>
<div class="evenline"> );</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> WriteChar(h, l: THex);</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Write(Chr(Ord(h) * Ord(hxCount) + Ord(l)));</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> WriteChar(hx04, hx08); <span class="comment">// H</span></div>
<div class="oddline"> WriteChar(hx06, hx05); <span class="comment">// e</span></div>
<div class="evenline"> WriteChar(hx06, hx0c); <span class="comment">// l</span></div>
<div class="oddline"> WriteChar(hx06, hx0c); <span class="comment">// l</span></div>
<div class="evenline"> WriteChar(hx06, hx0f); <span class="comment">// o</span></div>
<div class="oddline"> WriteChar(hx02, hx00); <span class="comment">// </span></div>
<div class="evenline"> WriteChar(hx05, hx07); <span class="comment">// W</span></div>
<div class="oddline"> WriteChar(hx06, hx0f); <span class="comment">// o</span></div>
<div class="evenline"> WriteChar(hx07, hx02); <span class="comment">// r</span></div>
<div class="oddline"> WriteChar(hx06, hx0c); <span class="comment">// l</span></div>
<div class="evenline"> WriteChar(hx06, hx04); <span class="comment">// d</span></div>
<div class="oddline"><b>end</b>.</div>
</pre>
<br />
まあ、どっちにせよ、あんまり面白くはならなかったのですが……。<br />
特筆すべき事は何もないです。<br />
ちょっと悔やまれるのは、hxCount なんてのをつくったところ。<br />
そうじゃなくて、shl Ord(hx04) ってすれば良かった。<br />
<br />
出題者の @cielavenir さんのコードは<a href="https://github.com/cielavenir/codeiq_problems/blob/master/q431/helloworld.pas">こちら</a>。<br />
<a href="https://github.com/cielavenir/codeiq_problems/tree/master/q431">その他の言語は一個上</a>に。<br />
<br />
1 を取得してから、それを使って他の数を取得、という方法のようですね。<br />
<strike>
それで、ちょっと疑問なのが、Delphi や gpc ではコンパイル通るんだけど、Integer を Char にキャストして値を得ていること。<br />
Pure Pascal だと、これできないんじゃなかったかなあ……そのための <a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/System.Chr">Chr 関数</a>な訳だし……。<br />
C 系で言うところの 1byte を表す型は<a href="http://docwiki.embarcadero.com/Libraries/XE5/ja/System.Byte"> Byte っていう型</a>があるんですよ-。<br />
</strike>
2013/09/19 13:10 追記<br />
cielavenir さんに修正していただきました!<br />
<br />
後日、解説記事がアップされるそうなので、解説記事がアップされたら、ここに追記します!<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-7001049653122404392013-07-01T10:00:00.000+09:002013-07-01T10:00:03.087+09:00constructor 制約について<a href="http://www.facebook.com/groups/delphitalks/468637443221593/">Facebook の Delphi Talks で「型制約について、疑問があります」というスレッド</a>が立ちました。<br/>
内容は「ジェネリクス型で型指定するときに、レコード型と値型と文字列型、のみ指定することは可能か?」という話でした。<br/>
これについては、スレッド中で「できない」と、結論が出ました。<br/>
ただ、このスレッド中で「constructor 制約がついたジェネリクス型に文字列型や値型が渡せる」という事が判りました(僕が知りました)。<br/>
と、いうことで、ちょっと調べてみました。<br/>
<br/>
constructor 制約とは、下記のようにジェネリクスの型指定に constructor と書く事で定義される制約です。<br/>
<br/>
<pre class="code">
<div class="oddline"><b>type</b></div>
<div class="evenline"> TConstructorConstraint<T: <b>constructor</b>> = <b>class</b></div>
<div class="oddline"> <b>end</b>;</div>
</pre>
<br/>
具体的には、この制約を課されると「引数無しの Create を持った型しか指定できない」という制約です。<br/>
この制約の最大の特徴は T が <span class="extra">「どんな型か全く知らなくても」</span>インスタンスを <span class="extra">生成できる</span>、ということです。<br/>
これによって、何も知らなくても有効なインスタンスの存在を保証できます。<br/>
<br/>
……と、まあ原義はさておき、上述の様にプリミティブ型である String 型や Integer 型を指定できるのです。<br/>
当然プリミティブな型なので Create なんてコンストラクタメソッドを持っているわけがありません。<br/>
これはどういった事でしょうか。<br />
これを検証するために、下記のコードを書きました。<br/>
<br/>
<pre class="code">
<div class="oddline"><b>unit</b> Unit1;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>type</b></div>
<div class="evenline"> <span class="comment">// interface 部に定義すると全員に見える</span></div>
<div class="oddline"> <span class="comment">// 引数無しの Create は持っていないクラス</span></div>
<div class="evenline"> TBar = <b>class</b></div>
<div class="oddline"> <b>public</b></div>
<div class="evenline"> <b>constructor</b> Create(<b>const</b> iDummy: Integer); <b>reintroduce</b>;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>procedure</b> Test;</div>
<div class="evenline"> </div>
<div class="oddline"><b>implementation</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> System.Rtti;</div>
<div class="oddline"> </div>
<div class="evenline"><b>type</b></div>
<div class="oddline"> <span class="comment">// constructor 制約を課したジェネリック型クラス</span></div>
<div class="evenline"> TConstructorConstraint<T: <b>constructor</b>> = <b>class</b></div>
<div class="oddline"> <b>private</b></div>
<div class="evenline"> FValue: T;</div>
<div class="oddline"> <b>public</b></div>
<div class="evenline"> <b>constructor</b> Create; <b>reintroduce</b>;</div>
<div class="oddline"> <b>function</b> ToString: <b>String</b>; <b>override</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 引数無しの Create を持つクラス</span></div>
<div class="oddline"> TFoo = <b>class</b></div>
<div class="evenline"> <b>public</b></div>
<div class="oddline"> <b>constructor</b> Create; <b>reintroduce</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 動的配列型</span></div>
<div class="oddline"> TStringDynArray = <b>array</b> <b>of</b> <b>String</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// 集合型</span></div>
<div class="evenline"> TFactor = (Windows, MacOSX, Android, iOS, WindowsPhone);</div>
<div class="oddline"> TSet = <b>set</b> <b>of</b> TFactor;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">{ TConstructorConstraint<T> }</span></div>
<div class="evenline"> </div>
<div class="oddline"><b>constructor</b> TConstructorConstraint<T>.Create;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>inherited</b> Create;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// T の型は知らないけど Create を呼び出せる!</span></div>
<div class="evenline"> FValue := T.Create;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// T の型情報を出力する</span></div>
<div class="evenline"><b>function</b> TConstructorConstraint<T>.ToString: <b>String</b>;</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> Rtti: TRttiContext;</div>
<div class="oddline"> Field: TRttiField;</div>
<div class="evenline"> FieldType: TRttiType;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Result := <span class="string">''</span>;</div>
<div class="oddline"> </div>
<div class="evenline"> Rtti := TRttiContext.Create;</div>
<div class="oddline"> <b>try</b></div>
<div class="evenline"> Field := Rtti.GetType(ClassInfo).GetField(<span class="string">'FValue'</span>);</div>
<div class="oddline"> FieldType := Field.FieldType;</div>
<div class="evenline"> </div>
<div class="oddline"> Result := Field.<b>Name</b> + <span class="string">': '</span> + FieldType.ToString + <span class="string">';'</span>;</div>
<div class="evenline"> </div>
<div class="oddline"> <b>if</b> (FieldType.IsPublicType) <b>then</b></div>
<div class="evenline"> Result := Result + <span class="string">' Public;'</span>;</div>
<div class="oddline"> </div>
<div class="evenline"> <b>if</b> (FieldType.IsManaged) <b>then</b></div>
<div class="oddline"> Result := Result + <span class="string">' Manged;'</span>;</div>
<div class="evenline"> </div>
<div class="oddline"> <b>if</b> (FieldType.IsInstance) <b>then</b></div>
<div class="evenline"> Result := Result + <span class="string">' Instance;'</span>;</div>
<div class="oddline"> </div>
<div class="evenline"> <b>if</b> (FieldType.IsOrdinal) <b>then</b></div>
<div class="oddline"> Result := Result + <span class="string">' Ordinal;'</span>;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// Record は constructor 制約では指定できないので、ここは表示されない</span></div>
<div class="evenline"> <b>if</b> (FieldType.IsRecord) <b>then</b></div>
<div class="oddline"> Result := Result + <span class="string">' Record;'</span>;</div>
<div class="evenline"> </div>
<div class="oddline"> <b>if</b> (FieldType.IsSet) <b>then</b></div>
<div class="evenline"> Result := Result + <span class="string">' Set;'</span>;</div>
<div class="oddline"> <b>finally</b></div>
<div class="evenline"> Rtti.Free;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TFoo }</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>constructor</b> TFoo.Create;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>inherited</b> Create;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 生成時に表示される</span></div>
<div class="oddline"> Writeln(<span class="string">'TFoo Created !'</span>);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TBar }</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>constructor</b> TBar.Create(<b>const</b> iDummy: Integer);</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>inherited</b> Create;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 引数無しの Create ではないため、表示されない</span></div>
<div class="oddline"> Writeln(<span class="string">'TBar Created !'</span>);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// 生成して情報を出力する</span></div>
<div class="oddline"><b>procedure</b> Test;</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> Foo: TConstructorConstraint<TFoo>;</div>
<div class="evenline"> Bar: TConstructorConstraint<TBar>;</div>
<div class="oddline"> Str: TConstructorConstraint<<b>String</b>>;</div>
<div class="evenline"> Int: TConstructorConstraint<Integer>;</div>
<div class="oddline"> Ary: TConstructorConstraint<TStringDynArray>;</div>
<div class="evenline"> Sets: TConstructorConstraint<TSet>;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Foo := <b>nil</b>;</div>
<div class="oddline"> Bar := <b>nil</b>;</div>
<div class="evenline"> Str := <b>nil</b>;</div>
<div class="oddline"> Int := <b>nil</b>;</div>
<div class="evenline"> Ary := <b>nil</b>;</div>
<div class="oddline"> Sets := <b>nil</b>;</div>
<div class="evenline"> <b>try</b></div>
<div class="oddline"> Foo := TConstructorConstraint<TFoo>.Create;</div>
<div class="evenline"> Bar := TConstructorConstraint<TBar>.Create;</div>
<div class="oddline"> Str := TConstructorConstraint<<b>String</b>>.Create;</div>
<div class="evenline"> Int := TConstructorConstraint<Integer>.Create;</div>
<div class="oddline"> Ary := TConstructorConstraint<TStringDynArray>.Create;</div>
<div class="evenline"> Sets := TConstructorConstraint<TSet>.Create;</div>
<div class="oddline"> </div>
<div class="evenline"> Writeln(Foo.ToString);</div>
<div class="oddline"> Writeln(Bar.ToString);</div>
<div class="evenline"> Writeln(Str.ToString);</div>
<div class="oddline"> Writeln(Int.ToString);</div>
<div class="evenline"> Writeln(Ary.ToString);</div>
<div class="oddline"> Writeln(Sets.ToString);</div>
<div class="evenline"> </div>
<div class="oddline"> Readln;</div>
<div class="evenline"> <b>finally</b></div>
<div class="oddline"> Sets.Free;</div>
<div class="evenline"> Ary.Free;</div>
<div class="oddline"> Int.Free;</div>
<div class="evenline"> Str.Free;</div>
<div class="oddline"> Bar.Free;</div>
<div class="evenline"> Foo.Free;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>end</b>.</div>
</pre>
<br/>
様々なジェネリック型を定義して、生成、その情報を出力、とするだけのプログラムです。<br/>
ここでは、クラス型、文字列型、整数型、動的配列型、集合型、を指定してみました。<br/>
重要なのは、クラス型以外、Create なんてメソッドは持っていない!ということです。<br/>
<br/>
では、このプログラムを動かしてみると…<br/>
<br/>
<pre class="code">
TFoo Created !
FValue: TFoo; Instance;
FValue: TBar; Public; Instance;
FValue: string; Public; Manged;
FValue: Integer; Public; Ordinal;
FValue: TStringDynArray; Manged;
FValue: TSet; Set;
</pre>
<br/>
こんな風になりました!<br/>
TFoo, TBar はクラスなので "Instance" と表示されています。<br/>
また、TBar は、interface 部で定義されているので公開されている型 "Public" と表示されています。<br/>
そして、string と動的配列型は "Managed" と表示されています。これはコンパイラがその型の生成と廃棄を担っていることを示します。<br/>
つまり、string と動的配列型は、本当は管理されたメモリを持つ参照型であるため、このように表示されています。<br/>
また、Integer は Ordinal…順序型, 集合型は Set と出ました。これはそれぞれの型そのものですね。<br/>
<br/>
ということで、本当に値型や文字列型が Create というメソッドで生成されてしまいました。<br/>
本来、そのようなメソッドを持たない型にも関わらず、です。<br/>
<br/>
では、これらの型の生成は実際にはどのようなコードになっているのでしょうか?<br/>
それを見るために CPU ビューで逆アセンブルされたコードを見てみました。<br/>
<br/>
<pre class="code">
// TFoo の生成
Project1.dpr.28: FValue := T.Create;
00407D7A B201 mov dl,$01
00407D7C A158724000 mov eax,[$00407258]
00407D81 E85AF6FFFF call TFoo.Create // 初期化コード
00407D86 8B55FC mov edx,[ebp-$04]
00407D89 894204 mov [edx+$04],eax
// TBar の生成
Project1.dpr.28: FValue := T.Create;
00407DCE B201 mov dl,$01
00407DD0 A114734000 mov eax,[$00407314]
00407DD5 E8BACDFFFF call TObject.Create // 初期化コード
00407DDA 8B55FC mov edx,[ebp-$04]
00407DDD 894204 mov [edx+$04],eax
// 文字列の生成
Project1.dpr.28: FValue := T.Create;
00407E22 8B45FC mov eax,[ebp-$04]
00407E25 83C004 add eax,$04
00407E28 E843DDFFFF call @UStrClr // 初期化コード
// 整数型(順序型)の生成
Project1.dpr.28: FValue := T.Create;
00407E6E 8B45FC mov eax,[ebp-$04]
00407E71 33D2 xor edx,edx // 初期化コード
00407E73 895004 mov [eax+$04],edx
// 動的配列の生成
Unit1.pas.50: FValue := T.Create;
004D50F6 8B45FC mov eax,[ebp-$04]
004D50F9 83C004 add eax,$04
004D50FC 8B1500394D00 mov edx,[$004d3900]
004D5102 E87D68F3FF call @DynArrayClear // 初期化コード
// 集合の生成
Unit1.pas.50: FValue := T.Create;
004D540E 8B45FC mov eax,[ebp-$04]
004D5411 8A153C544D00 mov dl,[$004d543c] // 初期化コード?
004D5417 885004 mov [eax+$04],dl
</pre>
<br/>
なんと、コンパイラマジックによって自動的にそれぞれの型の初期化コードが走っていました。<br/>
文字列や動的配列であれば、それらの内容をクリアする関数をコールしています。<br/>
順序型は 0 が代入されています(同じレジスタを xor するとレジスタの内容は 0 になる)。<br/>
集合型については、ちょっと判りませんが……<br/>
また、TFoo, TBaz については、それぞれ「引数無しの Create」が呼ばれています。<br />
TFoo は定義されているので良いですが TBaz の場合基底クラスである TObject の Create が呼ばれました。<br/>
クラス型は全て TObject から派生しているので、constructor で制限を掛けても全てのクラスが生成できてしまいます。その Create が有効如何に関わらずです。<br/>
これは、constructor 制約の意義に関わる注意点です……実質意味が無い気がします……<br/>
<br/>
ということで、 constructor 制約で実際に生成されるコードを見てみました。<br/>
結論としては、コンパイラが上手いことやってくれてる、っていうだけのお話でした。<br/>
<br/>
ちなみに <T: class, constructor> というように class の制限も一緒につけると値型や文字列型は指定できなくなります。<br/>
また、<T: record, constructor> とすると、プリミティブ型しか指定できなくなります。つまり、クラス型は指定できません。<br/>
<br/>
constructor 制約に値型や文字列型がわたせるのは、上記の "class", "record" のどちらも指定していないため、どっちも通るよ!っていう事なのだと思います。<br/>
<br/>
それと、軽く流してしまいましたがジェネリックで指定された型が何型なのかは拡張 RTTI メソッド群を使えば取得できます。<br/>
詳しくは、上記のコード中の TConstructorConstrain クラスの ToString メソッドを参照してください。<br />
<br/>Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-70822569653610490352013-06-15T10:12:00.000+09:002013-06-15T10:13:21.068+09:00XE4 Update 1 2013/06/12 に XE4 Update 1 が発表されました。<br />
<br />
<a href="http://cc.embarcadero.com/item/29446">XE4 Update 1</a><br />
<br />
<a href="http://docwiki.embarcadero.com/RADStudio/XE4/ja/XE4_Update_1_%E3%81%AE%E3%83%AA%E3%83%AA%E3%83%BC%E3%82%B9_%E3%83%8E%E3%83%BC%E3%83%88">XE4 Update 1 リリースノート</a><br />
<br />
これで、FireMonkey の「最小化問題」と「タスクバーのコンテキストメニュー問題」は解決したのですが、まだ問題が発生しているようです。<br />
それは、タスクバーのボタンを押しても、最小化ができない、という問題です。<br />
通常、タスクバーでアプリケーションのボタンを押すと、アプリケーションが最小化し、もう一度押すと元のサイズに戻る、という動作をしますが、今回の Update でも、この問題は治っていないようです。<br />
僕も気づいていませんでしたが…。<br />
というのも、前のバージョンでは<a href="http://delphimaniacs.blogspot.jp/2013/05/firemonkey.html">先の記事</a>通り、そもそもタスクバーのボタンが上手く動作していなかったためです。<br />
<br />
多分、直すのはそんなに難しくないと思われるので、時間があったら <a href="https://github.com/freeonterminate/delphi/blob/master/FMXForm/uFixFMXForm.pas">FixFMXForm.pas</a> をアップデートしたいと思います。<br />
<br />
ちなみに、現状の FixFMXForm を使っても、治ると言えば治ります。
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-449523159757269042013-05-28T10:00:00.000+09:002013-06-06T15:36:10.698+09:00Delphi で iOS を開発するためのマシン構成について。とても今更ですが、僕がどのような構成で iOS アプリを開発しているか、そのマシン構成図を上げておきます。<br />
<a href="http://sonyshop-satouchi.blog.so-net.ne.jp/2012-06-05">VAIO Z は "Power Media Dock"</a> という拡張ドックがあるので、その HDMI / USB ポートと KVM スイッチが常時接続された状態になっています。<br />
<br />
<div class="column">
VAIO Z シリーズは、どうやら終了のようです。<br />
外付け拡張ドックに GPU / HDMI / USB 3.0 / Blueray を逃すというアイデアは秀逸でした。<br />
個人的には大好きな一台です。
</div>
<br />
ちなみに、これも <a href="http://www.freeml.com/delphi-users/3112/latest">Delphi ML</a> で貼った図になります。<br />
図中の Mac mini は、最低ランクの一番安いものです(型番:MD387J/A)。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQ0pQOdfIYvWMlITQrmj11bUE_bJzKyktkuagcabwBvI5vciHl51d5JDeQvJU0vTippqDUhyLGGu4cleiTy1WFjHS5kDCkzruKjnhyphenhyphen9CzERviBKsHbt45QM0HqKcD0nWzfUwU5mTnog4aZ/s1600/o_90c4a711ba1450f85a3634eb85006dacefae5af5.gif" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQ0pQOdfIYvWMlITQrmj11bUE_bJzKyktkuagcabwBvI5vciHl51d5JDeQvJU0vTippqDUhyLGGu4cleiTy1WFjHS5kDCkzruKjnhyphenhyphen9CzERviBKsHbt45QM0HqKcD0nWzfUwU5mTnog4aZ/s320/o_90c4a711ba1450f85a3634eb85006dacefae5af5.gif" /></a><br />
<br />
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-80053213050770390382013-05-27T01:56:00.000+09:002013-05-27T01:56:41.838+09:00FireMonkey の最小化問題と右クリック問題に対処する<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/blob/master/FMXForm/uFixFMXForm.pas">ソースはこちら(GitHub)</a>
</div>
<br />元々リリースの早い段階から <a href="http://qc.embarcadero.com/wc/qcmain.aspx?d=115232">FireMonkey3 を Windows で使うと最小化時にタスクバーに収まらないという問題</a>があることが知られていました。<br/>
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEirrRCIhyphenhyphenBvdPe8akXW0hsIZAkDEC3hhbTzdP53BQF69SNqdBkKUcYl_S0vfXF1Pm7qzhzxL5rm513IYdH3NWvcUgWPudCf8DRYP47buNOg7TsMG9RktN62cWSYzgSpMvL5EGLQVTNt8akZ/s1600/blog1.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEirrRCIhyphenhyphenBvdPe8akXW0hsIZAkDEC3hhbTzdP53BQF69SNqdBkKUcYl_S0vfXF1Pm7qzhzxL5rm513IYdH3NWvcUgWPudCf8DRYP47buNOg7TsMG9RktN62cWSYzgSpMvL5EGLQVTNt8akZ/s320/blog1.png" /></a><br />
<br />
今回さらに、Delphi ML で<a href="http://www.freeml.com/delphi-users/3182">『タスクバーの右クリックで出てくるシステムメニューで「ウィンドウを閉じる」を選択してもアプリが終わらない』</a>という問題が指摘されました。<br/>
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh01-WnUVlLwCg3EFhffuiTj015N6jm9GaQdRvtIVvBAaJ7j8pgN4_3jXIaseyFzKz5iuDoPF5XVzoaV71Q_e3Ed7QJSL_fNkUR95g7I-FC9JJc-UqvckbetzRP8_5AngpY4_sP5ApHcNvk/s1600/blog2.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh01-WnUVlLwCg3EFhffuiTj015N6jm9GaQdRvtIVvBAaJ7j8pgN4_3jXIaseyFzKz5iuDoPF5XVzoaV71Q_e3Ed7QJSL_fNkUR95g7I-FC9JJc-UqvckbetzRP8_5AngpY4_sP5ApHcNvk/s320/blog2.png" /></a><br />
<br />
実は2つとも原因は同じです。<br />
原因は、<a href="http://docwiki.embarcadero.com/Libraries/XE4/ja/FMX.Forms.TApplication">TApplication</a> の設計上のミスです。<br />
<br />
<div class="column">
このバグが出た背景として、MacOS X 対応が上げられます。<br />
MacOS X は、メインフォームを閉じてもアプリが終了しません。<br />
あくまで、メニューからアプリケーションの終了を選ばないと、終了しないのです!<br />
しかし、Windows では、メインフォームの終了は即ちアプリケーションの終了です。<br />
TApplication は Win と Mac 2つの環境で違う立ち振る舞いをすべきですが、今回は Windows への対応が甘くなっていました。<br />
それは、ベータテスターの主な注目点が iOS 対応だったためだと考えています。<br />
僕自身も Windows でのテストはせずに iOS と MacOS X 部分のみテストしていました。<br />
今後のベータテストでは、Windows もしっかりと見ていく必要がありそうです。<br />
</div>
<br />
<h3>最小化できない問題について</h3><br />
1.TForm の Owner に TApplication が設定されている<br />
2.TForm の WndParent には <a href="http://msdn.microsoft.com/ja-jp/library/cc364616.aspx">DesktopWindow</a> が設定されている<br />
<br />
という2つの事象から発生しています。<br />
オーナーが設定されている、かつ、拡張ウィンドウスタイルに <a href="http://msdn.microsoft.com/ja-jp/library/cc410714.aspx">WS_EX_APPWINDOW</a> が設定されていないので、タスクバーにはオーナーウィンドウ(TApplication)のみが表示されます。<br />
しかし、WndParent(親ウィンドウ)に DesktopWindow が指定されているため、最小化するとデスクトップウィンドウ内の子フォームとして最小化されてしまいます。<br />
<br />
<h3>システムメニューで閉じない問題について</h3><br />
最小化できない問題のところで、タスクバーにはオーナーウィンドウ(TApplication)が表示されていると記しました。<br />
もうおわかりかと思いますが、タスクバーを右クリックして出てきたシステムメニューは TApplication のモノです。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgfb_57wnNJ7Gan2Sp1-r7nNgbRzTogUDi7woo2farHOsvioPpS15zSII1utThDvT7L1o15UC-Fu-i86DujkJsuRv-CyKhMH2RT8HFaDT38DAFVkR_JNM7a0L4d8MFg84-2F-ip_k6bctPd/s1600/blog3.png" imageanchor="1" ><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgfb_57wnNJ7Gan2Sp1-r7nNgbRzTogUDi7woo2farHOsvioPpS15zSII1utThDvT7L1o15UC-Fu-i86DujkJsuRv-CyKhMH2RT8HFaDT38DAFVkR_JNM7a0L4d8MFg84-2F-ip_k6bctPd/s320/blog3.png" /></a><br />
<br />
システムメニューをクリックしても TForm に <a href="http://msdn.microsoft.com/ja-jp/library/windows/desktop/ms646360">WM_SYSCOMMAND</a> メッセージは送出されず、TApplication に対して送出されます。<br />
TApplication は、受け取った WM_SYSCOMMAND を、そのまま <a href="http://msdn.microsoft.com/ja-jp/library/cc410753.aspx">DefWindowProc</a> に流しているだけなので、TApplication のウィンドウハンドルは閉じてしまい、無効になります。<br />
しかし、プロセスを終了させていないので、プロセスは残り続けます。<br />
この問題を解決するためには TApplication が WM_SYSCOMMAND を受け取った時に メインフォームの <a href="http://docwiki.embarcadero.com/Libraries/XE4/ja/FMX.Forms.TCommonCustomForm.Close">Close</a> を呼ぶようにしてやるだけです。<br />
<br />
ただ、それだけだと最小化の問題は解決できません。<br />
そこで、今回、下記のユニットを作りました。<br />
ユニット uFixFMXForm.pas は、uses するだけで、上記の2つの問題を解決します。<br />
このユニットは Application のタスクバーボタンを消して、フォームのタスクバーボタンを表示する、という解決方法をとりました。<br />
<br />
ただし、副作用があって TApplication がオーナーのウィンドウは全てトップレベルウィンドウになります。<br />
TApplication がオーナーでは無い ShowMessage などのダイアログ系はトップレベルにならないので、実用上の問題にはならないでしょう。<br />
<br />
詳細はコード中のコメントを参照してください。<br />
<br />
<pre class="code">
<div class="oddline"><b>unit</b> uFixFMXForm;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>implementation</b></div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// Win32 API を使いまくるので Windows 以外ではコンパイルされないようにする</span></div>
<div class="evenline"><span class="comment">{$IFDEF MSWINDOWS}</span></div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> System.SysUtils,</div>
<div class="oddline"> <b>Winapi</b>.Messages, <b>Winapi</b>.Windows;</div>
<div class="evenline"> </div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> GHookHandle: HHOOK; <span class="comment">// フックハンドル</span></div>
<div class="oddline"> GAppWnd: HWND = <span class="number">0</span>; <span class="comment">// TApplication のハンドル</span></div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// SendMessage でメッセージが送られたときに呼ばれる</span></div>
<div class="evenline"><b>function</b> CallWndProc(</div>
<div class="oddline"> iNCode: Integer;</div>
<div class="evenline"> iWParam: WPARAM;</div>
<div class="oddline"> iLParam: LPARAM): LRESULT; <b>stdcall</b>;</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> ActiveThreadID: DWORD;</div>
<div class="evenline"> TargetID: DWORD;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// フックチェインの他のフックハンドラを先に呼んでしまう</span></div>
<div class="oddline"> Result := CallNextHookEx(GHookHandle, iNCode, iWParam, iLParam);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// nCode が 0 以下の時は処理してはいけない</span></div>
<div class="evenline"> <b>if</b> (iNCode < <span class="number">0</span>) <b>then</b></div>
<div class="oddline"> Exit;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// iLParam には CWPSTRUCT 型へのポインタが格納されている</span></div>
<div class="evenline"> <span class="comment">// この型には SendMessage で送られたメッセージの詳細が入っている</span></div>
<div class="oddline"> <b>with</b> PCWPStruct(iLParam)^ <b>do</b> <b>begin</b></div>
<div class="evenline"> <b>case</b> <b>message</b> <b>of</b></div>
<div class="oddline"> <span class="comment">// ウィンドウができるとき</span></div>
<div class="evenline"> WM_CREATE: <b>begin</b></div>
<div class="oddline"> <b>with</b> PCREATESTRUCT(lParam)^ <b>do</b> <b>begin</b></div>
<div class="evenline"> <span class="comment">// まだ TApplication が生成されていない、かつ「ウィンドウクラス」が</span></div>
<div class="oddline"> <span class="comment">// TFMAppClass(FireMonkey の TApplication のクラス名)だったとき</span></div>
<div class="evenline"> <b>if</b> (GAppWnd = <span class="number">0</span>) <b>and</b> (StrComp(lpszClass, <span class="string">'TFMAppClass'</span>) = <span class="number">0</span>) <b>then</b></div>
<div class="oddline"> <span class="comment">// hwnd を TApplication のウィンドウハンドルとして保存しておく</span></div>
<div class="evenline"> GAppWnd := hwnd</div>
<div class="oddline"> <b>else</b> <b>begin</b></div>
<div class="evenline"> <span class="comment">// もしも TApplication が visible(=タスクバーに表示されている)</span></div>
<div class="oddline"> <span class="comment">// なら、非表示にする!</span></div>
<div class="evenline"> <b>if</b> (GAppWnd <> <span class="number">0</span>) <b>and</b> (IsWindowVisible(GAppWnd)) <b>then</b></div>
<div class="oddline"> ShowWindow(GAppWnd, SW_HIDE);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// オーナーウィンドウが TApplication なら TForm のインスタンスと</span></div>
<div class="evenline"> <span class="comment">// みなして拡張ウィンドウスタイルに WS_EX_APPWINDOW を設定する</span></div>
<div class="oddline"> <span class="comment">// WS_EX_APPWINDOW が設定されたフォームは、トップレベルウィンドウ</span></div>
<div class="evenline"> <span class="comment">// となるので、タスクバーに表示される</span></div>
<div class="oddline"> <b>if</b> (GetWindow(hwnd, GW_OWNER) = GAppWnd) <b>then</b></div>
<div class="evenline"> SetWindowLong(</div>
<div class="oddline"> hwnd,</div>
<div class="evenline"> GWL_EXSTYLE,</div>
<div class="oddline"> GetWindowLong(hwnd, GWL_EXSTYLE) <b>or</b> WS_EX_APPWINDOW);</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// ウィンドウが表示されるとき</span></div>
<div class="oddline"> WM_SHOWWINDOW: <b>begin</b></div>
<div class="evenline"> <span class="comment">// オーナーがあるのに拡張スタイルに WS_EX_APPWINDOW を指定していると</span></div>
<div class="oddline"> <span class="comment">// 最前面に表示されない事があるので、ウィンドウが表示されるときは</span></div>
<div class="evenline"> <span class="comment">// 強制的に最前面にする</span></div>
<div class="oddline"> <span class="comment">// 強制最前面化処理は、下記のように AttachThreadInput を使うが</span></div>
<div class="evenline"> <span class="comment">// 詳細は省略</span></div>
<div class="oddline"> <b>if</b> (GetWindow(hwnd, GW_OWNER) = GAppWnd) <b>then</b> <b>begin</b></div>
<div class="evenline"> ActiveThreadID := GetWindowThreadProcessId(GetForegroundWindow, <b>nil</b>);</div>
<div class="oddline"> TargetID := GetWindowThreadProcessId(hwnd, <b>nil</b>);</div>
<div class="evenline"> </div>
<div class="oddline"> AttachThreadInput(TargetID, ActiveThreadID, True);</div>
<div class="evenline"> <b>try</b></div>
<div class="oddline"> SetForegroundWindow(hwnd);</div>
<div class="evenline"> SetActiveWindow(hwnd);</div>
<div class="oddline"> <b>finally</b></div>
<div class="evenline"> AttachThreadInput(TargetID, ActiveThreadID, False);</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>initialization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// WH_CALLWNDPROC フックを仕掛ける</span></div>
<div class="oddline"> <span class="comment">// WH_CALLWNDPROC は SendMessage が呼ばれたときに呼ばれるフック</span></div>
<div class="evenline"> GHookHandle :=</div>
<div class="oddline"> SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, <span class="number">0</span>, GetCurrentThreadID);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>finalization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// フックを解放</span></div>
<div class="oddline"> UnhookWIndowsHookEx(GHookHandle);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"><span class="comment">{$ENDIF}</span></div>
<div class="evenline"> </div>
<div class="oddline"><b>end</b>.</div>
</pre>
<br />
と、まあ今回このようなユニットを作りましたが、近日リリースされるであろう XE4 Update1 で、このバグは治っている事でしょう。<br />
ですから、無理してこのユニットを使わず、Update1 を待っても良いかも知れません。<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-7707116767004960232013-04-13T20:07:00.000+09:002013-04-13T20:08:31.609+09:00Prezi を使ってみたよPrezi を使ってみたよ。<br />
<br/>
Prezi のサンプルなので中身の説明は超いい加減!<br/>
<br/>
<br/>
<iframe src="http://prezi.com/embed/0ipkalu8tkjf/?bgcolor=ffffff&lock_to_path=0&autoplay=0&autohide_ctrls=0&features=undefined&disabled_features=undefined" width="550" height="400" frameBorder="0"></iframe>
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com1tag:blogger.com,1999:blog-5767280911867023345.post-42430111314243694712013-04-03T14:13:00.001+09:002013-04-03T14:14:42.909+09:00もうすぐ再開します!もう4月!<br />
この一月以上更新が無かった理由が、もうすぐ終わるので、それに関連した話題とかも上げていきます!<br />
しばし待たれよ!Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-65203298863217637652013-02-13T00:39:00.003+09:002013-02-13T00:39:50.906+09:00IME のメッセージを Windows Hook で取得する<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/blob/master/uIMEStartEnd.pas">ソースはこちら(GitHub)</a>
</div>
<br />
<a href="http://www.freeml.com/delphi-users/2995/latest">Delphi-ML で、IME の変換スタートと終了を知りたい、という投稿</a>がありました。<br />
全ての Edit をサブクラス化して実装しようとされていたのですが、それでは非常に大変だと思い、Windows Hook による方法を投稿しました。<br />
<br />
それが、以下のコードです。<br />
<br />
<pre class="code">
<div class="oddline"><b>unit</b> uIMEStartEnd;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> <b>Winapi</b>.Windows;</div>
<div class="oddline"> </div>
<div class="evenline"><b>type</b></div>
<div class="oddline"> <span class="comment">// IME の開始と終了を知らせるイベント</span></div>
<div class="evenline"> TIMEStartEndNotifyEvent =</div>
<div class="oddline"> <b>procedure</b>(<b>const</b> iWnd: HWND; <b>const</b> iStart: Boolean) <b>of</b> <b>object</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// イベントを受け取るイベントリスナを設定・削除する</span></div>
<div class="evenline"><b>procedure</b> AddIMEEventListener(<b>const</b> iEvent: TIMEStartEndNotifyEvent);</div>
<div class="oddline"><b>procedure</b> RemoveIMEEventListener(<b>const</b> iEvent: TIMEStartEndNotifyEvent);</div>
<div class="evenline"> </div>
<div class="oddline"><b>implementation</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> <b>Winapi</b>.Messages, Vcl.Controls, System.Generics.Collections;</div>
<div class="oddline"> </div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> <span class="comment">// WindowsHook のハンドル</span></div>
<div class="evenline"> GHookHandle: HHOOK; </div>
<div class="oddline"> <span class="comment">// イベントリスナのリスト</span></div>
<div class="evenline"> GHandlers: TList<TIMEStartEndNotifyEvent>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// イベントリスナを追加</span></div>
<div class="oddline"><b>procedure</b> AddIMEEventListener(<b>const</b> iEvent: TIMEStartEndNotifyEvent);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>if</b> (GHandlers.IndexOf(iEvent) < <span class="number">0</span>) <b>then</b></div>
<div class="evenline"> GHandlers.Add(iEvent);</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// イベントリスナを削除</span></div>
<div class="evenline"><b>procedure</b> RemoveIMEEventListener(<b>const</b> iEvent: TIMEStartEndNotifyEvent);</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>if</b> (GHandlers.IndexOf(iEvent) > -<span class="number">1</span>) <b>then</b></div>
<div class="oddline"> GHandlers.Remove(iEvent);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// イベントリスナを呼び出す</span></div>
<div class="oddline"><span class="comment">// iWnd IME メッセージを受け取ったウィンドウ</span></div>
<div class="evenline"><span class="comment">// iStart 開始の場合は True</span></div>
<div class="oddline"><b>procedure</b> CallEventHandlers(<b>const</b> iWnd: HWND; <b>const</b> iStart: Boolean);</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> Handler: TIMEStartEndNotifyEvent;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>for</b> Handler <b>in</b> GHandlers <b>do</b></div>
<div class="evenline"> Handler(iWnd, iStart);</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// Hook のメイン関数</span></div>
<div class="evenline"><b>function</b> CallWndProc(</div>
<div class="oddline"> iNCode: Integer;</div>
<div class="evenline"> iWParam: WPARAM;</div>
<div class="oddline"> iLParam: LPARAM): LRESULT; <b>stdcall</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// 先に、次のフックチェインを呼び出してしまう</span></div>
<div class="evenline"> Result := CallNextHookEx(GHookHandle, iNCode, iWParam, iLParam);</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// iNCode が 0 以下ならフックは作業してはならない</span></div>
<div class="oddline"> <b>if</b> (iNCode < <span class="number">0</span>) <b>then</b></div>
<div class="evenline"> Exit;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// lParam は CWPStruct 形式で、メッセージが入っている</span></div>
<div class="oddline"> <b>with</b> PCWPStruct(iLParam)^ <b>do</b> <b>begin</b></div>
<div class="evenline"> <b>case</b> <b>message</b> <b>of</b></div>
<div class="oddline"> WM_IME_STARTCOMPOSITION: <b>begin</b></div>
<div class="evenline"> <span class="comment">// IME 変換開始</span></div>
<div class="oddline"> CallEventHandlers(hwnd, True);</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> WM_IME_ENDCOMPOSITION: <b>begin</b></div>
<div class="oddline"> <span class="comment">// IME 変換終了</span></div>
<div class="evenline"> CallEventHandlers(hwnd, False);</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>initialization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// イベントハンドラを管理するリストを作成</span></div>
<div class="oddline"> GHandlers := TList<TIMEStartEndNotifyEvent>.Create;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// WindowsHook</span></div>
<div class="evenline"> GHookHandle :=</div>
<div class="oddline"> SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, <span class="number">0</span>, GetCurrentThreadID);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>finalization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// Hook を解放</span></div>
<div class="oddline"> UnhookWIndowsHookEx(GHookHandle);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// リストを破棄</span></div>
<div class="evenline"> GHandlers.Free;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>end</b>.</div>
</pre>
<br />
具体的にはソースコードのコメントを参照してほしいのですが、一点だけ Windows Hook について説明します。<br />
<a href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms644959(v=vs.85).aspx">Windows Hook</a> は Windows の作業に割り込む機構です。<br />
例えば、キーボードの入力があった時や、新しいウィンドウが開くときなど本来アプリケーション側からは見えない Windows の作業に割り込むことができます。<br />
Windows Hook を設定するためには <a href="http://msdn.microsoft.com/ja-jp/library/cc430103.aspx">SetWindowsHookEx API</a> を使います。<br />
SetWindowsHookEx の説明を見て頂ければわかるように、様々なフックがあります。<br />
今回は、その中で WH_CALLWNDPROC フックを使う事にしました。<br />
このフックは Window Procedure にメッセージが渡されるタイミングで呼び出されます。<br />
そのタイミングとはいつかというと、具体的には <a href="http://msdn.microsoft.com/ja-jp/library/cc411022.aspx">SendMessage API</a> が呼ばれた時です。<br />
<br />
<div class="column">
<a href="http://msdn.microsoft.com/ja-jp/library/cc410952.aspx">PostMessage API</a> を使った場合は、WH_GETMESSAGE フックが使えます。<br />
</div>
<br />
WH_CALLWNDPROC フックを使うのは IME のメッセージは SendMessage で送られるためです。<br />
そして、今回のソースでは SetWindowsHookEx の3番目の引数に 0 を指定しています。<br />
ここに 0 を指定して、次の引数に現在の Thread ID を指定すると、現在のスレッドで処理される SendMessage についてフックされるます。<br />
この Unit の Initialization 節はメインスレッドから呼ばれるので、メインスレッド(GUI の操作・表示をするスレッド)がメッセージを受け取る度に、CallWndProc 関数が呼ばれることになります。<br />
その結果、Edit などで IME の処理が行われると、それを感知してイベントを発行できます。<br />
<br />
また、SetWindowsHookEx の3番目の引数に HInstance を指定してフックする DLL を作ると、全プロセスに結びつくフックを作る事ができます。<br />
これによって、他のプログラムのメッセージを見ることもできます。<br />
<br />
これをグローバルフック DLL と呼びます。<br />
グローバルフック DLL の作成については、また次回!<br />
<br />
<br />
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-77516627148509631852013-01-31T20:34:00.000+09:002013-01-31T20:38:30.496+09:00ColorCheckbox を StyleElements で実装できるかどうかDEKO さんの<a href="http://ht-deko.minim.ne.jp/ft1301.html#130122">「TCheckBox の文字色と背景色を変えたい (Delphi) 」</a>で、XE3 であれば <a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.Controls.TControl.StyleElements">StyleElements</a> があるので <span class="extra">VCL Style 適用時</span>であれば比較的簡単に実装できるのではないかと思い、やってみました。<br />
<br />
結論からいうと、そうでもなかったです。<br />
<br />
まず、VCL Style を設定しているアプリケーションのメインフォームに、次の画像のように CheckBox1, CheckBox2 を置きました。<br />
そして、CheckBox2 の StyleElements を [] にしました。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiUINLHJTgI8i-c0Ae0ufMmxYtuYISe-vaHMGpiTuPu4gp-3U7lKznvv8BFPAkVpk2Nry8ogHWHYTGg8Fuk8ClWP4qleutCvmJ7tx7ztgExyshy1n2Q3-SRNSoBaPKrsb-i9GbZu2n7txOw/s1600/i1.png"><img border="0" height="184" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiUINLHJTgI8i-c0Ae0ufMmxYtuYISe-vaHMGpiTuPu4gp-3U7lKznvv8BFPAkVpk2Nry8ogHWHYTGg8Fuk8ClWP4qleutCvmJ7tx7ztgExyshy1n2Q3-SRNSoBaPKrsb-i9GbZu2n7txOw/s320/i1.png" /></a><br />
<br />
これを実行すると以下のようになりました。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhjyFc-honapW42zoMs7XirBs955wl8N4FEjh9iQFIheAijTCs3_3waANwrqWfVkiurHRIBb9CPW57YuZKJukH6Uc04Or43EjQBT4Mw_hoVu6x0nzyMUTHRC7wauHUEuq6kbms5f4PGXcZ2/s1600/i2.png"><img border="0" height="143" width="157" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhjyFc-honapW42zoMs7XirBs955wl8N4FEjh9iQFIheAijTCs3_3waANwrqWfVkiurHRIBb9CPW57YuZKJukH6Uc04Or43EjQBT4Mw_hoVu6x0nzyMUTHRC7wauHUEuq6kbms5f4PGXcZ2/s320/i2.png" /></a><br />
<br />
CheckBox2 は、VCL Style ではなく、Windows のデフォルトで表示されています。<br />
全ての Style を無効にしたので、当然の結果です。<br />
<br />
次に、StyleElements に [seClient, seBorder] を指定して、フォントにはスタイルが要りません!宣言をします。<br />
そして、Font.Color プロパティに clAqua を入れ、実行すると次のようになりました。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhDOz65yWISce1fFbcEuKAUq6M4NysBcAyBtgK0LB1vFglPxDDYBfmnHX7A0QBv__8CdsYKd4iAvRQdqGN5Lh1UfZIPK2E5JuKs4WIpI1_RnJJmBsYUr4SJW4r8MAWlu5Dg9VrQePU4u7lL/s1600/i3.png"><img border="0" height="171" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhDOz65yWISce1fFbcEuKAUq6M4NysBcAyBtgK0LB1vFglPxDDYBfmnHX7A0QBv__8CdsYKd4iAvRQdqGN5Lh1UfZIPK2E5JuKs4WIpI1_RnJJmBsYUr4SJW4r8MAWlu5Dg9VrQePU4u7lL/s320/i3.png" /></a><br />
<br />
このように、フォント色は簡単に変更できることが判ります。<br />
<br />
では、ここで StyleElements から seClient を抜いて、Color プロパティに clRed を指定してやれば、クライアント領域が赤で塗りつぶされそうな気がします。<br />
<br />
しかし、結果は、下図のようになり、期待した動作にはなりませんでした。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgZo_AqoN-lvmKD2iIb7y6KJ5LBbrqO9pP78Je02bJCXFS5Ef3TgpbVcnkYAqB9Hmnn6DJBQas3Qjp4qaPbwEEpf-EiTkzP3IeCWzM84usU8fDJWRJbaArGVOr6JO-pQLKGeIICFCMgw2sI/s1600/i4.png"><img border="0" height="91" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgZo_AqoN-lvmKD2iIb7y6KJ5LBbrqO9pP78Je02bJCXFS5Ef3TgpbVcnkYAqB9Hmnn6DJBQas3Qjp4qaPbwEEpf-EiTkzP3IeCWzM84usU8fDJWRJbaArGVOr6JO-pQLKGeIICFCMgw2sI/s320/i4.png" /></a><br />
<br />
実はクライアント領域は <a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.Themes.TStyleHook.AcceptMessage">TStyleHook の方で seClient が入っていなければ、元々の動作をするように組まれている</a>のです。 <br />
<br />
そのため、seClient を抜いても、Color プロパティで背景は描画されません。<br />
<br />
<div class="column">
TLabel の場合、元々背景色を塗りつぶす機能があるため、StyleElements から seClient を抜き、<a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.StdCtrls.TCustomLabel.Transparent">Transparent プロパティ</a>を False に設定すると、指定した色で背景が描画できます。<br />
<br/>
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjwYBZAdzQ2Y-Xo9efeLGoiaoGJqsA08Fl5-tTaIeGGANkKRthWjK7Cbu0AkoEPsSco1VorxJ3jmqvxZqzuLPgbZoK7V_a9ZhrFyv2FyRAj2RLquZY-Ib8JaLBQ03Mmak6DIahf2u0-j0zN/s1600/i6.png"><img border="0" height="172" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjwYBZAdzQ2Y-Xo9efeLGoiaoGJqsA08Fl5-tTaIeGGANkKRthWjK7Cbu0AkoEPsSco1VorxJ3jmqvxZqzuLPgbZoK7V_a9ZhrFyv2FyRAj2RLquZY-Ib8JaLBQ03Mmak6DIahf2u0-j0zN/s320/i6.png" /></a><br/>
</div>
<br />
これを解決するためには、TCheckBox 用の新しい StyleHook を作る他ありません。<br />
<br />
そこで、作ってみました。<br />
できあがった StyleHook のソースは以下のようになります。<br />
<br />
<pre class="code">
<div class="oddline"><b>unit</b> uCheckBoxStyleHookEx;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> System.Types, <b>Winapi</b>.Messages, System.Classes, Vcl.Graphics, Vcl.Controls,</div>
<div class="oddline"> Vcl.StdCtrls, Vcl.Themes;</div>
<div class="evenline"> </div>
<div class="oddline"><b>type</b></div>
<div class="evenline"> TCheckBoxStyleHookEx = <b>class</b>(TCheckBoxStyleHook)</div>
<div class="oddline"> <b>protected</b></div>
<div class="evenline"> <b>procedure</b> PaintBackground(Canvas: TCanvas); <b>override</b>;</div>
<div class="oddline"> <b>function</b> AcceptMessage(var <b>Message</b>: TMessage): Boolean; <b>override</b>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>implementation</b></div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TCheckBoxStyleHookEx }</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>function</b> TCheckBoxStyleHookEx.AcceptMessage(var <b>Message</b>: TMessage): Boolean;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// StyleElements が、どのような値であっても描画処理はこちらで行う</span></div>
<div class="oddline"> Result := True;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> TCheckBoxStyleHookEx.PaintBackground(Canvas: TCanvas);</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> tmpRect: TRect;</div>
<div class="oddline"> ElementSize: TElementSize;</div>
<div class="evenline"> BoxSize: TSize;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// 元の描画処理を呼び出して、チェックボックスの図形などを書いて貰う</span></div>
<div class="oddline"> <b>inherited</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// クライアント領域の描画が入っていない場合</span></div>
<div class="evenline"> <b>if</b> <b>not</b> (seClient <b>in</b> Control.StyleElements) <b>then</b> <b>begin</b></div>
<div class="oddline"> <span class="comment">// チェックボックス図形の大きさを求める</span></div>
<div class="evenline"> tmpRect := Rect(<span class="number">0</span>, <span class="number">0</span>, <span class="number">20</span>, <span class="number">20</span>);</div>
<div class="oddline"> ElementSize := esActual;</div>
<div class="evenline"> </div>
<div class="oddline"> <b>with</b> StyleServices <b>do</b></div>
<div class="evenline"> <b>if</b></div>
<div class="oddline"> <b>not</b> GetElementSize(</div>
<div class="evenline"> Canvas.Handle,</div>
<div class="oddline"> GetElementDetails(tbCheckBoxCheckedNormal),</div>
<div class="evenline"> tmpRect,</div>
<div class="oddline"> ElementSize,</div>
<div class="evenline"> BoxSize)</div>
<div class="oddline"> <b>then</b> <b>begin</b></div>
<div class="evenline"> BoxSize.cx := <span class="number">13</span>;</div>
<div class="oddline"> BoxSize.cy := <span class="number">13</span>;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// チェックボックス図形の分を矩形から取り除く</span></div>
<div class="oddline"> tmpRect := Control.ClientRect;</div>
<div class="evenline"> Inc(tmpRect.Left, BoxSize.cx);</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// Color プロパティの色で背景を塗りつぶす</span></div>
<div class="oddline"> Canvas.Brush.Color := TCheckBox(Control).Color;</div>
<div class="evenline"> Canvas.FillRect(tmpRect);</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>initialization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// TCheckBoxStyleHookEx を TCheckBox の Style Hook とする</span></div>
<div class="oddline"> TCustomStyleEngine.RegisterStyleHook(TCheckBox, TCheckBoxStyleHookEx);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>finalization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>end</b>.</div>
</pre>
<br />
ポイントは、AcceptMessage で返す値を必ず True にして、描画処理をこちらで受け持つ所です。<br />
これにより、必ず PaintBackground が呼び出されるため、背景色を自由に設定できます。<br />
また、元々の描画処理も呼び出しているので、TFont.Color も何もしなくても効きます。<br />
この TCheckBoxStyleHookEx を uses して実行した結果が次の画像です。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjwf7YXMDxin1RLKjg8iEkG9J5-5gJxbtK_KFlTImwtnjDcptVR4Fql4J1J1qaR900Rsd1tM0-kDK0DwjHr9qJYEazvHRKmHf-dzy0oi_79CUba99I7-_0EoKafvGMI0CkFOIRViyLF4dtz/s1600/i5.png"><img border="0" height="143" width="157" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjwf7YXMDxin1RLKjg8iEkG9J5-5gJxbtK_KFlTImwtnjDcptVR4Fql4J1J1qaR900Rsd1tM0-kDK0DwjHr9qJYEazvHRKmHf-dzy0oi_79CUba99I7-_0EoKafvGMI0CkFOIRViyLF4dtz/s320/i5.png" /></a><br />
<br />
期待通り、TForm.Color と Font.Color が効いています。<br />
<br />
結局、StyleHook を使わないと簡単にはできないんだね、という結論でした。<br />
<br />
<div class="column">
上記の例では StyleElements を [seBorder] にして実行しました。<br />
もしも StyleElements を [] にすると、どうなるでしょうか?<br />
StyleElements を [] にして実行すると、素の Windows のコントロールが描画されます。<br />
AcceptMessage が True を返しているにも関わらず、です。<br />
これは、TWinControl.WndProc の中で、StyleElements が [] だったら、スタイル処理を実行しない、という部分(Vcl.Controls.pas 9892 行目)があるためです。<br />
そのため、StyleElements が [] の状態だと、スタイル処理が実行されず、素の Windows のコントロールが描画されてしまうのです。<br />
個人的には、この if 文は要らないと思います(※)が、仕様ともいえるため QuolityCentral には報告していません。<br>
<br />
※変更する手段が無いため。<br />
Control.WindowProc でウィンドウプロシージャを変更しても、その時点では StyleHook を設定できない。
</div>
<br />
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-80550593752211900822013-01-21T10:00:00.000+09:002013-01-21T10:00:01.379+09:00管理者権限で起動する CMD<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/blob/master/AdminCMD/AdminCMD.dpr">ソースはこちら(GitHub)</a>
</div>
<br />
開発していると、結構コマンドプロンプト(CMD.exe)を実行することがあります。<br />
普通に CMD.exe を起動すると、普通の権限で起動します。<br />
しかし、管理者権限でのみ動作するようなプログラムなどを起動したい場合に、一々 UAC が開くのは煩わしいものです。<br />
かといって「管理者としてこのプログラムを起動する」っていうチェックをいれるというのも、いまいちです。<br />
というのも、もしも顧客に対して提供するコマンドラインツールがあったとすると、「このコマンドを実行して下さい。このコマンドは管理者権限で~云々」と説明しなくてはならないためです(しかも正しく伝わる確率の方が低い!)。<br />
そこで、管理者権限で起動する CMD.exe を作ってみます。<br />
<br />
ポイントは3つ。<br />
<br />
1つ目は、CMD.exe のパスの取得です。<br />
CMD.exe のパスの取得はいくつかやり方があります。<br />
まずは <a href="http://msdn.microsoft.com/ja-jp/library/windows/desktop/bb762203(v=vs.85).aspx">SHGetSpecialFolderLocation</a> を使って「Windows\System32」のパスを取得し、そのパスに CMD.exe を結合して実行する方法です。<br />
とても真っ当な方法ですが <a href="http://msdn.microsoft.com/ja-jp/library/windows/desktop/bb773321(v=vs.85).aspx">ItemIDList</a> を取得したりと、何かと面倒です。
<br />
そこで、もう1つの方法「環境変数」から取得することにします。<br />
環境変数「<a href="http://msdn.microsoft.com/ja-jp/library/vstudio/ms404706.aspx">ComSpec</a>」は、CMD.exe のパスを示す環境変数です。<br />
取得した環境変数を展開して有効なパスに変換する API が <a href="http://msdn.microsoft.com/ja-jp/library/cc429716.aspx">ExpandEnvironmentStrings</a> です。<br />
これを使って「%ComSpec%」という環境変数を「C:\Windows\System32\cmd.exe」に変換します。<br />
<br />
2つ目は、管理者権限での実行です。<br />
とても有名なので既にご存じかも知れませんが、ShellExecuteEx の lpVerb に 'runas' を指定して、プログラムを実行すると UAC が開いて管理者権限で実行できます。<br />
これについては<a href="http://edn.embarcadero.com/jp/article/images/34159/devcamp04_g4.pdf">過去のデベロッパーキャンプでエンバカデロの高橋さんが説明(pdf)</a>されています。<br />
<br />
3つ目は、起動しても自分自身は見せずに CMD.exe だけを実行する方法です。<br />
プログラムを一個起動するだけなので <a href="http://docwiki.embarcadero.com/RADStudio/XE3/ja/Application_%E3%81%AE%E7%A8%AE%E9%A1%9E%EF%BC%88Delphi%EF%BC%89">{$APPTYPE CONSOLE}</a> で、コンソールアプリとして実装すれば良さそうに見えますが、そうするとコンソールが開いてしまいます。<br />
そこで、今回は何も指定しない、つまり {$APPTYPE GUI} としてアプリケーションを作る事にします。<br />
こうすることで、開く Window(TForm)が存在しないため、何も表示せずにアプリケーションを実行可能です。<br />
<br />
これらを踏まえたコードが下記です。<br />
<br />
<pre class="code">
<div class="oddline"><b>program</b> AdminCMD;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// 自分を表示したくないので指定しない</span></div>
<div class="evenline"><span class="comment"><span class="comment">//{$APPTYPE CONSOLE}</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>uses</b></div>
<div class="oddline"> <b>Winapi</b>.Windows, <b>Winapi</b>.ShellApi, System.SysUtils;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// 管理者権限で実行する</span></div>
<div class="evenline"><b>function</b> RunAsAdmin(<b>const</b> iExeName, iParam: <b>String</b>): Boolean;</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> SEI: TShellExecuteInfo;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Result := False;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// runas は、Vista 以降のみ動作する</span></div>
<div class="oddline"> <b>if</b> (CheckWin32Version(<span class="number">6</span>)) <b>then</b> <b>begin</b></div>
<div class="evenline"> ZeroMemory(@SEI, SizeOf(SEI));</div>
<div class="oddline"> </div>
<div class="evenline"> <b>with</b> SEI <b>do</b> <b>begin</b></div>
<div class="oddline"> cbSize := SizeOf(SEI);</div>
<div class="evenline"> Wnd := <span class="number">0</span>;</div>
<div class="oddline"> fMask := SEE_MASK_FLAG_DDEWAIT <b>or</b> SEE_MASK_FLAG_NO_UI;</div>
<div class="evenline"> lpVerb := <span class="string">'runas'</span>;</div>
<div class="oddline"> lpFile := PChar(iExeName);</div>
<div class="evenline"> lpParameters := PChar(iParam);</div>
<div class="oddline"> nShow := SW_SHOW;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> Result := ShellExecuteEx(@SEI);</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> CmdPath: <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// 環境変数から CMD.exe のパスを取得する</span></div>
<div class="evenline"> CmdPath := <span class="string">StringOfChar(#0</span>, MAX_PATH);</div>
<div class="oddline"> ExpandEnvironmentStrings(</div>
<div class="evenline"> PChar(<span class="string">'%ComSpec%'</span>),</div>
<div class="oddline"> PChar(CmdPath),</div>
<div class="evenline"> Length(CmdPath));</div>
<div class="oddline"> </div>
<div class="evenline"> CmdPath := Trim(CmdPath);</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 管理者権限で実行</span></div>
<div class="oddline"> RunAsAdmin(CmdPath, <span class="string">''</span>);</div>
<div class="evenline"><b>end</b>.</div>
</pre>
<br />
このコードを実行すると……<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiXzehigw0itNuDqG_n8kaHQjdOgokoB1LUjNyqLI4IlJPxGUSrwPdjsK5ee6mzGahKVV9K3J52iHjOVsRb3zcgNm85dxXr0a213boW_t2LzpyN-pXokrAyvHKzLsG7fl6oaXNQ4w8oYh5u/s1600/%25E5%2590%258D%25E7%25A7%25B0%25E6%259C%25AA%25E8%25A8%25AD%25E5%25AE%259A-1.png"><img border="0" height="183" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiXzehigw0itNuDqG_n8kaHQjdOgokoB1LUjNyqLI4IlJPxGUSrwPdjsK5ee6mzGahKVV9K3J52iHjOVsRb3zcgNm85dxXr0a213boW_t2LzpyN-pXokrAyvHKzLsG7fl6oaXNQ4w8oYh5u/s320/%25E5%2590%258D%25E7%25A7%25B0%25E6%259C%25AA%25E8%25A8%25AD%25E5%25AE%259A-1.png" /></a>
<br />
<br />
UAC の確認ダイアログが出た後に<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgzV_GT-4_a87bast1bThpN7yVWpU4kyD49zn-pkVPOm5ZtuX-iXhR7ISdP33nUPwMXsYL4a2CKABV68nVFmcgWGaW0Xa_T99UIcu7_7ZLH_o_TU8zzhkKcKXckgj1mduUlOed_IwG8hKyr/s1600/%25E5%2590%258D%25E7%25A7%25B0%25E6%259C%25AA%25E8%25A8%25AD%25E5%25AE%259A-2.png"><img border="0" height="233" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgzV_GT-4_a87bast1bThpN7yVWpU4kyD49zn-pkVPOm5ZtuX-iXhR7ISdP33nUPwMXsYL4a2CKABV68nVFmcgWGaW0Xa_T99UIcu7_7ZLH_o_TU8zzhkKcKXckgj1mduUlOed_IwG8hKyr/s320/%25E5%2590%258D%25E7%25A7%25B0%25E6%259C%25AA%25E8%25A8%25AD%25E5%25AE%259A-2.png" /></a>
<br />
<br />
コマンドプロンプトが開きます。<br />
使いどころを誤らなければ、便利なコマンドプロンプトだと思います。<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-10821838532358798982013-01-17T20:04:00.001+09:002013-01-17T20:12:25.117+09:00IME が ATOK か見分けるごくごく希に IME をいじる時があります。<br />
そして、MS-IME と ATOK で違う動作をさせたいなーという事が、すごっく希にあります。<br />
<br />
そんなとき、<a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.Forms.TScreen.Imes">Screen.Imes</a> や <a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.Forms.TScreen.DefaultIme">Screen.DefaultIme</a> で IME の名前を取れば、ATOK かそうでないかが見分けられます。<br />
<br />
たとえば、次のような関数で ATOK かどうかを見分けられます。<br />
<br />
<pre class="code">
<div class="oddline"><b>function</b> IsATOK: Boolean;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> Result := (Screen.DefaultIme.IndexOf(<span class="string">'ATOK'</span>) > -<span class="number">1</span>);</div>
<div class="evenline"><b>end</b>;</div>
</pre>
<br />
また、Screen.Imes.Objects[] プロパティには「入力ロケール識別子」(旧名:キーボードレイアウト)が入っています。
あるエディットコントロールでは、この識別子、また別の時には別の識別子、を指定して <a href="http://msdn.microsoft.com/ja-jp/library/cc430248.aspx">ActiveKeyboardLayout API</a> を呼び出して、IME を指定したりすることもできます。<br />
<br />
<div class="column">
(<a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.Forms.TScreen.DefaultKbLayout">Screen.DefaultKbLayout</a> というデフォルトの入力ロケール識別子を返すプロパティもあります。)
</div>
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-26165760907111430612012-12-25T00:00:00.000+09:002012-12-25T00:00:01.234+09:00痛 VCL Style<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/tree/master/ItaVCLStyle">ソースはこちら(GitHub)</a><br />
<a href="http://msdn.microsoft.com/ja-jp/claudia00_03">クラウディアさんはこちら</a><br />
</div>
<br />
<a href="http://atnd.org/events/34390">Delphi Advent Calendar 2012</a> 12/25 の記事です。<br />
<br />
タイトルにある通りのことをしてみたいと思ったわけです。<br />
これは、<a href="http://atnd.org/events/34390">Delphi Advent Calendar 2012</a> の 12/14 の <a href="https://twitter.com/lynatan">Lyna</a> さんの記事「<a href="http://d.hatena.ne.jp/tales/20121214/1355418690">IDEにおける背景変更機能の導入による開発効率への影響とその考察。</a>」(痛IDE)に触発されてのことです。<br />
<br />
VisualStudio の痛背景画像では開発環境しか変えられないけど、Delphi だったら Style 使えば簡単に「痛アプリ」が作れちゃうもんね!という思いから始めたわけですが、TForm だけ、かなり特殊じゃん……と気づかされました。<br />
<br />
手始めに、こんなスタイルを作ってみました。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgJVO6u8kVZqRZOJ7HrqaT8C_5RHi4vutGW069nZdi4c-oaxrLEo6U1DN-jkTC77MC6A_46OJ8cOxfVRqGjoGjNVlFsZUMg0f2rUUfkBLm58hlOKyRhxo7IUWUbkp8tmJ6lR1icgbsjW-5J/s1600/1.png"><img border="0" height="249" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgJVO6u8kVZqRZOJ7HrqaT8C_5RHi4vutGW069nZdi4c-oaxrLEo6U1DN-jkTC77MC6A_46OJ8cOxfVRqGjoGjNVlFsZUMg0f2rUUfkBLm58hlOKyRhxo7IUWUbkp8tmJ6lR1icgbsjW-5J/s320/1.png" /></a><br />
<br />
Metropolis UI の Blue スタイルにクラウディアを追加するという形で。<br />
<br />
<div class="column">
Images に画像を「追加」することができるのですが、うまくいきませんでした。<br />
様々な例外が上がります。<br />
また、上記のような一体化画像を作った際は「更新」ボタンを使って画像を更新しないと、酷い目に遭います。<br />
Objects 以下のオブジェクトは全部、現在の画像を指しているので「削除」してから「追加」とすると、Objects 以下の全オブジェクトが例外を吐きます……。
</div>
<br />
それで、Objects/Form/Image/Client にクラウディアを設定してみました。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi7vmQVw-s9eulUI_YpuLV535Od4ngvfY_jf7dyOzxfC969zeitavG1ZQnWcEzQFmVJgpFs0wXf7Bw80HWvCoVSRR2V9s-vmsxf9AnkJ7dFBJqg9GRwHn0bkNZ3QGN67aXhXcD9pIRf0u1x/s1600/2.png"><img border="0" height="222" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi7vmQVw-s9eulUI_YpuLV535Od4ngvfY_jf7dyOzxfC969zeitavG1ZQnWcEzQFmVJgpFs0wXf7Bw80HWvCoVSRR2V9s-vmsxf9AnkJ7dFBJqg9GRwHn0bkNZ3QGN67aXhXcD9pIRf0u1x/s320/2.png" /></a><br />
<br />
この結果何が起こるかというと……<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg8azWAvNIF6eM4cir4U35gTgmE7fQTccjVE3SXfE7HFlakPvrPqAExdBmWXTMHAiw9bfXgNznnZuVjt3cCTfIG6P9f3-z1DXQj8611OwqCcHJJnw-unVCVBDw0DAVl55j6AbHZunRzjSit/s1600/3.png"><img border="0" height="216" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg8azWAvNIF6eM4cir4U35gTgmE7fQTccjVE3SXfE7HFlakPvrPqAExdBmWXTMHAiw9bfXgNznnZuVjt3cCTfIG6P9f3-z1DXQj8611OwqCcHJJnw-unVCVBDw0DAVl55j6AbHZunRzjSit/s320/3.png" /></a><br />
<br />
思ってたのと違う!!いや合ってるけど!でも違う!<br />
タイリング表示されました……<br />
なんとか右下にクラウディアたんが佇んでくれないかと。<br />
かといって TileStyle には、そんな都合のいい値はありません。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhqfLliXAYCwuk8-1LMrgYyl4g17IAeNO3MulRm5dLqOLZnq32PHJAxDaVAVOYy3n9IIjk3I04nI62FCYAo5CrjZKESwRDihvRVX0weY4kbM1c_D4uwZ_nuNKRAzUoaTd-0-ZitRK7SWodL/s1600/4.png" imageanchor="1" style=""><img border="0" height="320" width="310" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhqfLliXAYCwuk8-1LMrgYyl4g17IAeNO3MulRm5dLqOLZnq32PHJAxDaVAVOYy3n9IIjk3I04nI62FCYAo5CrjZKESwRDihvRVX0weY4kbM1c_D4uwZ_nuNKRAzUoaTd-0-ZitRK7SWodL/s320/4.png" /></a><br />
<br />
<div class="column">
そもそも、tsTile 以外の値を設定すると、再描画が上手くされません。<br />
これは、スタイルの描画方法に起因しています。<br />
このような一部分が他と違うようなものを想定していないためです。
</div>
<br />
何時間か、弄っていたのですが、これでは拉致があかない!と、方法を改めることにしました。<br />
TClaudiaFormStyleHooke を作る事にしたのです。<br />
しかし、これも簡単にはいきませんでした。<br />
何故かと言うと TCustomForm と TFormStyleHook が完全に癒着していて、TForm に他の StyleHook が設定できる想定がされていなかったためです。<br />
<br />
しかし、最終的にはなんとかなりました。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjAku61bBuqJtdXWYlvAdhOBrbYzxU4YcgKE7ltW3MSafukJ4DiyZcWaf7yZFb-WjKuIRN3oq6ceZNrOAQTDCXgAR04ccGe6rOugEULsjvdQ98YBHW5ghTAA5wXvbf56F2ZWhLSADFytyB0/s1600/5.png"><img border="0" height="224" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjAku61bBuqJtdXWYlvAdhOBrbYzxU4YcgKE7ltW3MSafukJ4DiyZcWaf7yZFb-WjKuIRN3oq6ceZNrOAQTDCXgAR04ccGe6rOugEULsjvdQ98YBHW5ghTAA5wXvbf56F2ZWhLSADFytyB0/s320/5.png" /></a><br />
<br />
結構苦労しましたが、使い方は簡単です。<br />
uClaudiaFormStyleHook をプロジェクトファイルに uses するだけです。<br />
<span class="extra">※アプリケーションに <a href="http://docwiki.embarcadero.com/RADStudio/XE3/ja/VCL_%E3%82%B9%E3%82%BF%E3%82%A4%E3%83%AB%E3%81%AE%E6%A6%82%E8%A6%81">VCL Style</a> が設定されている必要があります。</span><br />
<br />
<pre class="code">
<div class="oddline"><b>program</b> Project1;</div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> Vcl.Forms,</div>
<div class="oddline"> Vcl.Themes,</div>
<div class="evenline"> Vcl.Styles,</div>
<div class="oddline"> Unit1 <b>in</b> <span class="string">'Unit1.pas'</span> <span class="comment">{Form1}</span>,</div>
<div class="evenline"> <span class="extra">uClaudiaFormStyleHook</span>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{$R *.res}</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> Application.Initialize;</div>
<div class="evenline"> Application.MainFormOnTaskbar := True;</div>
<div class="oddline"> TStyleManager.TrySetStyle(<span class="string">'Auric'</span>);</div>
<div class="evenline"> Application.CreateForm(TForm1, Form1);</div>
<div class="oddline"> Application.Run;</div>
<div class="evenline"><b>end</b>.</div>
</pre>
<br />
詳しい構造は、ソース内のコメントをご覧ください。<br />
<br />
<pre class="code">
<div class="oddline"><b>unit</b> <span class="extra">uClaudiaFormStyleHook</span>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> <b>Winapi</b>.Windows, Vcl.Controls, Vcl.Graphics, Vcl.Forms, Vcl.Themes,</div>
<div class="oddline"> Vcl.Imaging.pngimage;</div>
<div class="evenline"> </div>
<div class="oddline"><b>type</b></div>
<div class="evenline"> <span class="comment">// クラウディアたんを右下に表示する Style Hook</span></div>
<div class="oddline"> TClaudiaFormStyleHook = <b>class</b>(TFormStyleHook)</div>
<div class="evenline"> <b>private</b></div>
<div class="oddline"> FClaudia: TPngImage;</div>
<div class="evenline"> <b>protected</b></div>
<div class="oddline"> <b>procedure</b> PaintBackground(Canvas: TCanvas); <b>override</b>;</div>
<div class="evenline"> <b>public</b></div>
<div class="oddline"> <b>constructor</b> Create(iControl: TWinControl); <b>override</b>;</div>
<div class="evenline"> <b>destructor</b> Destroy; <b>override</b>;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>implementation</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> System.Classes, System.SysUtils;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">{ TClaudiaFormStyleHook }</span></div>
<div class="oddline"> </div>
<div class="evenline"><b>constructor</b> TClaudiaFormStyleHook.Create(iControl: TWinControl);</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>inherited</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// PNG Image を生成</span></div>
<div class="oddline"> FClaudia := TPngImage.Create;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// クラウディアの画像を読み出す</span></div>
<div class="evenline"> FClaudia.LoadFromFile(ExtractFilePath(Application.ExeName) + <span class="string">'\Claudia.png'</span>);</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>destructor</b> TClaudiaFormStyleHook.Destroy;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// PNG Image を破棄</span></div>
<div class="evenline"> FClaudia.Free;</div>
<div class="oddline"> </div>
<div class="evenline"> <b>inherited</b>;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// WM_ERASEBKGND が来たときに呼ばれるメソッド</span></div>
<div class="evenline"><b>procedure</b> TClaudiaFormStyleHook.PaintBackground(Canvas: TCanvas);</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> FormCanvas: TCanvas;</div>
<div class="oddline"> Back: TBitmap;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// まず親の PaintBackground を呼び、このフォームに乗っている</span></div>
<div class="evenline"> <span class="comment">// 子コントロール分の背景を描画する</span></div>
<div class="oddline"> <b>inherited</b>;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// 背景用 Bitmap を作る</span></div>
<div class="evenline"> Back := TBitmap.Create;</div>
<div class="oddline"> <b>try</b></div>
<div class="evenline"> <b>with</b> Back, Canvas <b>do</b> <b>begin</b></div>
<div class="oddline"> <span class="comment">// 大きさは、フォームのクライアントエリアと同じ</span></div>
<div class="evenline"> SetSize(Control.Width, Control.Height);</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 背景色で塗りつぶす</span></div>
<div class="oddline"> Brush.Color := StyleServices.GetStyleColor(scWindow);</div>
<div class="evenline"> FillRect(Rect(<span class="number">0</span>, <span class="number">0</span>, Width, Height));</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// クラウディアを右下に描画する</span></div>
<div class="oddline"> Draw(Width - FClaudia.Width, Height - FClaudia.Height, FClaudia);</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// フォームに描画するための Canvas を作る</span></div>
<div class="oddline"> <span class="comment">// 引数の Canvas は、TBitmap の Canvas でしかないため</span></div>
<div class="evenline"> <span class="comment">// Canvas に Draw しても描画されない</span></div>
<div class="oddline"> FormCanvas := TCanvas.Create;</div>
<div class="evenline"> <b>try</b></div>
<div class="oddline"> <span class="comment">// デバイスコンテキストを取得</span></div>
<div class="evenline"> FormCanvas.Handle := GetDC(Control.Handle);</div>
<div class="oddline"> <b>try</b></div>
<div class="evenline"> <span class="comment">// 背景用 Bitmap を描画する</span></div>
<div class="oddline"> FormCanvas.Draw(<span class="number">0</span>, <span class="number">0</span>, Back);</div>
<div class="evenline"> <b>finally</b></div>
<div class="oddline"> ReleaseDC(Control.Handle, FormCanvas.Handle);</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"> <b>finally</b></div>
<div class="evenline"> FormCanvas.Free;</div>
<div class="oddline"> <b>end</b>;</div>
<div class="evenline"> <b>finally</b></div>
<div class="oddline"> Back.Free;</div>
<div class="evenline"> <b>end</b>;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>initialization</b></div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// まず TFormStyleHook を TCustomForm から外さないと</span></div>
<div class="evenline"> <span class="comment">// TClaudiaFormStyleHook は呼ばれない</span></div>
<div class="oddline"> TCustomStyleEngine.UnregisterStyleHook(TCustomForm, TFormStyleHook);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// TClaudiaFormStyleHook を TCustomForm の StyleHook として設定</span></div>
<div class="evenline"> TCustomStyleEngine.RegisterStyleHook(TCustomForm, TClaudiaFormStyleHook);</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>finalization</b></div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// TCustomForm はアプリケーションが終わり破棄されるとき TFormStyleHook を</span></div>
<div class="evenline"> <span class="comment">// UnregisterStyleHook しようとする。</span></div>
<div class="oddline"> <span class="comment">// そのため、ここで StyleHook に TFormStyleHook を登録してやる。</span></div>
<div class="evenline"> <span class="comment">// 登録しないと、例外が発生する</span></div>
<div class="oddline"> TCustomStyleEngine.RegisterStyleHook(TCustomForm, TFormStyleHook);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>end</b>.</div>
</pre>
<br />
少し時間が掛かってしまいましたが、Delphi は Style という手法を手に入れたため、uses するだけで簡単に背景を変更できます。<br />
他の環境では、WM_ERASEBKGND を地道に変更したりと、Delphi のように簡単には行かないでしょう。<br />
<br />
というわけで、今回は VCL スタイルについて、痛StyleHook を作ってみました。<br />
<br />
<div class="column">
FireMonkey のスタイルでも同じ物を作ろうと思ったのですが、上手く行きませんでした。<br />
これは、僕がまだ FireMonkey を使いこなしていないためです。<br />
他の方がやってくれるかも知れません……!<br />
</div>
<br />
ということで、この記事を、Delphi Advent Calendar 2012 のトリとさせていただきます。<br />
25日間、記事を書いてくださった皆さん、記事をご覧いただいた皆さん、お付き合いくださりありがとうございました!<br />
また、来年もやりたいです!<br />
<br />
それでは、皆さん、良いお年を!<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com2tag:blogger.com,1999:blog-5767280911867023345.post-70558227978004432432012-12-24T00:00:00.000+09:002012-12-24T00:00:02.663+09:00コンソールアプリケーション4-コンソールをデバッグに使う(Delphi Advent Calendar 2012-12-24)<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/tree/master/ConsoleDebug">ソースはこちら(GitHub)</a></div>
<br />
<a href="http://atnd.org/events/34390">Delphi Advent Calendar 2012</a> 12/24 の記事です。<br />
<br />
前回までで、コンソールの基礎的な事柄を述べました<br />
今回 GUI アプリケーションで、コンソールを使う方法を紹介します。<br />
(ずっとコンソールについて書いてきましたが、結局これがやりたかった!)<br />
<br />
GUI アプリでも、デバッグ時に現在の状態を表示するためにログを出したりする事が多々あります。<br />
その場合、<a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.StdCtrls.TMemo">TMemo</a> をアプリに配置して、そこに <a href="http://docwiki.embarcadero.com/Libraries/XE3/ja/Vcl.StdCtrls.TCustomMemo.Lines">Lines.Add</a>('メッセージ')などとしている事が多いのでは無いでしょうか? <br />
しかし、Lines.Add だと数字は IntToStr() で文字列に変換しないと表示できないですし、そもそもデバッグの為だけに TMemo を置くのも馬鹿らしいです。<br />
<br />
コンソールが使えれば、それらの悩みも一挙解決です。<br />
コンソールを表示するために、何かインスタンスを作る必要も無いですし、Writeln を使えば文字列も数値も一緒くたに表示できるからです。<br />
しかも、コンソールは表示するだけではなく読み取ることもできます。<br />
コンソールから文字列を受け取って、それに応じてアプリの状態を変更したりできます(デバッグ時に非常に役に立つでしょう)。<br />
<br />
GUI アプリでコンソールを使うには2つ方法があります。<br />
1つは <a href="http://msdn.microsoft.com/ja-jp/library/cc429066.aspx">CreateProcess</a> の引数に CREATE_NEW_CONSOLE を付ける方法、<br />
もう1つは、<a href="http://msdn.microsoft.com/ja-jp/library/cc429163.aspx">AllocConsole</a> を使う方法です。<br />
<br />
CREATE_NEW_CONSOLE を使う方法は、アプリの起動時(CreateProcess を呼び出した時)に指定する必要があるため、今回は使えません(自分で自分を呼び出すことはできないため)。<br />
そこで、今回は AllocConsole を使います。<br />
FormCreate でコンソールを割り当て、FormDestroy でコンソールの割り当てを解除しています。<br />
<br />
<pre class="code">
<div class="oddline"><b>procedure</b> TForm1.Button1Click(Sender: TObject);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// コンソールに文字列を出力</span></div>
<div class="evenline"> Writeln(<span class="string">'Hello, Console !'</span>);</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>procedure</b> TForm1.FormCreate(Sender: TObject);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// コンソールを割り当て</span></div>
<div class="evenline"> AllocConsole;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>procedure</b> TForm1.FormDestroy(Sender: TObject);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// 割り当てたコンソールを開放</span></div>
<div class="evenline"> FreeConsole;</div>
<div class="oddline"><b>end</b>;</div>
</pre>
<br />
Button1 を押すとコンソールに文字列が表示されました!<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjOq8Hn6CcFp_aV8jKdgj2bY74vkshYNGaSqkSJxLBmz87iqA-Y8KZbG4PdAXe7FM-ZpP34LqeLCWTMf6ZOf6nTz0KtpSqVDhRbu6ECOTK5Ey2KVARanrrnfJbN_fSVrxNjn9KWL3VbVHd8/s1600/c1.png"><img border="0" height="232" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjOq8Hn6CcFp_aV8jKdgj2bY74vkshYNGaSqkSJxLBmz87iqA-Y8KZbG4PdAXe7FM-ZpP34LqeLCWTMf6ZOf6nTz0KtpSqVDhRbu6ECOTK5Ey2KVARanrrnfJbN_fSVrxNjn9KWL3VbVHd8/s320/c1.png" width="320" /></a>
<br />
<br />
<div class="column">
なお、コンソールが無い状態で Writeln や Readln を呼び出すと「I/O エラー」が発生します。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj57wn0rfjed9tXN_K8IXXVAykjdOaRo37Th9-z6JnLpmfNJI4FslQybEtybdGTyg02zSxANBLqBo74qLJENe2xaur24UUHR5g-RMxnfkbWCg9qpsxiKXtUfCBZiFAqqgHkJ3HCGfYo9IW_/s1600/c2.png"><img border="0" height="191" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj57wn0rfjed9tXN_K8IXXVAykjdOaRo37Th9-z6JnLpmfNJI4FslQybEtybdGTyg02zSxANBLqBo74qLJENe2xaur24UUHR5g-RMxnfkbWCg9qpsxiKXtUfCBZiFAqqgHkJ3HCGfYo9IW_/s320/c2.png" width="207" /></a>
</div>
<br />
では、この仕組みを使いやすくライブラリ化し、簡単にデバッグメッセージを出力できるようにしてみます。<br />
それぞれ詳細はコード中のコメントを参照してください。<br />
<br />
まず先に使い方です。<br />
コンソールアプリケーションと同様に Writeln/Readln が普通に使えます。<br />
ここでは Readln を使う代わりに、ライブラリ化した関数 ReadConsole を使っています。<br />
<pre class="code">
<div class="oddline"><b>procedure</b> TForm1.Button1Click(Sender: TObject);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// 文字列の表示</span></div>
<div class="evenline"> Writeln(<span class="string">'Hello, World !'</span>);</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 数字や Boolean、文字列などを混在して表示できる</span></div>
<div class="oddline"> Writeln(<span class="number">123456789</span>, <span class="string">' '</span>, True);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>procedure</b> TForm1.Button2Click(Sender: TObject);</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> Str: <b>String</b>;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// 命令をコンソールから読み取る</span></div>
<div class="oddline"> Str := ReadConsole(<span class="string">'Input Command: '</span>, True);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// exit なら終了</span></div>
<div class="evenline"> <b>if</b> (Str = <span class="string">'exit'</span>) <b>then</b></div>
<div class="oddline"> Close</div>
<div class="evenline"> <span class="comment">// notepad なら「メモ帳」を起動</span></div>
<div class="oddline"> <b>else</b> <b>if</b> (Str = <span class="string">'notepad'</span>) <b>then</b></div>
<div class="evenline"> WinExec(<span class="string">'notepad.exe'</span>, SW_SHOW)</div>
<div class="oddline"> <span class="comment">// それ以外なら不明と表示</span></div>
<div class="evenline"> <b>else</b></div>
<div class="oddline"> Writeln(<span class="string">'Unknown command:'</span>, Str);</div>
<div class="evenline"><b>end</b>;</div>
</pre>
<br />
uConsole.pas<br />
<pre class="code">
<div class="oddline"><b>unit</b> uConsole;</div>
<div class="evenline"> </div>
<div class="oddline"><b>interface</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>type</b></div>
<div class="evenline"> <span class="comment">// コンソールイベント</span></div>
<div class="oddline"> TConsoleEventType = (</div>
<div class="evenline"> ceC, <span class="comment">// CTRL + C が押された</span></div>
<div class="oddline"> ceBreak, <span class="comment">// CTRL + BREAK が押された</span></div>
<div class="evenline"> ceClose, <span class="comment">// コンソールウィンドウが閉じられた</span></div>
<div class="oddline"> ceLogOff, <span class="comment">// ログオフされた</span></div>
<div class="evenline"> ceShutdown <span class="comment">// シャットダウンされた</span></div>
<div class="oddline"> );</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// コンソールイベント型</span></div>
<div class="evenline"> TConsoleEvent = <b>procedure</b>(<b>const</b> iType: TConsoleEventType) <b>of</b> <b>object</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// コンソールイベントを受け取るリスナーを追加・解除</span></div>
<div class="oddline"><b>procedure</b> AddConsoleEventListener(<b>const</b> iListener: TConsoleEvent);</div>
<div class="evenline"><b>procedure</b> RemoveConsoleEventListener(<b>const</b> iListener: TConsoleEvent);</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// コンソールから文字列を読み取る</span></div>
<div class="oddline"><b>function</b> ReadConsole(</div>
<div class="evenline"> <b>const</b> iPrompt: <b>String</b> = <span class="string">''</span>;</div>
<div class="oddline"> <b>const</b> iToLower: Boolean = False): <b>String</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><b>implementation</b></div>
<div class="evenline"> </div>
<div class="oddline"><b>uses</b></div>
<div class="evenline"> <b>Winapi</b>.Windows, Generics.Collections, System.SysUtils;</div>
<div class="oddline"> </div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> <span class="comment">// コンソールウィンドウのハンドル</span></div>
<div class="evenline"> GWnd: HWND;</div>
<div class="oddline"> <span class="comment">// イベントリスナを管理するリスト</span></div>
<div class="evenline"> GListeners: TList<TConsoleEvent>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// コンソールイベントリスナを追加</span></div>
<div class="oddline"><b>procedure</b> AddConsoleEventListener(<b>const</b> iListener: TConsoleEvent);</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <b>if</b> (GListeners.IndexOf(iListener) < <span class="number">0</span>) <b>then</b></div>
<div class="evenline"> GListeners.Add(iListener);</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// コンソールイベントリスナを削除</span></div>
<div class="evenline"><b>procedure</b> RemoveConsoleEventListener(<b>const</b> iListener: TConsoleEvent);</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <b>if</b> (GListeners.IndexOf(iListener) > -<span class="number">1</span>) <b>then</b></div>
<div class="oddline"> GListeners.Remove(iListener);</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// コンソールから文字列を読み取る</span></div>
<div class="oddline"><span class="comment">// iPrompt 読み取り前に表示する文字列(ex. 'Please input your name: ')</span></div>
<div class="evenline"><span class="comment">// iToLower 読み取った文字列を小文字にするなら True</span></div>
<div class="oddline"><b>function</b> ReadConsole(</div>
<div class="evenline"> <b>const</b> iPrompt: <b>String</b> = <span class="string">''</span>;</div>
<div class="oddline"> <b>const</b> iToLower: Boolean = False): <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// プロンプトの表示</span></div>
<div class="evenline"> <b>if</b> (iPrompt <> <span class="string">''</span>) <b>then</b></div>
<div class="oddline"> <b>Write</b>(iPrompt);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// コンソールに入力フォーカスを与える</span></div>
<div class="evenline"> ShowWindow(GWnd, SW_SHOW);</div>
<div class="oddline"> SetForegroundWindow(GWnd);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// 読み込む</span></div>
<div class="evenline"> Readln(Result);</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// 小文字化</span></div>
<div class="oddline"> <b>if</b> (iToLower) <b>then</b></div>
<div class="evenline"> Result := LowerCase(Result);</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// コンソールイベントが起きたときに呼ばれる関数</span></div>
<div class="evenline"><b>function</b> HandlerRoutine(dwCtrlType: DWORD): BOOL; <b>stdcall</b>;</div>
<div class="oddline"><b>var</b></div>
<div class="evenline"> Listener: TConsoleEvent;</div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> Result := True; <span class="comment">// False の場合、イベントは OS が適切に処理する</span></div>
<div class="oddline"> <span class="comment">//(ex. CTRL + C が押されたらアプリケーションを終了させる)</span></div>
<div class="evenline"> <span class="comment">// True の場合、OS は何もしない</span></div>
<div class="oddline"> </div>
<div class="evenline"> <b>for</b> Listener <b>in</b> GListeners <b>do</b></div>
<div class="oddline"> Listener(TConsoleEventType(dwCtrlType));</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><span class="comment">// コンソールの初期設定</span></div>
<div class="oddline"><span class="comment">// ・コンソールの Window Handle の特定</span></div>
<div class="evenline"><span class="comment">// ・コンソールのタイトルの設定</span></div>
<div class="oddline"><b>procedure</b> InitConsole;</div>
<div class="evenline"><b>var</b></div>
<div class="oddline"> Cap: <b>String</b>;</div>
<div class="evenline"><b>begin</b></div>
<div class="oddline"> <span class="comment">// Window Caption に GUID を設定する</span></div>
<div class="evenline"> Cap := TGUID.NewGuid.ToString;</div>
<div class="oddline"> SetConsoleTitle(PWideChar(Cap));</div>
<div class="evenline"> </div>
<div class="oddline"> Sleep(<span class="number">40</span>); <span class="comment">// Caption が確実に設定されるために 40[msec] 待つ</span></div>
<div class="evenline"> <span class="comment"><span class="comment">// <a href="http://support.microsoft.com/kb/124103/ja">http://support.microsoft.com/kb/124103/ja</a></span></div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// GUID でウィンドウを探す</span></div>
<div class="oddline"> GWnd := FindWindow(<b>nil</b>, PChar(Cap));</div>
<div class="evenline"> </div>
<div class="oddline"> <b>if</b> (GWnd <> <span class="number">0</span>) <b>then</b></div>
<div class="evenline"> <span class="comment">// 見つけたらスタイルから System Menu を外す</span></div>
<div class="oddline"> <span class="comment">//(コンソールを勝手に閉じられないようにするため)</span></div>
<div class="evenline"> SetWindowLong(</div>
<div class="oddline"> GWnd,</div>
<div class="evenline"> GWL_STYLE,</div>
<div class="oddline"> GetWindowLong(GWnd, GWL_STYLE) <b>and</b> <b>not</b> WS_SYSMENU);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// コンソールのタイトルをアプリケーションのパスにする</span></div>
<div class="evenline"> SetConsoleTitle(PWideChar(ParamStr(<span class="number">0</span>)));</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// 初期化</span></div>
<div class="evenline"><b>initialization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// イベントハンドラ管理用リストの生成</span></div>
<div class="oddline"> GListeners := TList<TConsoleEvent>.Create;</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// アプリケーションにコンソールを割り当てる</span></div>
<div class="evenline"> AllocConsole;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// コンソールイベントのハンドラを設定する</span></div>
<div class="oddline"> SetConsoleCtrlHandler(@HandlerRoutine, True);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// コンソールの初期設定</span></div>
<div class="evenline"> InitConsole;</div>
<div class="oddline"><b>end</b>;</div>
<div class="evenline"> </div>
<div class="oddline"><span class="comment">// 終了処理</span></div>
<div class="evenline"><b>finalization</b></div>
<div class="oddline"><b>begin</b></div>
<div class="evenline"> <span class="comment">// コンソールイベントのハンドラを解除</span></div>
<div class="oddline"> SetConsoleCtrlHandler(@HandlerRoutine, False);</div>
<div class="evenline"> </div>
<div class="oddline"> <span class="comment">// 割り当て済みのコンソールを解除</span></div>
<div class="evenline"> FreeConsole;</div>
<div class="oddline"> </div>
<div class="evenline"> <span class="comment">// イベントハンドラ管理用リストの破棄</span></div>
<div class="oddline"> GListeners.Free;</div>
<div class="evenline"><b>end</b>;</div>
<div class="oddline"> </div>
<div class="evenline"><b>end</b>.</div>
</pre>
<br />
実行すると、こんな風になります。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjpQYKiG_iXH8Va4VZxmo6pXzXzvD7Lf9_NNfmwQEjSd7oyvzYaTi_nLjajh4y0vMAEn6TaZC9KMfo4gfUy5X1vBQW9-VJwzAPsddPJh7l69VZjI4VLLhwzIwJ5dUQwaaAf6svrPGy3xuRz/s1600/c3.png"><img border="0" height="147" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjpQYKiG_iXH8Va4VZxmo6pXzXzvD7Lf9_NNfmwQEjSd7oyvzYaTi_nLjajh4y0vMAEn6TaZC9KMfo4gfUy5X1vBQW9-VJwzAPsddPJh7l69VZjI4VLLhwzIwJ5dUQwaaAf6svrPGy3xuRz/s320/c3.png" /></a>
<br />
Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0tag:blogger.com,1999:blog-5767280911867023345.post-18483765004343656392012-12-21T00:00:00.000+09:002012-12-21T00:00:04.637+09:00コンソールアプリケーション3(Delphi Advent Calendar 2012-12-21)<div style="text-align: right;">
<a href="https://github.com/freeonterminate/delphi/tree/master/ChangeStdIO">ソースはこちら(GitHub)</a></div>
<br />
<a href="http://atnd.org/events/34390">Delphi Advent Calendar 2012</a> 12/21 の記事です。<br />
<br />
前回、コンソールアプリケーションで Read/Write について述べました。<br />
今回は、Read/Write の標準入出力先を変更してみます。<br />
Read/Write にはファイル変数を指定することで、ファイルに値を出力したり、値をファイルから読み出したりできます。<br />
しかし、それはあくまで入出力先を変数として与えただけで、標準入出力先が変わった訳ではありません。<br />
それでは、標準入出力先を変更するにはどうすれば良いのでしょうか?<br />
<br />
<a href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms686331(v=vs.85).aspx">StartUpInfo</a> に、その鍵があります。<br />
<br />
StartUpInfo とは、CreateProcess でプロセスを生成するときに渡すパラメータの1つです。<br />
StartUpInfo は構造体ですが、ここに次の重要なパラメータがあります。<br />
<br />
<table class="tb1">
<tr><td>hStdInput</td><td>標準入力のハンドル</td></tr>
<tr><td>hStdOutput</td><td>標準出力のハンドル</td></tr>
<tr><td>hStdError</td><td>標準エラー出力のハンドル</td></tr>
</table>
<br />
このパラメータの説明にあるとおり、ここにハンドルを指定することで、標準入出力先を変更できるのです!
<br />
ちなみに、UNIX では、標準入力のハンドルは 0, 標準出力のハンドルは 1 と、決まった値になっています。
<br />
Windows の場合は、ハンドルは決まっていません。<br />
その代わり <a href="http://msdn.microsoft.com/ja-jp/library/cc429347.aspx">GetStdHandle</a> という API を使って標準入出力のハンドルを取得できます。<br />
<br />
それはそうと、実際に標準入出力先を変更してみます。<br />
ハンドルに指定できるのは CreateFile などで返されるハンドルです。<br />
つまり、ファイルハンドルを指定すれば、ファイルに出力されます。<br />
<br />
今回はパイプを使おうと思います。<br />
<br />
パイプを作るには <a href="http://msdn.microsoft.com/ja-jp/library/cc429801.aspx">CreatePipe</a> という関数を使います。<br />
パイプは WriteHandle に対して書き込まれた値を ReadHandle で読み出すことができる通信路です。<br />
<br />
とりあえず、今回のソースを全文記載します。<br />
<br />
<pre style="font-family: monospace; background: #000000; border: 1px solid gray; padding: 5px 10px 5px 10px; color: #ffffff;">
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>001</span> <b>program</b> Project1;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>002</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>003</span> <span style="color: #008080;">{$APPTYPE CONSOLE}</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>004</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>005</span> <b>uses</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>006</span>  System.SysUtils, <b>Winapi</b>.Windows;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>007</span>  </div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>008</span> <b>function</b> Exec(<b>const</b> iCommand, iParam: <b>String</b>): <b>String</b>;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>009</span> <b>var</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>010</span>  ReadHandle, WriteHandle: THandle;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>011</span>  SA: TSecurityAttributes;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>012</span>  SI: TStartUpInfo;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>013</span>  PI: TProcessInformation;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>014</span>  Buffer: RawByteString;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>015</span>  Len: Cardinal;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>016</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>017</span>  <span style="color: #008080;">// パイプから値を読み出す</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>018</span>  <b>procedure</b> ReadResult;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>019</span>  <b>var</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>020</span>  Count: DWORD;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>021</span>  ReadableByte: DWORD;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>022</span>  Data: RawByteString;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>023</span>  <b>begin</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>024</span>  <span style="color: #008080;">// 読み出しバッファをクリア</span></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>025</span>  ZeroMemory(PRawByteString(Buffer), Len);</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>026</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>027</span>  <span style="color: #008080;">// パイプに読み出せるバイト数がいくつあるのか調べる</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>028</span>  PeekNamedPipe(ReadHandle, PRawByteString(Buffer), Len, <b>nil</b>, <b>nil</b>, <b>nil</b>);</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>029</span>  ReadableByte := Length(Trim(<b>String</b>(Buffer)));</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>030</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>031</span>  <span style="color: #008080;">// 読み込める文字列があるなら</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>032</span>  <b>if</b> (ReadableByte > <span style="color: lime;">0</span>) <b>then</b> <b>begin</b></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>033</span>  <b>while</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>034</span>  (ReadFile(ReadHandle, PRawByteString(Buffer)^, Len, Count, <b>nil</b>))</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>035</span>  <b>do</b> <b>begin</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>036</span>  Data := Data + RawByteString(Copy(Buffer, <span style="color: lime;">1</span>, Count));</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>037</span>  </div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>038</span>  <b>if</b> (Count >= ReadableByte) <b>then</b></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>039</span>  Break;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>040</span>  <b>end</b>;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>041</span>  </div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>042</span>  Result := Result + Data;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>043</span>  <b>end</b>;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>044</span>  <b>end</b>;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>045</span>  </div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>046</span> <b>begin</b></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>047</span>  Result := <span style="color: yellow;">''</span>;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>048</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>049</span>  ZeroMemory(@SA, SizeOf(SA));</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>050</span>  SA.nLength := SizeOf(SA);</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>051</span>  SA.bInheritHandle := True;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>052</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>053</span>  <span style="color: #008080;">// パイプを作る</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>054</span>  CreatePipe(ReadHandle, WriteHandle, @SA, <span style="color: lime;">0</span>);</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>055</span>  <b>try</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>056</span>  <span style="color: #008080;">// StartInfo を初期化</span></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>057</span>  ZeroMemory(@SI, SizeOf(SI));</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>058</span>  <b>with</b> SI <b>do</b> <b>begin</b></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>059</span>  cb := SizeOf(SI);</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>060</span>  dwFlags := STARTF_USESTDHANDLES; <span style="color: #008080;">// 標準入出力ハンドルを使います!宣言</span></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>061</span>  hStdOutput := WriteHandle; <span style="color: #008080;">// 標準出力を出力パイプに変更</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>062</span>  hStdError := WriteHandle; <span style="color: #008080;">// 標準エラー出力を出力パイプに変更</span></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>063</span>  <b>end</b>;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>064</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>065</span>  <span style="color: #008080;">// プロセスを作成</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>066</span>  <b>if</b> (<b>not</b> CreateProcess(</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>067</span>  PChar(iCommand),</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>068</span>  PChar(iParam),</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>069</span>  <b>nil</b>,</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>070</span>  <b>nil</b>,</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>071</span>  True,</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>072</span>  <span style="color: lime;">0</span>,</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>073</span>  <b>nil</b>,</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>074</span>  <b>nil</b>,</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>075</span>  SI,</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>076</span>  PI))</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>077</span>  <b>then</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>078</span>  Exit;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>079</span>  </div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>080</span>  <span style="color: #008080;">// 読み出しバッファを 4096[byte] 確保</span></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>081</span>  SetLength(Buffer, <span style="color: lime;">4096</span>);</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>082</span>  Len := Length(Buffer);</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>083</span>  </div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>084</span>  <b>with</b> PI <b>do</b> <b>begin</b></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>085</span>  <span style="color: #008080;">// プロセスが終了するまで、パイプを読み出す</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>086</span>  <b>while</b> (WaitForSingleObject(hProcess, <span style="color: lime;">100</span>) = WAIT_TIMEOUT) <b>do</b></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>087</span>  ReadResult;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>088</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>089</span>  ReadResult;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>090</span>  </div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>091</span>  <span style="color: #008080;">// プロセスを閉じる</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>092</span>  CloseHandle(hProcess);</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>093</span>  CloseHandle(hThread);</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>094</span>  <b>end</b>;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>095</span>  <b>finally</b></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>096</span>  <span style="color: #008080;">// パイプを閉じる</span></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>097</span>  CloseHandle(WriteHandle);</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>098</span>  CloseHandle(ReadHandle);</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>099</span>  <b>end</b>;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>100</span> <b>end</b>;</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>101</span>  </div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>102</span> <b>begin</b></div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>103</span>  <span style="color: #008080;">// dir の結果を出力</span></div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>104</span>  Writeln(Exec(<span style="color: yellow;">'C:\Windows\System32\CMD.exe'</span>, <span style="color: yellow;">'/C dir'</span>));</div>
<div style="background: #000000; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>105</span>  Readln;</div>
<div style="background: #101010; width: 100%; display: inline-block; _display: inline;"><span style="color: #999999; background: #202020; padding: 0px 4px 0px 4px;";>106</span> <b>end</b>.</div>
</pre>
<br />
このソースコードでは、コマンドラインで dir を呼んだ結果を表示します。<br />
結果は、こんな風になります。<br />
<br />
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhdciZ74Vix96DxLgzOn2Nn2LZAavrOdudHKHTFNAoYZCf7YmqCtmAlgO1wCM0_Uml1H_De7i_R8jZnyUfrOc6FXE941orp7bNJowfQGyEYnAbm0TZkFE277k3yNKnGl3hFykMfUew2EuxP/s1600/Clipboard01.png"><img border="0" height="233" width="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhdciZ74Vix96DxLgzOn2Nn2LZAavrOdudHKHTFNAoYZCf7YmqCtmAlgO1wCM0_Uml1H_De7i_R8jZnyUfrOc6FXE941orp7bNJowfQGyEYnAbm0TZkFE277k3yNKnGl3hFykMfUew2EuxP/s320/Clipboard01.png" /></a><br />
<br />
重要なのは 60~62 行の StartUpInfo の初期化部です。<br />
前に記載したとおり hStdOutput, hStdError にパイプの書き込みハンドルを入れています。<br />
この hStdOutput と hStdError を有効にするためにフラグに STARTF_USESTDHANDLES を代入しています。<br />
この値を設定しないと標準入出力ハンドルは使用されません。<br />
<br />
そして、起動されたコンソールアプリケーションは、設定された書き込み用パイプハンドル(WriteHandle)に値を書き込みます。<br />
値は読み込み用パイプハンドル(ReadHandle)からから読み出すことができます(34行目)。<br />
<br />
このようにちょっと手間ですが、標準入出力の値を変更することができました。<br />
<br />
次回は、これらの API を使ってコンソールをデバッグ用出力として使う方法を紹介したいと思います。
<br />Anonymoushttp://www.blogger.com/profile/05033739711111463591noreply@blogger.com0