全力わはー RSSフィード

2016-12-09

プラグインのまほう

00:23 | プラグインのまほうを含むブックマーク

これはDelphi Advent Calendar 2016の9日目の記事です。前日は@luxideaさんのシェーダでプロジェクションマッピングする。でした。3D関連は不得意なので物凄く勉強になります!

概要

IDEのプラグインを作ろう!と思っても、ただでさえ少ないDelphi情報のさらにニッチな分野なので、検索してもなかなか辿り着けないですよね。そこで実際に必要な情報を自力で調べながらプラグインを作っていこうという試みです。なお、ググれば解決する内容も含まれていますが、今回はなるべく頼らない方向で進めます。当然ながら実際に作る際は時間の無駄なのでさっさとググった方が良いです。また、今回のプラグイン作成はDelphi 10.1 Berlin上で行っています。

パッケージ

DelphiのIDEはその名(Integrated Development Environment=統合開発環境)の通り、様々な機能が実装されています。そのためバイナリも大きくなりがちで、ひとつのEXEファイルに機能を集約せずにパッケージライブラリ(BPL)というファイルに機能を分散しています。BPLファイルはパッケージファイル(PKG)をコンパイルしたもので、中身としてはDLLと同等ですが、Delphiに特化した構造になっています。これもプラグインの一種で、DelphiのIDEは多数のプラグインによって成立しているアプリケーションとも言えます。

Open Tools API

DelphiのIDEには、自身を拡張するためのOpen Tools APIと呼ばれる仕組みがあります。これをパッケージの中で駆使することでプラグインとなり、IDEにあんな機能やこんな機能を付加できるわけですが、如何せん情報がありません。ヘルプにすら載っていないこともあり、Googleでとあるインターフェース名をキーワードに検索したら、0件という絶望的な結果を返してくるなんてこともわりとあります。

Open Tools APIを扱う上で最低限知っておく知識は、source\ToolsAPIフォルダの中に関連ユニットがあること、BorlandIDEServicesという変数をIxxxxxServicesといった名前を持つインターフェースにキャストすることで様々な機能にアクセスすること、の2点です。公式ヘルプや情報サイト、あるいは各APIのコメントなどといった情報もあるにはありますが、最終的にはトライアンドエラーで挙動を確認しながら作ることになります。

ちなみに

公式的にはTools APIがAPI全体の名称で、IOTAxxxx系がOpen Tools API、INTAxxxx系がNative Tools APIと言うらしいですが、ほとんどの人がAPI全体を指してOpen Tools APIと呼んでいるようです。

プラグインを作ってみる

どんな機能を持つプラグインを作るかによって必要な情報も変わりますが、今回は例として「アプリを起動できるランチャー機能を持ったツールバー(以下LaunchBar)」を作る過程で、その作り方を一緒に調べていきたいと思います。任意に登録できた方が便利そうですが、そこまで解説してしまうと長さがとんでもないことになりそうなので、今回は「OS付属の電卓とペイント」を起動することとします*1

ちなみに

こういったIDEの拡張機能は、古くはエキスパートと呼ばれていましたが、現在では公式ヘルプにもその呼称は無く、今は単にIDE拡張だとかプラグインのように呼ぶことの方が多いようです。

ツールバーを追加する方法を調べる

LaunchBarの機能を満たすには、まずツールバーをIDEに登録する方法を知る必要があります。問題はどこでその方法を知るか。

Open Tools APIは複数のユニットから構成されていますが、その中でも中心となる「ToolsAPI」というユニットがあります。この中にツールバーに関するAPIがないか、まずはテキストエディタなどで「ToolBar」のような単語で検索してみます。

いくつか見ていると、INTAServices40.ToolBar[const ToolBarName: string]というプロパティが見つかりました。これはIDE内のツールバーにアクセスするために使えそうなので覚えておきます。

さらに検索していくと、INTAServices90.NewToolbarというメソッドがあります。その上に書いてあるコメントに「NewToolBar creates a new toolbar with the given name and caption」とありますし、ツールバーを作るメソッドはこれで間違いなさそうです。すぐ下にはAddToolButtonというメソッドも見えます。これも後々使いそうなので覚えておきます。

それでは早速追加するコードを書いてみます。

ツールバーを追加してみる

f:id:tales:20161203171125p:image:w360

