package plIDEDialogTest;

{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$IMPLICITBUILD ON}

requires
  rtl,
  designide;  // 追加

end.

%PUBLIC%\DOCUMENTS\RAD Studio
%PUBLIC%\DOCUMENTS\Embarcadero\Studio   // Delphi XE6 以降

unit plIDialogTest;

interface

procedure Register;

implementation

uses
  ToolsAPI,
  Winapi.Windows;

//-----------------------------------------------------------------------------
//  [ヘルプ] に項目を追加するウイザードクラスの定義
//  IOTAMenuWizard は IDEの [ヘルプ] に項目を自動登録してくれるインターフェイス
//  継承元のインターフェイスにあるメソッドは必ず実装が必要
//-----------------------------------------------------------------------------
type
  TIDEDialogTestWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
    function GetIDString: string;
    function GetName: string;
    function GetState: TWizardState;
    function GetMenuText: string;
    procedure Execute;
  end;

//-----------------------------------------------------------------------------
//  IDE がウイザードを識別するためのユニークな名前の設定
//-----------------------------------------------------------------------------
function TIDEDialogTestWizard.GetIDString: string;
begin
  Result := 'TIDEDialogTestWizard.1.0';
end;

//-----------------------------------------------------------------------------
//  ユーザー定義のウイザードの任意の名前の設定
//-----------------------------------------------------------------------------
function TIDEDialogTestWizard.GetName: string;
begin
  Result := 'Delphi TIDE Dialog Test Wizard';
end;

//-----------------------------------------------------------------------------
//  メニュー項目の状態の設定 (有効，無効など)
//-----------------------------------------------------------------------------
function TIDEDialogTestWizard.GetState: TWizardState;
begin
  Result := [wsEnabled];
end;

//-----------------------------------------------------------------------------
//  [ヘルプ] のメニューに追加した項目のキャプション (タイトル)
//-----------------------------------------------------------------------------
function TIDEDialogTestWizard.GetMenuText: string;
begin
  Result := 'ダイアログを表示';
end;

//-----------------------------------------------------------------------------
//  メニュー項目が選択された時に実行されるメソッド
//  uses に Winapi.Windows が必要
//-----------------------------------------------------------------------------
procedure TIDEDialogTestWizard.Execute;
var
  LText : string;
begin
  LText := '[ヘルプ] から表示したダイアログ';
  MessageBox(0, PChar(LText), '情報', MB_ICONINFORMATION);
end;

//-----------------------------------------------------------------------------
//  ウイザードクラスを生成して登録
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterPackageWizard(TIDEDialogTestWizard.Create);
end;

end.

unit plDialogStruct;

interface

procedure Register;

implementation

uses
  ToolsAPI,
  Vcl.Dialogs,
  Vcl.Menus,
  System.AnsiStrings,
  System.SysUtils,
  plDialogStructForm;

 var
   FAddItem : TMenuItem;

//-----------------------------------------------------------------------------
//  [ツール] に項目を追加するウイザードクラスの定義
//  IOTAWizard インターフェイスを使用する
//
//  継承元のインターフェイスにある以下のメソッド類は必ず実装が必要
//  GetIDString, GetNamem, GetState, Execute
//-----------------------------------------------------------------------------
type
  TIDEDialogStructWizard = class(TNotifierObject, IOTAWizard)
    function GetIDString: string;
    function GetName: string;
    function GetState: TWizardState;
    procedure Execute;
    constructor Create;
    destructor Destroy; override;
    procedure OnItemClickEvent(Sender: TObject);
  end;

//-----------------------------------------------------------------------------
//  IDE がウイザードを識別するためのユニークな名前の設定
//-----------------------------------------------------------------------------
function TIDEDialogStructWizard.GetIDString: string;
begin
  Result := 'TIDEDialogStructWizard.1.0';
end;

//-----------------------------------------------------------------------------
//  ユーザー定義のウイザードの任意の名前の設定
//-----------------------------------------------------------------------------
function TIDEDialogStructWizard.GetName: string;
begin
  Result := 'Delphi IDE TIDE Dialog Struct Wizard';
end;

//-----------------------------------------------------------------------------
//  メニュー項目の状態の設定 (有効，無効など)
//-----------------------------------------------------------------------------
function TIDEDialogStructWizard.GetState: TWizardState;
begin
  Result := [wsEnabled];
end;

//-----------------------------------------------------------------------------
//  メニュー項目が選択された時に実行されるメソッド
//  本サンプルでは追加した項目の OnClick イベントで処理するので使用しない
//  使用しなくても継承元の IOTAWizard インターフェイスにあるので実装が必要
//-----------------------------------------------------------------------------
procedure TIDEDialogStructWizard.Execute;
begin
//
end;

