¿Cómo cambiar un comportamiento del elemento de menú local del administrador de proyectos específico para los documentos HTML?
Pregunta
Estoy en el proceso de reproducción de opciones de página del proyecto IDE Addin¹. Particularmente, este complemento reemplaza el comportamiento predeterminado² de Abierto Acción en el gerente del proyecto con su propio comportamiento: para abrir una página HTML en el mismo navegador interno que se utiliza para mostrar una página de bienvenida. Entonces, quiero hacer lo mismo, pero actualmente no pude llegar a este menú.
Probé la interfaz iotaprojectManager, que facilita una suplente Elementos del menú del gerente del proyecto, pero aprendí lo que es notifiers
están aislados el uno del otro, por lo que probablemente esta API es inútil para mi propósito. Además, intenté conectarme al procesamiento de acción en toda la aplicación. No me dio absolutamente ningún resultado, probablemente no se usan listas de acción allí en absoluto.
Supongo que la disposición anterior no me deja más remedio que recurrir a un hacks, lo que hace que las soluciones hackish sean realmente bienvenidas aquí. Entonces, ¿alguna idea por favor?
¹ Para obtener más información sobre eso, ver esta Q.
² Hay 3 artículos relevantes: Abierto, Marcar el margen, Diseñador de espectáculos. Abierto Valor predeterminado a Diseñador de espectáculos sin un complemento.
³ En el hecho, esta API permite agregar elementos sobre la marcha, y probablemente hace que las cosas sean aún más complicadas.
Menús con contexto ilustrados:
Como Tondrej mencionado en los comentarios a continuación, comportamiento de Abierto El elemento del menú cambió solo para el documento HTML configurado como "página del proyecto" en el cuadro de diálogo correspondiente.
Solución
Creo que la extensión original de la página del proyecto lo hace instalando un notificador IDE (ver TProjectPageNotifier
abajo). No creo que tenga nada que ver con el gerente del proyecto. Simplemente escucha notificaciones sobre archivos que se abren en el IDE y si es la página del proyecto, la abrirá en el navegador incrustado en lugar del diseñador HTML predeterminado. Aquí está mi intento de reproducir esta funcionalidad para Delphi 2007.
1) Paquete:
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) Módulo de datos con una acción y un elemento de menú para agregar al menú 'Proyecto':
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) El DFM del módulo de datos:
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) Diálogo de opciones de página del proyecto:
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 del diálogo:
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
Sin embargo, no sé qué efecto tiene la "carpeta de recursos". La opción se puede almacenar y leer desde el archivo .dproj, también se verifica que existe, pero no sé cómo la extensión original usa la ruta de la carpeta. Si se entera, hágamelo saber, lo incluiré en el código.
Además, parte de este código se copia de mi responder a otra pregunta tuya, que compilé (y probé brevemente) en Delphi 2007 y Delphi Xe. Este código solo fue compilado y probado brevemente en Delphi 2007.
Espero que esto ayude como punto de partida, al menos.