まずはIDEで新規パッケージを作成します。プラグインはDLLで作る方法もありますが、パッケージで作った方がインストールなどもIDE上から行えるため楽です*2。パッケージを作成したら、次に新規ユニットを追加します。この中に処理を書くことでプラグインを実装していくことになります。

パッケージの処理を書く上で最低限必要なのはRegister手続きです。これはパッケージ独特のルールで、この手続きを書いておくとパッケージのロード時に自動的に呼ばれます。そのため、ここに初期化処理などを書くことになります。反対に終了時処理は特にルールはないため、適当にUnregisterのような名前で手続きを作り、finalization節に書いておきます。

また、パッケージでライブラリ内のユニットを使用する場合、コンパイル済みパッケージ(DCPファイル)への参照が必要です*3。普通はプロジェクトマネージャのRequires上で右クリックして「参照の追加」を選び、ファイル選択ダイアログからDCPファイルを選んで…とやるんですが、僕の場合は面倒なのでパッケージのソースに直書きします。ぶっちゃけその方が手っ取り早いです。こんな感じで。

f:id:tales:20161203172954p:image

今回はツールバーの追加ということでVcl.ComCtrls.TToolBarも使うことになるので、一緒にvclも追加しておいてください。

基本的な部分を書き終えところで、この中にNewToolbarメソッドを使ったツールバーの追加処理を追加していきます。

unit ULaunchBar;

interface

uses
  Vcl.ComCtrls, ToolsAPI;

procedure Register; // interface部で宣言しておかないとコールされない

implementation

var
  FLaunchBar: TToolBar;

procedure Register;
begin
  FLaunchBar := (BorlandIDEServices as INTAServices).NewToolbar('LaunchToolBar', 'LaunchBar');
end;

procedure Unregister;
begin
  FLaunchBar.Free;
end;

initialization
finalization
  Unregister;
end.

INTAServices90.NewToolbarを使うのに、どうしてINTAServicesなの?というところを解説しておくと、Open Tools API内に含まれるインターフェースはIDEのバージョンアップに伴って機能が追加されています。元々INTAServicesという名前は別のインターフェース(=初代INTAServices)が使用していた名称でしたが、バージョンアップで機能が追加されたことでINTAServices40と名前を変え、INTAServices40を継承したインターフェースを新たにINTAServicesという名前にすることで、どのバージョンでコンパイルしてもエラーが起きないようになっているわけです。

コードが書けたらインストールして動作確認をしたいところですが、その前にプロジェクトオプションで「説明」の設定と「用途に関するオプション」を「設計時のみ使用可能」にしておきます。説明はパッケージの一覧で表示されるため、プラグイン名などを入れておくと分かりやすいですが、ここにはひとつ罠があり、スペースを含む文字列を書かないと表示されず、BPLファイルのフルパス表示になってしまいます。バグなのか仕様なのかは分かりませんが、これを回避するには「LaunchBar - Application Launcher」みたいな複数のワードで構成される説明にするか、あるいは単純に末尾にスペースを追加すればOKです。

f:id:tales:20161203172151p:image:w640

以上の設定ができたらいよいよインストールしてみます。

f:id:tales:20161203172405p:image

そのままではよく分かりませんが、ツールバーの上で右クリックすると、LaunchBarが追加されていることが分かります。これにチェックを入れれば空のツールバーが表示されるはずです。これでプラグイン開発の第一歩が踏み出せました。

f:id:tales:20161203175418p:image

アンインストールの罠

ところがインストールに成功したくらいでは喜んでいられません。すぐにアンインストールしましょう。そしてツールバー上で右クリックして正しく消えているか確認すると…。

f:id:tales:20161203183054p:image

どうやら削除処理がうまくいっていないようです。こういう場合はコードを修正する前にひとまずIDEを再起動します。内部状態がおかしくなっているため、そのまま継続するとさらなるエラーを引き起こす可能性があるからです。

さて、ToolsAPIを見る限りでは追加したツールバーを削除するようなメソッドは無く、Freeで解放する以外に方法が無さそうなことから、IDE側に問題がある可能性もあります。これが本当にIDEのバグなのか、あるいはやはり正式な削除手順に則っていないために起きたこちらのバグなのかは分かりませんが、ツールバーを追加するプラグインを2つほど試してみたところ、片方はそもそもツールバーを削除しない(当然アンロードされたプラグインのツールバーボタンを押すとエラー)、もう片方は同様にエラーが起きたので、バグの可能性が高そうです。

