HTML ドキュメントの特定のプロジェクトマネージャーのローカルメニュー項目の動作を変更するにはどうすればよいですか?

https://stackoverflow.com/questions/8379094

28-10-2019
|

質問

現在、プロジェクトページオプション IDE アドイン¹ を再作成中です。特に、このアドインは、デフォルトの動作²を置き換えます。 開ける 独自の動作を持つプロジェクトマネージャーのアクション - ウェルカムページの表示に使用されるのと同じ内部ブラウザで HTML ページを開きます。それで、私も同じことをしたいのですが、現時点ではこのメニューに到達できませんでした。

IOTAProjectManager インターフェースを試してみました。 追加する プロジェクトマネージャーのメニュー項目 3 ですが、それが何であるかを学びました notifiers は互いに分離されているため、おそらくこの API は私の目的には役に立ちません。また、アプリケーション全体のアクション処理にフックしようとしました。おそらくアクションリストがまったく使用されていないため、まったく結果が得られませんでした。

おそらく、上記のような性質があるため、ハッキングに頼る以外に選択肢はなく、ここではハック的な解決策が非常に歓迎されています。それで、何かアイデアはありますか？

¹ 詳細については、を参照してください。このQ.

² 関連する項目が 3 つあります。 開ける, マークアップを表示, ショーデザイナー. 開ける デフォルトは ショーデザイナー アドインなしで。

³ 実際のところ、この API では項目をオンザフライで追加できますが、おそらく状況がさらに複雑になります。

コンテキストメニューの図:

enter image description here

として トンドレイ 以下のコメントで言及されている、の動作 開ける メニュー項目は、対応するダイアログで「プロジェクトページ」として設定された HTML ドキュメントに対してのみ変更されました。

解決

元のプロジェクトページ拡張機能は、IDE Notifier をインストールすることでそれを行っていると思います (「 TProjectPageNotifier 下に）。プロジェクトマネージャーとは関係ないと思います。IDE で開かれているファイルに関する通知をリッスンするだけで、それがプロジェクトページの場合は、デフォルトの HTML デザイナーではなく埋め込みブラウザで開きます。これは、この機能を Delphi 2007 で再現する試みです。

1) パッケージ:

package projpageide;

{$R *.res}
// ... some compiler options snipped for brevity
{$DESCRIPTION '_Project Page Options'}
{$LIBSUFFIX '100'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}

requires
  rtl,
  designide;

contains
  Projectpagecmds in 'Projectpagecmds.pas',
  ProjectPageOptionsDlg in 'ProjectPageOptionsDlg.pas';

end.

2) 「プロジェクト」メニューに追加するアクションとメニュー項目を含むデータモジュール:

unit ProjectPageCmds;

interface

uses
  Windows,SysUtils, Classes, ActnList, Menus, Controls, Forms, Dialogs;

type
  TProjectPageCmds = class(TDataModule)
    ActionList1: TActionList;
    PopupMenu1: TPopupMenu;
    ProjectWelcomeOptions: TAction;
    ProjectWelcomeOptionsItem: TMenuItem;
    procedure ProjectWelcomeOptionsExecute(Sender: TObject);
    procedure ProjectWelcomeOptionsUpdate(Sender: TObject);
  private
  public
  end;

implementation

{$R *.dfm}

uses
  XMLIntf, Variants, ToolsApi,
  ProjectPageOptionsDlg;

type
  IURLModule = interface(IOTAModuleData)
  ['{9D215B02-6073-45DC-B007-1A2DBCE2D693}']
    function GetURL: string;
    procedure SetURL(const URL: string);
    property URL: string read GetURL write SetURL;
  end;
  TOpenNewURLModule = procedure(const URL: string; EditorForm: TCustomForm);

  TProjectPageNotifier = class(TNotifierObject, IOTAIDENotifier)
    procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
    procedure AfterCompile(Succeeded: Boolean); overload;
  end;

const
  sWelcomePageFile = 'WelcomePageFile';
  sWelcomePageFolder = 'WelcomePageFolder';

