Как изменить поведение местного меню менеджера конкретного менеджера проекта для документов HTML?

StackOverflow https://stackoverflow.com/questions/8379094

  •  28-10-2019
  •  | 
  •  

Вопрос

Я нахожусь в процессе воспроизведения параметров страницы проекта IDE Add¹. В частности, это дополнение заменяет поведение по умолчанию Открытым Действие в менеджере проекта с его собственным поведением - чтобы открыть HTML -страницу в том же внутреннем браузере, которая используется для отображения приветственной страницы. Итак, я хочу сделать то же самое, но в настоящее время я не смог достичь этого меню.

Я попробовал интерфейс йотапроектманагера, который облегчает добавление Меню меню меню проектахов, но я узнал, что его notifiers изолированы друг от друга, поэтому, скорее всего, этот API бесполезен для моей цели. Кроме того, я попытался зацепить обработку действий по всему применению. Это дало мне абсолютно никаких результатов, вероятно, списка действий вообще не используются.

Я полагаю, диспозиция выше не оставляет мне иного выбора, кроме как прибегнуть к халам, что делает хакерские решения действительно приветствовать здесь. Итак, есть идея, пожалуйста?

¹ Для получения дополнительной информации об этом см. это кв.

² Есть 3 соответствующих пункта: Открытым, Показать наценку, Показать дизайнер. Открытым по умолчанию Показать дизайнер без надстройки.

«В связи с тем, что этот API позволяет добавлять элементы на лету, и это, вероятно, делает вещи еще более сложными.

Контекстные меню иллюстрированы:

enter image description here enter image description here

В качестве Тондрей упоминается в комментарии ниже, поведение Открытым Элемент меню изменен только для документа HTML, настроенного как «страница проекта» в соответствующем диалоговом окне.

Это было полезно?

Решение

Я думаю, что исходное расширение страницы проекта делает это путем установки уведомления 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.

Надеюсь, это поможет как отправная точка, по крайней мере.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top