まさか解説記事のためのサンプルを作る過程でバグに遭遇するとは思わなかったため、このバグについては今回は目を瞑りたいと思います…で終わってはつまらないですよね。ちょっと当初の予定とは異なりますが、バグを潰してみようと思います。

エラーはどこで起きているか

バグを直すためには、まずはエラーがどこで起きているかを特定する必要があります。幸いにも先ほどのエラーダイアログは続きがあり、詳細を開くとスタックトレースを見ることができます。スタックトレースというのは簡単に言えば関数やメソッドが呼び出された履歴のようなもので、一番下がプログラムの起点となる処理(ここではApplication.Run)、一番上がエラーが起きた箇所になります。

ではエラーが起きた箇所がバグのある箇所かというとそうでもありません。例えばTStringListを引数に取るメソッドがあるとして、これにすでにFreeしてしまった変数を渡した場合、エラーはメソッドの中で起きますがバグはFreeをしてしまった側の方ですよね。

f:id:tales:20161209015546p:image

これを踏まえてスタックトレースを眺めていくと、TAppBuilder.ToolbarsPopupPopupやTAppBuilder.BuildToolbarsMenuというメソッドを呼び出している箇所が目につきます。名前からしてツールバーで右クリックした時に出るメニューを動的に作っているようです。このことから、NewToolbarで追加されたツールバーは恐らくTAppBuilderが持つ何らかのリストに追加され、Freeではこのリストからの削除が行われないため、動的にメニューを作成する際にすでに解放されたツールバーを参照することで起きているのではないか?と予想します。

バグをどう見つけ、どう直すか

もし予想が正しいとすれば、ツールバーが保持されているリストの中から、自分で作成したツールバーを取り除くことで解決しそうです。問題はソースコードがないのにどうやってそれを知るか。勘のいい方はお気付きかと思いますが、そこで活躍するのがRTTI(実行時型情報)です。

型情報は従来可視性がpublishedの物のみに生成されていましたが、Delphi 2010で拡張されたRTTIにより可視性がprivateの変数などについても情報を得られるようになりました。これを使用してTAppBuilderクラスにツールバーのリストのようなものが存在しないか確認するわけです。

型の名前から型情報を取得するにはTRttiContext.FindTypeを使用しますが、これに渡すクラス名は完全修飾名である必要があります。完全修飾名とはユニットスコープが付いた状態の名称で、例えばTStringListであればSystem.Classes.TStringListになります。ではTAppBuilderはどうなのかというと、先ほどのスタックトレースを見るとAppMain.TAppBuilderとなっているので、AppMainがユニットスコープのようです。

ここまで分かれば、あとはプラグインのソースを以下のように情報列挙のために一時的に書き換えます。ちなみにプラグインの開発では従来のアプリ開発と同じようにデバッグ実行して動作を調べることもしますが、個人的にはOutputDebugString関数を使った、いわゆるprintfデバッグをよく行います。理由は単純で、デバッグ実行するたびにIDEを起動しないといけないため、ちょっとした確認のために時間がかかるのは面倒なんですよね…(しかもデバッグ実行なので普段より起動が遅い)。Open Tools APIを使うとIDEのログウィンドウにメッセージを表示することも可能ですが、プラグインの開発では時にIDEがフリーズしてしまうこともあり、その場合メッセージが確認できなくなってしまうため、OutputDebugStringで出力した方がより確実です。

OutputDebugStringで出力した文字列はDebugViewのような外部ツールで閲覧できます。ここではDebugViewを使用します。

unit ULaunchBar;

interface

uses
  Winapi.Windows, System.Rtti, Vcl.ComCtrls, ToolsAPI;

procedure Register;

implementation

procedure Register;
var
  ctx: TRttiContext;
  typ: TRttiType;
  fld: TRttiField;
begin
  typ := ctx.FindType('AppMain.TAppBuilder');
  if typ = nil then Exit;
  for fld in typ.GetDeclaredFields do
    OutputDebugString(PChar(fld.ToString));
end;

procedure Unregister;
begin
end;

initialization
finalization
  Unregister;
end.

このプラグインをインストール(そして不要なのですぐアンインストール)すると、DebugViewにたくさんのフィールド情報が出力されたと思います。このままではよく分からないので、全体を選択してCtrl+Cでコピーして適当なエディタに貼り付け、「ToolBar」で検索してみましょう。するといくつか引っかかりますが、その中でも「FToolbars: TToolbarArray」というのが名前からしてもとても怪しいです。