var
  DataModule: TProjectPageCmds = nil;
  NotifierIndex: Integer = -1;

function FindURLModule: IURLModule;
var
  I: Integer;
begin
  Result := nil;
  with BorlandIDEServices as IOTAModuleServices do
    for I := 0 to ModuleCount - 1 do
      if Supports(Modules[I], IURLModule, Result) then
        Break;
end;

procedure OpenURL(const URL: string; UseExistingView: Boolean = True);
{$IFDEF VER220} // Delphi XE
const
  SStartPageIDE = 'startpageide150.bpl';
  SOpenNewURLModule = '@Urlmodule@OpenNewURLModule$qqrx20System@UnicodeStringp22Editorform@TEditWindow';
{$ENDIF}
{$IFDEF VER185} // Delphi 2007
const
  SStartPageIDE = 'startpageide100.bpl';
  SOpenNewURLModule = '@Urlmodule@OpenNewURLModule$qqrx17System@AnsiStringp22Editorform@TEditWindow';
{$ENDIF}
var
  Module: IURLModule;
  EditWindow: INTAEditWindow;
  Lib: HMODULE;
  OpenNewURLModule: TOpenNewURLModule;
begin
  EditWindow := nil;
  Module := nil;
  if UseExistingView then
    Module := FindURLModule;
  if Assigned(Module) then
  begin
    Module.URL := URL;
    (Module as IOTAModule).Show;
  end
  else
  begin
{$IFDEF VER220}
    EditWindow := (BorlandIDEServices as INTAEditorServices).TopEditWindow;
{$ENDIF}
{$IFDEF VER185}
    if Assigned((BorlandIDEServices as IOTAEditorServices).TopView) then
      EditWindow := (BorlandIDEServices as IOTAEditorServices).TopView.GetEditWindow;
{$ENDIF}
    if not Assigned(EditWindow) or not Assigned(EditWindow.Form) then
      Exit;
    Lib := GetModuleHandle(SStartPageIDE);
    if Lib = 0 then
      Exit;

    OpenNewURLModule := GetProcAddress(Lib, SOpenNewURLModule);
    if @OpenNewURLModule <> nil then
      OpenNewURLModule(URL, EditWindow.Form);
  end;
end;

function ReadOption(const Project: IOTAProject; const SectionName, AttrName: WideString): WideString;
var
  Node: IXMLNode;
begin
  Result := '';
  Node := (BorlandIDEServices as IOTAProjectFileStorage).GetProjectStorageNode(Project, SectionName, False);
  if Assigned(Node) and (Node.HasAttribute(AttrName)) then
    Result := Node.Attributes[AttrName];
end;

procedure WriteOption(const Project: IOTAProject; const SectionName, AttrName, Value: WideString);
var
  Node: IXMLNode;
begin
  Node := (BorlandIDEServices as IOTAProjectFileStorage).GetProjectStorageNode(Project, SectionName, False);
  if not Assigned(Node) then
    Node := (BorlandIDEServices as IOTAProjectFileStorage).AddNewSection(Project, SectionName, False);
  Node.Attributes[AttrName] := Value;
  Project.MarkModified;
end;

function GetCurrentProjectPageFileName: string;
var
  Project: IOTAProject;
begin
  Result := '';
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  if Assigned(Project) then
    Result := ReadOption(Project, sWelcomePageFile, 'Path');
end;

procedure TProjectPageCmds.ProjectWelcomeOptionsExecute(Sender: TObject);
var
  Project: IOTAProject;
  Dlg: TDlgProjectPageOptions;
  I: Integer;
  ModuleInfo: IOTAModuleInfo;