//-----------------------------------------------------------------------------
//  クラスのコンストラクタ
//  [ツール] メニューに新規に項目を追加
//
//  uses に以下が必要
//  Vcl.Menus,
//  System.AnsiStrings,
//  System.SysUtils;
//-----------------------------------------------------------------------------
constructor TIDEDialogStructWizard.Create;
var
   LIDESrv   : INTAServices;
   LToolMenu : TMenuItem;
   LIndex    : Integer;
begin
{中略}
  // IDE のオブジェクトを取得
  // INTAServices が IDE の本体
  LIDESrv := BorlandIDEServices as INTAServices;

  LToolMenu := nil;
  // メインメニューの [ツール] を探す
  for LIndex := 0 to LIDESrv.MainMenu.Items.Count - 1 do begin
    if AnsiSameText(LIDESrv.MainMenu.Items[LIndex].Name,'ToolsMenu') then begin
      LToolMenu := LIDESrv.MainMenu.Items[LIndex];
      Break;
    end;
  end;

  // 新しい項目を生成
  FAddItem := TMenuItem.Create(nil);

  // 生成した項目の各種プロパティと OnClick イベントを設定
  FAddItem.Name    := 'plDialogStruct';
  FAddItem.Caption := 'モジュール情報取得';
  FAddItem.OnClick := OnItemClickEvent;
  // [ツール] の 2 番目の項目として追加
  LToolMenu.Insert(1, FAddItem);
end;

//-----------------------------------------------------------------------------
//  生成したクラスのデストラクタ
//  新規に作成したメニュー項目のオブジェクトを破棄
//-----------------------------------------------------------------------------
destructor TIDEDialogStructWizard.Destroy;
begin
  FreeAndNil(FAddItem);
  inherited;
end;

//-----------------------------------------------------------------------------
//  新規に追加したメニュー項目の OnClick イベント処理
//  フォームを表示
//-----------------------------------------------------------------------------
procedure TIDEDialogStructWizard.OnItemClickEvent(Sender: TObject);
begin
  Form1 := TForm1.Create(nil);
  try
    Form1.ShowModal;
  finally
    FreeAndNil(Form1);
  end;
end;

//-----------------------------------------------------------------------------
//  ウイザードクラスを生成して登録
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterPackageWizard(TIDEDialogStructWizard.Create);
end;

end.

unit plDialogStructForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  procedure StructureViewToSL(ASL: TStringList);

var
  Form1: TForm1;

implementation

uses
  ToolsAPI,
  StructureViewAPI;

{$R *.dfm}

{ TForm1 }

//=============================================================================
//  フォームを表示する時のイベント
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LStrList : TStringList;
begin
  Self.Caption := '構造';

  Memo1.Lines.Clear;
  Memo1.ScrollBars := ssBoth;
  Memo1.Font.Size  := 11;
  Memo1.Font.Name  := 'Courier New';

  LStrList := TStringList.Create;
  try
    StructureViewToSL(LStrList);
    Memo1.Lines.Text := LStrList.Text;
  finally
  end;
end;

//-----------------------------------------------------------------------------
//  Delphi の IDE の構造ペインと同じ情報を取得して表示
//  現在アクティブなモジュールの情報
//  結果は [ツール| [オプション] [環境オプション] [エクスプローラ] の設定に依存する
//
//  uses に ToolsAPI, StructureViewAPI が必要
//-----------------------------------------------------------------------------
procedure StructureViewToSL(ASL: TStringList);

  procedure TreeToSL(ANode: IOTAStructureNode; ASL: TStringList; const APrefix: string);
  var
    I: Integer;
  begin
    ASL.Add(APrefix + ANode.Caption);
    for I := 0 to ANode.ChildCount - 1 do begin
      TreeToSL(ANode.Child[I], ASL, APrefix + '  ');
    end;
  end;

var
  StructureView: IOTAStructureView;
  StructureContext: IOTAStructureContext;
  Node: IOTAStructureNode;
  I: Integer;
begin
  StructureView := BorlandIDEServices as IOTAStructureView;
  StructureContext := StructureView.GetStructureContext;
  for I := 0 to StructureContext.RootNodeCount - 1 do
  begin
    Node := StructureContext.GetRootStructureNode(I);
    TreeToSL(Node, ASL, '');
  end;
end;

end.

  // 上のサンプルコード ( as 演算子によるオブジェクトの取得)
  StructureView := BorlandIDEServices as IOTAStructureView;


  // Supports 関数を使用する例 (戻り値は論理値)
  if Supports(BorlandIDEServices, IOTAStructureView, StructureView) then begin
    // StructureView を使用する各種処理 
  end;  

  // QueryInterface メソッドを使用する例 (戻り値は HRESULT 型)
  if BorlandIDEServices.QueryInterface(IOTAStructureView, StructureView) = S_OK then begin
    // StructureView を使用する各種処理
  end; 

type
  TMyClass = class(TObject);

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;