Integerやstringといった型であれば、fld.GetValue().ToStringとすることで中身が分かりますが、TToolbarArrayという独自の型を使っているので、中身を知るためにはまず構造を知る必要があります。そこでTRttiField.FieldType.TypeKindを出力してみるとtkArrayが得られるので、この型が配列であることは間違いないようです。

ところで、FieldTypeの型であるTRttiTypeは実は抽象クラスで、実際のクラスはその継承クラスなので、そちらにキャストした方がより情報が得られます。FToolbarsのTRttiField.FieldType.ClassNameを出力してみると、実際にはTRttiDynamicArrayTypeであることが分かります。そしてTRttiDynamicArrayTypeは配列要素の型を示すElementTypeというプロパティがあるので、TRttiDynamicArrayType(fld.FieldType).ElementType.Nameを表示させてみると「TWinControl」と表示されました。つまりTToolbarArrayは以下のような定義だということです。

type
  TToolbarArray = array of TWinControl;

型が分かったところで、実際にこの中身を確認してみたいと思います。そのためにはTRttiField.GetValueに渡すためのインスタンスが必要ですが、TAppBuilderは通常ひとつしかインスタンスがありません。普段僕らが見ているIDEそのもの、つまりTAppBuilderはIDEのメインフォームです。メインフォームは通常のDelphiアプリと同じようにApplication.MainFormで取得できます。

これらを踏まえてプラグインのインストール後、アンインストール後にそれぞれFToolbarsの中身を出力するコードを記述し、インストールしてみます。

unit ULaunchBar;

interface

uses
  Winapi.Windows, System.Rtti, Vcl.Controls, Vcl.Forms, Vcl.ComCtrls, ToolsAPI;

procedure Register;

implementation

type
  TToolbarArray = array of TWinControl;

var
  FLaunchBar: TToolBar;

procedure OutputToolbars(const S: string);
var
  ctx: TRttiContext;
  typ: TRttiType;
  fld: TRttiField;
  toolbars: TToolbarArray;
  i: Integer;
begin
  OutputDebugString(PChar(S));

  typ := ctx.FindType('AppMain.TAppBuilder');
  if typ = nil then Exit;
  fld := typ.GetField('FToolbars');
  if fld = nil then Exit;

  fld.GetValue(Application.MainForm).ExtractRawData(@toolbars);
  for i := Low(toolbars) to High(toolbars) do
    OutputDebugString(PChar(toolbars[i].Name + ': ' + toolbars[i].ClassName));
end;

procedure Register;
begin
  FLaunchBar := (BorlandIDEServices as INTAServices).NewToolbar('LaunchToolBar', 'LaunchBar');
  OutputToolbars('[AfterInstall]');
end;

procedure Unregister;
begin
  FLaunchBar.Free;
  OutputToolbars('[AfterUninstall]');
end;

initialization
finalization
  Unregister;
end.

すると…。

f:id:tales:20161203192010p:image

ビンゴです。見事にツールバーの一覧が取得できました。インストール後なのでLaunchBarも追加されています。そして問題はアンインストール時の出力です。

f:id:tales:20161203192345p:image

先ほどLaunchBarがあったところの表示がおかしくなっています。どうやらFreeをしてもこのリスト上では残ってしまっています。そして右クリックメニューの表示処理内でこのリストを参照し、結果エラーが起きているという予想で間違いなさそうです。

ちなみに「Freeだけしてリストからの削除処理をしていないから残るのは当然では?」という疑問を誰もが持つと思いますが、Delphiにはコンポーネントの追加・削除の通知を行うNotificationというメソッドがあり、独自にコンポーネントを所有する場合は、どこかでFreeがあればNotificationでそれを検知し、リストからの削除など適切な処理を行うのが普通です。全然関係ないですが、この文を記述しているまさに今、IDEがライセンスエラーで落ちました。勘弁してください…。

さて、原因が分かれば、あとは削除時にFreeするだけではなく、FToolbarsからも削除すればエラーは起きなくなるはずです。普通に考えればTRttiField.GetValueで取得したTToolbarArrayの実体から項目を削除し、再びTRttiField.SetValueで書き戻せば済みそうですが、ここでまた別の問題としてTValueの読み書きは単純な型じゃないとキャストエラーを起こすという何とも悩ましい仕様(というかバグというか…)がありまして、そのあたりを考慮したちょっとだけ低レベルなコードが必要です。ここまで解説し出すと長くなりそうなので、ソースコードから何となく汲み取ってください。