begin
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  if not Assigned(Project) then
    Exit;
  Dlg := TDlgProjectPageOptions.Create(nil);
  try
    for I := 0 to Project.GetModuleCount - 1 do
    begin
      ModuleInfo := Project.GetModule(I);
      if ModuleInfo.CustomId = 'HTMLTool' then
        Dlg.cmbWelcomePage.Items.Add(ExtractRelativePath(ExtractFilePath(Project.FileName), ModuleInfo.FileName));
    end;

    Dlg.cmbWelcomePage.Text := ReadOption(Project, sWelcomePageFile, 'Path');
    Dlg.edWelcomeFolder.Text := ReadOption(Project, sWelcomePageFolder, 'Path');

    if Dlg.ShowModal = mrOK then
    begin
      WriteOption(Project, sWelcomePageFile, 'Path', Dlg.cmbWelcomePage.Text);
      WriteOption(Project, sWelcomePageFolder, 'Path', Dlg.edWelcomeFolder.Text);
    end;
  finally
    Dlg.Free;
  end;
end;

procedure TProjectPageCmds.ProjectWelcomeOptionsUpdate(Sender: TObject);
var
  Project: IOTAProject;
begin
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  with (Sender as TAction) do
  begin
    Enabled := Assigned(Project);
    Visible := Enabled;
  end;
end;

procedure TProjectPageNotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string;
  var Cancel: Boolean);
var
  Project: IOTAProject;
begin
  if (NotifyCode = ofnFileOpening) then
  begin
    Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
    if not Assigned(Project) then
      Exit;
    if SameText(ReadOption(Project, sWelcomePageFile, 'Path'), ExtractRelativePath(ExtractFilePath(Project.FileName), FileName)) then
    begin
      Cancel := True;
      OpenURL(FileName);
    end;
  end;
end;

procedure TProjectPageNotifier.AfterCompile(Succeeded: Boolean);
begin
  // do nothing
end;

procedure TProjectPageNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
  // do nothing
end;

procedure Initialize;
var
  NTAServices: INTAServices;
  Services: IOTAServices;
begin
  if not BorlandIDEServices.GetService(INTAServices, NTAServices) or not BorlandIDEServices.GetService(IOTAServices, Services) then
    Exit;

  DataModule := TProjectPageCmds.Create(nil);
  try
    NTAServices.AddActionMenu('ProjectDependenciesItem', DataModule.ProjectWelcomeOptions, DataModule.ProjectWelcomeOptionsItem);
    NotifierIndex := Services.AddNotifier(TProjectPageNotifier.Create);
  except
    FreeAndNil(DataModule);
    raise;
  end;
end;

procedure Finalize;
begin
  if NotifierIndex <> -1 then
    (BorlandIDEServices as IOTAServices).RemoveNotifier(NotifierIndex);
  FreeAndNil(DataModule);
end;

initialization
  Initialize;

finalization
  Finalize;

end.

3) データモジュールの dfm:

object ProjectPageCmds: TProjectPageCmds
  OldCreateOrder = False
  Left = 218
  Top = 81
  Height = 150
  Width = 215
  object ActionList1: TActionList
    Left = 32
    Top = 8
    object ProjectWelcomeOptions: TAction
      Category = 'Project'
      Caption = 'Pro&ject Page Options...'
      HelpContext = 3146
      OnExecute = ProjectWelcomeOptionsExecute
      OnUpdate = ProjectWelcomeOptionsUpdate
    end
  end
  object PopupMenu1: TPopupMenu
    Left = 96
    Top = 8
    object ProjectWelcomeOptionsItem: TMenuItem
      Action = ProjectWelcomeOptions
    end
  end
end

4) プロジェクトページのオプションダイアログ:

unit ProjectPageOptionsDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TDlgProjectPageOptions = class(TForm)
    bpCancel: TButton;
    bpHelp: TButton;
    bpOK: TButton;
    cmbWelcomePage: TComboBox;
    edWelcomeFolder: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure bpOKClick(Sender: TObject);
    procedure bpHelpClick(Sender: TObject);
  private
    procedure Validate;
  public
  end;

implementation

{$R *.dfm}

uses
  ShLwApi, ToolsApi;

