4

我正在复制项目页面选项 IDE 插件¹。特别是，此插件将项目管理器中打开操作的默认行为² 替换为自己的行为 - 在用于显示欢迎页面的同一内部浏览器中打开 HTML 页面。所以，我也想做同样的事情，但目前我无法到达这个菜单。

我尝试了 IOTAProjectManager 接口，它有助于添加项目管理器的菜单项³，但我知道它notifiers是相互隔离的，所以很可能这个 API 对我的目的没有用。此外，我试图挂钩到应用程序范围的动作处理。它绝对没有给我任何结果，可能根本没有使用操作列表。

我想，上面的配置让我别无选择，只能求助于黑客，这使得黑客解决方案在这里非常受欢迎。那么，有什么想法吗？

¹有关更多信息，请参阅此 Q。

² 有 3 个相关项：打开、显示标记、显示设计器。在没有加载项的情况下打开默认显示设计器。

³ 事实上，这个 API 允许即时添加项目，它可能会使事情变得更加复杂。

图示的上下文菜单：

在此处输入图像描述 在此处输入图像描述

正如TOndrej在下面的评论中提到的，打开菜单项的行为仅针对在相应对话框中配置为“项目页面”的 HTML 文档进行了更改。

4

1 回答 1

2

我认为原始项目页面扩展是通过安装 IDE 通知程序来实现的（见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 文件中并从中读取，还检查了它是否存在，但我不知道原始扩展如何使用文件夹路径。如果你发现了，请告诉我，我会把它包含在代码中。

此外，此代码的一部分是从我对您的另一个问题的回答中复制的，我在 Delphi 2007 和 Delphi XE 中编译（并简要测试）了该问题。此代码仅在 Delphi 2007 中编译和简要测试。

希望这有助于作为一个起点，至少。

于 2011-12-10T22:05:36.923 回答