unit ULaunchBar;

interface

uses
  Winapi.Windows, System.Rtti, Vcl.Controls, Vcl.Forms, Vcl.ComCtrls, ToolsAPI;

procedure Register;

implementation

type
  TToolbarArray = array of TWinControl;
  PToolbarArray = ^TToolbarArray;

var
  FLaunchBar: TToolBar;

procedure Register;
begin
  FLaunchBar := (BorlandIDEServices as INTAServices).NewToolbar('LaunchToolBar', 'LaunchBar');
end;

procedure Unregister;

  procedure RemoveFromToolbars(AToolBar: TToolBar);
  var
    ctx: TRttiContext;
    typ: TRttiType;
    fld: TRttiField;
    toolbars: TToolbarArray;
    i: Integer;
  begin
    typ := ctx.FindType('AppMain.TAppBuilder');
    if typ = nil then Exit;
    fld := typ.GetField('FToolbars');
    if fld = nil then Exit;

    fld.GetValue(Application.MainForm).ExtractRawData(@toolbars);
    for i := Low(toolbars) to High(toolbars) do
    begin
      if toolbars[i] = AToolBar then
      begin
        Delete(toolbars, i, 1);
        Break;
      end;
    end;

    TValue.From(toolbars).ExtractRawData(PByte(Application.MainForm) + fld.Offset);
  end;

begin
  RemoveFromToolbars(FLaunchBar);
  FLaunchBar.Free;
end;

initialization
finalization
  Unregister;
end.

これで何回インストール/アンインストールを繰り返してもエラーが出ないようになりました。まだボタンすら追加していないというのに疲労感がものすごいですが、プラグインの作成では往々にしてこのような問題に遭遇します。こういったバグの回避方法もプラグイン作成にとっては欠かせない技術です。

起動時・終了時のチェック

今までのインストール/アンインストールはIDE上から手動で行ってきました。しかしこれはIDEが完全に起動しきった状態で行うものなので、実際に使用する際のロードタイミングとは異なります。本来であればIDEの起動処理中にインストールされ、終了処理中にアンインストールされるからです。そこで、インストールした状態で一度IDEを終了し、再度起動/終了を行うことでエラーなどが発生しないかチェックしてみます。

すると案の定エラーが出ましたが、手動インストールでは問題が無かったことを考えると、今回はこちらの追加したコード内で起こっている可能性が高いため、実際にデバッグ実行してエラー箇所を見た方が手っ取り早そうです。ということで以下のように実行時引数を設定してIDEをデバッグ実行してみます。プラグインは単体で起動できないため、それをロードする側のIDEをデバッグ実行するわけです。恐らく途中で例外が出ますが、これは無視して継続してください。

f:id:tales:20161203211950p:image

すると、FLaunchBar.Freeで例外が起きていることが分かりました。Freeで例外が起きる原因のひとつとして、インスタンスがすでに解放されてしまっているというものがあります。IDEは起動時にデフォルトのツールバーを作成した後、表示状態やツールバーが含むボタンなどをレジストリから読み取って再構築しているはずで、ここで自分が追加したツールバーも一度解放された後、再作成されてしまっている可能性があります。ここで冒頭のINTAServices40.ToolBarプロパティを思い出してください。これを使えば「現在の」ツールバーにアクセスできそうです。そこで以下のようなコードで終了時のインスタンスのアドレスを取ってみると…。

  OutputDebugString(PChar(Format('自分で作ったツールバー: %p', [Pointer(FLaunchBar)])));
  OutputDebugString(PChar(Format('ToolBarプロパティで取得したツールバー: %p', [Pointer((BorlandIDEServices as INTAServices).ToolBar['LaunchToolBar'])])));
自分で作ったツールバー: 05AEEC60
ToolBarプロパティで取得したツールバー: 05AEE120

アドレスが違うということは、やはり異なるインスタンスとなっているようです。となるとNewToolbarで作ったインスタンスを自分で保持しておくのはまずそうです。

とはいえ、ここでの解決方法は簡単です。ToolBarプロパティで現在のインスタンスが取れるのであれば、それを解放するコードに書き換えればいいだけです。というわけでツールバーの追加/削除の完全なコードは以下のようになります。