resourcestring
  sProjectPageDoesNotExist = 'Project page ''%s'' does not exist';
  sProjectFolderDoesNotExist = 'Project folder ''%s'' does not exist';

function CanonicalizePath(const S: string): string;
var
  P: array[0..MAX_PATH] of Char;
begin
  Win32Check(PathCanonicalize(P, PChar(S)));
  Result := P;
end;

procedure TDlgProjectPageOptions.Validate;
var
  Project: IOTAProject;
  WelcomePagePath, WelcomeFolderPath: string;
begin
  Project := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
  if not Assigned(Project) then
    Exit;

  if cmbWelcomePage.Text <> '' then
  begin
    WelcomePagePath := CanonicalizePath(ExtractFilePath(Project.FileName) + cmbWelcomePage.Text);
    if not FileExists(WelcomePagePath) then
    begin
      ModalResult := mrNone;
      raise Exception.CreateFmt(sProjectPageDoesNotExist, [WelcomePagePath]);
    end;
  end;
  if edWelcomeFolder.Text <> '' then
  begin
    WelcomeFolderPath := CanonicalizePath(ExtractFilePath(Project.FileName) + edWelcomeFolder.Text);
    if not FileExists(WelcomeFolderPath) then
    begin
      ModalResult := mrNone;
      raise Exception.CreateFmt(sProjectFolderDoesNotExist, [WelcomeFolderPath]);
    end;
  end;

  ModalResult := mrOK;
end;

procedure TDlgProjectPageOptions.bpHelpClick(Sender: TObject);
begin
  Application.HelpContext(Self.HelpContext);
end;

procedure TDlgProjectPageOptions.bpOKClick(Sender: TObject);
begin
  Validate;
end;

end.

5) ダイアログの dfm:

object DlgProjectPageOptions: TDlgProjectPageOptions
  Left = 295
  Top = 168
  HelpContext = 3146
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  Caption = 'Project Page Options'
  ClientHeight = 156
  ClientWidth = 304
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  DesignSize = (
    304
    156)
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 6
    Width = 65
    Height = 13
    Caption = '&Project page:'
    FocusControl = cmbWelcomePage
  end
  object Label2: TLabel
    Left = 8
    Top = 62
    Width = 80
    Height = 13
    Caption = '&Resource folder:'
    FocusControl = edWelcomeFolder
  end
  object edWelcomeFolder: TEdit
    Left = 8
    Top = 81
    Width = 288
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 1
  end
  object bpOK: TButton
    Left = 59
    Top = 123
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'OK'
    Default = True
    ModalResult = 1
    TabOrder = 2
    OnClick = bpOKClick
  end
  object bpCancel: TButton
    Left = 140
    Top = 123
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 3
  end
  object bpHelp: TButton
    Left = 221
    Top = 123
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Help'
    TabOrder = 4
    OnClick = bpHelpClick
  end
  object cmbWelcomePage: TComboBox
    Left = 8
    Top = 25
    Width = 288
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    ItemHeight = 13
    TabOrder = 0
    Text = 'cmbWelcomePage'
  end
end

ただし、「リソースフォルダー」にどのような効果があるのかはわかりません。このオプションは .dproj ファイルに保存したり、.dproj ファイルから読み取ることができ、その存在もチェックされますが、元の拡張子がフォルダーパスをどのように使用するかはわかりません。わかったら、コードに含めますので、お知らせください。

また、このコードの一部は私のコードからコピーされています答えあなたの別の質問については、私が Delphi 2007 と Delphi XE でコンパイル (および簡単にテスト) しました。このコードは、Delphi 2007 でコンパイルされ、簡単にテストされただけです。

これが少なくとも出発点として役立つことを願っています。

ライセンス： CC-BY-SA と帰属

所属していません StackOverflow

HTML ドキュメントの特定のプロジェクト マネージャーのローカル メニュー項目の動作を変更するにはどうすればよいですか?

HTML ドキュメントの特定のプロジェクトマネージャーのローカルメニュー項目の動作を変更するにはどうすればよいですか?