Comment changer un comportement de menu local spécifique de projet pour les documents HTML?

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

  •  28-10-2019
  •  | 
  •  

Question

Je suis en train de reproduire projet Page Options de l'EDI add-in¹. En particulier, ce complément remplace behavior² par défaut de Ouvrir action dans le gestionnaire de projet avec son propre comportement - pour ouvrir une page HTML dans le même navigateur interne qui est utilisé pour afficher une page d'accueil. Donc, je veux faire la même chose, mais actuellement je ne ai pas atteindre ce menu.

J'ai essayé une interface IOTAProjectManager, ce qui facilite une ajouter Menu du Gestionnaire de projet items³, mais j'appris ce que son notifiers sont isolés les uns des autres, donc très probablement cette API est inutile pour mon but. En outre, j'ai essayé de brancher dans le traitement d'action demande à l'échelle. Il m'a donné absolument aucun résultat, probablement la liste d'action (s) ne sont pas utilisés du tout.

Je suppose que, la disposition ci-dessus me laisse pas d'autre choix que de recourir à un hacks, ce qui rend les solutions hackish vraiment les bienvenus ici. Alors, une idée vous plaît?

¹ Pour plus d'informations à ce sujet voir ce Q .

² Il y a 3 éléments pertinents: Ouvrir , Afficher les marques , Show Designer . Ouvrir par défaut Show Designer sans. Add-in

³ En fait, cette API permet d'ajouter des éléments à la volée, et il est probablement

les choses encore plus compliquées.

menus contextuels illustré:

entrer image description ici

TOndrej mentionné dans le commentaire ci-dessous, le comportement de Ouvrir élément de menu a changé uniquement pour le document HTML configuré dans la boîte de dialogue correspondante comme "page Projet".

Était-ce utile?

La solution

Je pense que l'extension page du projet d'origine, il fait en installant un notificateur IDE (voir TProjectPageNotifier ci-dessous). Je ne pense pas que cela n'a rien à voir avec le gestionnaire de projet. Il écoute simplement les notifications sur les fichiers qui sont ouverts dans l'EDI et si elle est la page du projet, il ouvrira dans le navigateur intégré au lieu du concepteur HTML par défaut. Voici ma tentative de reproduire cette fonctionnalité pour Delphi 2007.

1) paquet: 

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) module de données avec une action et un élément de menu pour ajouter au menu 'Projet': 

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) le DFM du module de données: 

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

de 4) options de la page du projet: 

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) La DFM de la boîte de dialogue: 

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

Cependant, je ne sais pas quel effet le « dossier de ressources » a. L'option peut être stockée et lue à partir du fichier .dproj, il est également vérifié qu'il existe, mais je ne sais pas comment l'extension d'origine utilise le chemin du dossier. Si vous trouvez s'il vous plaît laissez-moi savoir, je vais inclure dans le code.

En outre, une partie de ce code est copié de mon réponse à une autre question de la vôtre, que je compilé (et brièvement testé) dans Delphi 2007 et Delphi XE. Ce code a été compilé seulement et brièvement testé dans Delphi 2007.

Hope this helps comme point de départ, au moins.

Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top