unit ULaunchBar;

interface

uses
  Winapi.Windows, System.Rtti, Vcl.Controls, Vcl.Forms, Vcl.ComCtrls, ToolsAPI;

procedure Register;

implementation

type
  TToolbarArray = array of TWinControl;

procedure Register;
begin
  (BorlandIDEServices as INTAServices).NewToolbar('LaunchToolBar', 'LaunchBar');
end;

procedure Unregister;

  procedure RemoveFromToolbars(AToolBar: TToolBar);
  var
    ctx: TRttiContext;
    typ: TRttiType;
    fld: TRttiField;
    toolbars: TToolbarArray;
    i: Integer;
  begin
    typ := ctx.FindType('AppMain.TAppBuilder');
    if typ = nil then Exit;
    fld := typ.GetField('FToolbars');
    if fld = nil then Exit;

    fld.GetValue(Application.MainForm).ExtractRawData(@toolbars);
    for i := Low(toolbars) to High(toolbars) do
    begin
      if toolbars[i] = AToolBar then
      begin
        Delete(toolbars, i, 1);
        Break;
      end;
    end;

    TValue.From(toolbars).ExtractRawData(PByte(Application.MainForm) + fld.Offset);
  end;

var
  toolbar: TToolBar;
begin
  toolbar := (BorlandIDEServices as INTAServices).ToolBar['LaunchToolBar'];
  RemoveFromToolbars(toolbar);
  toolbar.Free;
end;

initialization
finalization
  Unregister;
end.

ボタンの追加

あまりにも迂回が長すぎて本来の目的を忘れそうになっていましたが、今作っているのはLaunchBarです。アプリを起動できるようにするには、ボタンを追加しなければなりません。そのためにはボタンの追加方法を知る必要があります。

と言っても、ボタンの追加らしきメソッドについてはすでに分かっています。ツールバーを追加するために使ったNewToolbarメソッドのすぐ下にAddToolButtonというメソッドが定義されていましたよね。なのでツールバーの追加処理の下にこのようなコードを追加してボタンが追加されるか試してみます。

  // function AddToolButton(const ToolBarName, ButtonName: string;
  //   AAction: TCustomAction; const IsDivider: Boolean = False;
  //   const ReferenceButton: string = ''; InsertBefore: Boolean = False): TControl;
  (BorlandIDEServices as INTAServices).AddToolButton('LaunchToolBar', 'LaunchBarButton', nil, True);

4つ目の引数であるIsDividerにTrueを指定したので区切り線としてですが、ツールバー上にボタンが追加できました。メソッドはこれで合っていたようです。

また、AddToolButtonの戻り値の型はTControlと抽象的なのが気になり、ClassNameを出力させてみたところTToolButtonでした。さらに引数を変えながら調べていくと、どうもIsDividerがTrueの時はTToolButton、Falseの時はTSpeedButtonを返すようです。しかも何故か区切り線のような画像を指定したTSpeedButtonが生成されます。ツールバーに続いてボタンも雲行きが怪しくなってきました…。

こういう時は他がどうなっているか確認するのが手っ取り早いので、TAppBuilder.FToolbarsの中身を列挙して既存のツールバーを取得し、Controlsプロパティで子コントロールを列挙してやります。するとどうやら全てTToolButtonのようなので、AddToolButtonでIsDividerにTrueを指定してTToolButtonとして生成し、TToolButtonのStyleプロパティで普通の見た目のボタンへと変えてやれば良さそうです。

ところが実行してみると分かりますがこの状態でも問題があり、2つ以上のボタンを追加すると最後のボタンがおかしくなります。色々試してみると、これはStyleをtbsTextButtonにすると発生せず、また、ツールバーをアンドックしてやると直るようです。ここを追求し始めるとキリがないので、今回はRecreateWndを呼ぶことで全体を再作成し解決してみます。RecreateWndはprotectedでそのままでは呼べないので、ボタンを追加した後に同等の処理であるPerform(CM_RECREATEWND, 0, 0)を呼んでやります。これで正常にボタンが表示されるようになりました。

ところでAddToolButtonメソッドのコメントを見ると「Actionを指定しないとツールボタンを削除した場合リセットしない限り元に戻らなくなります」というようなことが書いてあります。ツールバーのボタンはカスタマイズできるので、試しにメニューからカスタマイズを選んでボタンをポイッと捨てたところ、利用可能なコマンドに自作ボタンが表示されていないため、確かに元に戻せなくなりました。ではActionをnilではなくちゃんとTActionを生成して渡せばいいかというとそうでもなく、IsDividerをTrueにした場合は無視されると書いてあります。そこでIsDividerをFalseにし、Actionを指定した状態でボタンを生成、カスタマイズを見ると…コマンド一覧に出てきません。

f:id:tales:20161208230905p:image

この辺りは同じINTAServicesに解決のヒントがありそうなので探してみます。するとINTAServicesはActionListというそのまんまなプロパティを持っているようで、これに登録したActionだけがコマンド一覧に並ぶようです。というわけでボタンを復活可能にし、だんだん記事を書き続けるのが面倒になってきたので残りの機能を全部実装したコードがこちらになります。まあアプリケーションの起動なんかは普通のWindowsアプリ開発の知識なので、あえてここで解説する必要も無いかとは思いますが。

unit ULaunchBar;

interface

uses
  Winapi.Windows, Winapi.ShellAPI, System.SysUtils, System.Classes, System.Rtti,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.ComCtrls, Vcl.ActnList, Vcl.ImgList,
  ToolsAPI;

procedure Register;

implementation

type
  TToolbarArray = array of TWinControl;

  TActionHandler = class
  public
    class procedure OnExecute(Sender: TObject);
  end;

var
  FActions: array of record
    Action: TAction;
    FileName: string;
  end;

class procedure TActionHandler.OnExecute(Sender: TObject);
begin
  if TAction(Sender).Tag < Low(FActions) then Exit;
  if TAction(Sender).Tag > High(FActions) then Exit;
  ShellExecute(0, 'open', PChar(FActions[TAction(Sender).Tag].FileName), nil, nil, SW_SHOWNORMAL);
end;

procedure Register;
var
  ntaServices: INTAServices;
  syspath: string;
  i: Integer;
  toolbar: TToolBar;
  button: TToolButton;

  function GetSystemPath: string;
  var
    path: array[0..MAX_PATH-1] of Char;
  begin
    GetSystemDirectory(path, Length(path));
    Result := IncludeTrailingPathDelimiter(path);
  end;

  procedure AddToolButton(const Name, Caption, FileName: string);
  var
    action: TAction;
    fileInfo: TSHFileInfo;
    ico: TIcon;
  begin
    action := TAction.Create(ntaServices.ActionList);
    try
      action.Name := Name;
      action.Caption := Caption;
      action.Category := 'LaunchBar';
      action.Hint := Caption;
      action.OnExecute := TActionHandler.OnExecute;
      action.Tag := Length(FActions);
      action.ActionList := ntaServices.ActionList;

      fileInfo := Default(TSHFileInfo);
      if SHGetFileInfo(PChar(FileName), 0, fileInfo, SizeOf(fileInfo), SHGFI_ICON or SHGFI_SMALLICON) <> 0 then
      try
        ico := TIcon.Create;
        try
          ico.Handle := fileInfo.hIcon;
          action.ImageIndex := action.Images.AddIcon(ico);
        finally
          ico.Free;
        end;
      finally
        DestroyIcon(fileInfo.hIcon);
      end;

      SetLength(FActions, Length(FActions) + 1);
      FActions[High(FActions)].Action := action;
      FActions[High(FActions)].FileName := FileName;
    except
      action.Free;
    end;
  end;

begin
  ntaServices := BorlandIDEServices as INTAServices;

  syspath := GetSystemPath;
  AddToolButton('actnLaunchBarCalc', '電卓', syspath + 'calc.exe');
  AddToolButton('actnLaunchBarPaint', 'ペイント', syspath + 'mspaint.exe');

  toolbar := ntaServices.NewToolbar('LaunchToolBar', 'LaunchBar');

  for i := Low(FActions) to High(FActions) do
  begin
    button := TToolButton(ntaServices.AddToolButton('LaunchToolBar', 'LaunchBarButton' + (i + 1).ToString, nil, True));
    button.Style := tbsButton;
    button.Action := FActions[i].Action;
  end;

  toolbar.Perform(CM_RECREATEWND, 0, 0);
  toolbar.Show;
end;

procedure Unregister;

  procedure RemoveFromToolbars(AToolBar: TToolBar);
  var
    ctx: TRttiContext;
    typ: TRttiType;
    fld: TRttiField;
    toolbars: TToolbarArray;
    i, j: Integer;
    btn: TToolButton;

    function IsMyAction(Action: TBasicAction): Boolean;
    var
      i: Integer;
    begin
      for i := Low(FActions) to High(FActions) do
        if FActions[i].Action = Action then Exit(True);
      Result := False;
    end;

  begin
    typ := ctx.FindType('AppMain.TAppBuilder');
    if typ = nil then Exit;
    fld := typ.GetField('FToolbars');
    if fld = nil then Exit;
    fld.GetValue(Application.MainForm).ExtractRawData(@toolbars);

    // ボタンの削除
    for i := Low(toolbars) to High(toolbars) do
    begin
      if not (toolbars[i] is TToolBar) then Continue;
      for j := TToolBar(toolbars[i]).ButtonCount-1 downto 0 do
      begin
        if IsMyAction(TToolBar(toolbars[i]).Buttons[j].Action) then
        begin
          btn := TToolBar(toolbars[i]).Buttons[j];
          toolbars[i].Perform(CM_CONTROLCHANGE, WPARAM(btn), LPARAM(False));
          btn.Free;
        end;
      end;
    end;

    // 追加したツールバーの除去
    for i := High(toolbars) downto Low(toolbars) do
      if toolbars[i] = AToolBar then
        Delete(toolbars, i, 1);
    TValue.From(toolbars).ExtractRawData(PByte(Application.MainForm) + fld.Offset);
  end;

var
  toolbar: TToolBar;
  i: Integer;
begin
  toolbar := (BorlandIDEServices as INTAServices).ToolBar['LaunchToolBar'];
  RemoveFromToolbars(toolbar);
  toolbar.Free;
  for i := High(FActions) downto Low(FActions) do
  begin
    if FActions[i].Action.ImageIndex = FActions[i].Action.Images.Count - 1 then
    begin
      FActions[i].Action.Images.Delete(FActions[i].Action.ImageIndex);
    end;
    FActions[i].Action.Free;
  end;
end;

initialization
finalization
  Unregister;
end.

ここからの発展

例えば「現在表示中のユニットを含むフォルダをExplorer.exeで起動するようなボタン」はどうしたら書けるでしょうか。Explorer.exeの起動はすぐにできると思いますが、問題は「現在表示中のユニット」をどう取得するか。

冒頭で述べたようにIDEの様々な機能にはBorlandIDEServicesからアクセスできます。フォルダを取得するにはまずユニットのファイル名が必要なので、「FileName」のような単語でToolsAPIユニットを検索してみるとどのインターフェースを用いればいいか分かってくるかもしれません。

答えを言ってしまうと、「現在表示中のユニット」の取得はOpen Tools APIの中では簡単な方で、次のように書くことができます(もちろんCurrentModuleが常に存在するとは限らないので、本来はnilチェックが必要です)。

  (BorlandIDEServices as IOTAModuleServices).CurrentModule.FileName

最後に

自分の場合は調べることも趣味のひとつなのであまり外部の情報は見ないんですが、実際にプラグインを作ろうとする人がこういった情報の調査から行うのは非効率です。ということで参考になりそうなものをいくつか列挙して締めたいと思います。

一番参考になるのは、オープンソースで開発されているGExpertsCnPackといったプラグインのソースコードだと思います。プログラマとしてはやはり実際に動くコードを見るのが一番手っ取り早く理解できます。また、GExpertsの方にはOpen Tools API FAQという記事があり、プラグインを作る上で参考になる情報がまとめられており非常に有用です。

また、Open Tools APIを解説したサイトやブログはググればそこそこヒットしますが、その中でもDave’s Development Blogは現在進行形で更新されており、最近のバージョンで追加されたようなAPIにも言及があるため、他と比べてより生きた情報を得られる可能性が高いです。もちろん日本語でまとまった情報が得られる公式ヘルプも参考になります。

というわけでDelphi Advent Calendar 2016の9日目でした。明日は@kazinoueさんのビーコンの距離測定精度を上げるためのキャリブレーションを行うアプリをDelphiで作るです。

*1:この文を書いている時点では一行もコードを書いていないので、ツールバーを追加する方法すら分かってない

*2:もちろんDLLにはDLLの利点があるがここでは割愛

*3:例えばToolsAPIユニットであればdesignide、Vcl.StdCtrlsであればvcl

トラックバック - http://d.hatena.ne.jp/tales/20161209/1481210588