如何在设计时确定项目目录中的组件

7
我编写了一个组件,需要存储一些与项目目录相关的信息。每当我的组件属性发生变化时,它都应该写入一个文件。那么,在设计时,如何让组件确定当前的项目目录呢?
谢谢提前!
编辑:
我想在每次更改组件属性时生成一个Delphi源文件,这样当我编译代码时就可以始终得到最新版本。可以将其视为一种代码生成器。
目前,我设置了源码应存储的完整路径和文件名,但我更喜欢使用相对路径到项目(或包含我的组件的窗体/数据模块),以便在不同的开发者机器上复制项目更容易。
6个回答

7

感谢您的提示。开放工具API是正确的选择,可以在设计时从表单上的组件使用开放工具API。

这是我的解决方案:

我需要两个单元,一个用于组件,另一个用于注册组件和使用开放工具API的代码。

以下是组件单元:


unit TestLabels;

interface

uses
  SysUtils, Classes, Windows, Controls, StdCtrls;

type
  TTestLabel = class(TLabel)
  private
    FTestProperty: Boolean;
    procedure SetTestProperty(const Value: Boolean);
    procedure Changed;
  published
    property TestProperty: Boolean read FTestProperty write SetTestProperty;
  end;

var
  OnGetUnitPath: TFunc;

implementation

{ TTestLabel }

procedure TTestLabel.Changed;
begin
  if not (csDesigning in ComponentState) then
     Exit; // I only need the path at designtime

  if csLoading in ComponentState then
     Exit; // at this moment you retrieve the unit path which was current before

  if not Assigned(OnGetUnitPath) then
    Exit;

  // only for demonstration
  Caption := OnGetUnitPath;
  MessageBox(0, PChar(ExtractFilePath(OnGetUnitPath)), 'Path of current unit', 0);
end;

procedure TTestLabel.SetTestProperty(const Value: Boolean);
begin
  if FTestProperty  Value then
  begin
    FTestProperty := Value;
    Changed;
  end;
end;

end.

这里是用于注册组件和调用Open Tools API的单元:


unit TestLabelsReg;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, TestLabels;

procedure register;

implementation

uses
  ToolsAPI;

function GetCurrentUnitPath: String;
var
  ModuleServices: IOTAModuleServices;
  Module: IOTAModule;
  SourceEditor: IOTASourceEditor;
  idx: integer;

begin
  Result := '';
  SourceEditor := nil;

  if SysUtils.Supports(BorlandIDEServices, IOTAModuleServices,
    ModuleServices) then
  begin
    Module := ModuleServices.CurrentModule;

    if System.Assigned(Module) then
    begin
      idx := Module.GetModuleFileCount - 1;

      // Iterate over modules till we find a source editor or list exhausted
      while (idx >= 0) and not SysUtils.Supports(Module.GetModuleFileEditor(idx), IOTASourceEditor, SourceEditor) do
        System.Dec(idx);

      // Success if list wasn't ehausted.
      if idx >= 0 then
        Result := ExtractFilePath(SourceEditor.FileName);
    end;

  end;

end;

procedure register;
begin
  RegisterComponents('Samples', [TTestLabel]);
  TestLabels.OnGetUnitPath := GetCurrentUnitPath;
end;

end.

我非常确定你的GetCurrentUnitPath无法编译(至少while循环的布尔表达式不行),而且while循环永远不会结束。但是这个想法很有趣,所以我点了赞。 - Jeroen Wiert Pluimers
@Jeroen:感谢您指出这一点。stackoverflow.com编辑器裁剪了“while not ((idx < 0) or SysUtils.Supports(Module.GetModuleFileEditor(idx), IOTASourceEditor, SourceEditor) do”这一行。我已经调整了while循环的条件,以便stackoverflow.com正确显示它。顺便说一句,CurrentUnitPath是从附带Delphi的DUnit向导中提取的(经过修改)。 - Heinz Z.

7

从Delphi 7开始,ToolsAPI单元定义了一个getActiveProject函数,该函数返回当前项目的IOTAProject接口。

IOTAProject的fileName属性返回项目主源文件的完整路径(通常是.dpr文件)。

因此,在许多情况下,可以使用简单的指令,例如:

if csDesigning in componentState then
    appFolderPath := extractFilePath( getActiveProject.fileName ) 
else
    appFolderPath := extractFilePath( application.exeName );

(在海因茨的示例中不需要使用两个单位)

方便 :-) 我刚刚创建了一个TComponentEditor,用它来编辑资源(*.rc)。这个基础路径可以将相对路径转换为绝对路径。 - Adrian Maire

2

组件无法访问您的源路径,因为组件是放置在您的应用程序中并作为应用程序的一部分在Delphi IDE之外运行的。

如果您想要访问项目路径或自动化IDE内的任何过程,则必须使用OpenTools API编写IDE专家,而不是组件。


这并不总是正确的:组件也可以在设计器中运行。显然,在应用程序运行时源路径是不可用的,但在设计时拥有项目路径仍然很有用(例如,在编辑器中检索资源)。 - Adrian Maire

1

我认为这是不可能的。虽然你可以很容易地确定你的 EXE 运行的目录,但是在设计时,你的组件是作为 IDE 的一部分运行的。我怀疑组件是否有办法通过 IDE 访问项目信息。


这不是我想听到的。 :-) 我希望能够从我的组件中访问IDE的设计API。 - Heinz Z.
1
请看一下OTAPI,它可以访问IDE的设计API,但我认为您不能将OTAPI功能与表单上的组件混合使用。 - Mason Wheeler
1
@Heinz:不是从你的组件中,正如Mason所说。你可以使用Open Tools API(OTAPI)从IDE专家中实现。 - Ken White
可以将OTAPI与组件混合使用(请参见我的解决方案)。 - Heinz Z.

1

gexperts otafaq的链接非常有帮助。 - Heinz Z.

0

我有一个稍微不同的目标:如何在设计时知道项目exe文件将位于何处,以便应用程序在运行时可以与设计时功能共享一些文件。

因此,我结合了两个最佳答案并创建了以下函数可用于应用程序:

unit MyUtils;

interface

function GetProjectTargetPath: string;

var

  _GetProjectTargetPath: TFunc<string>;

...
implementation

function GetProjectTargetPath: string;
begin
  Result := '';
  if Assigned(_GetProjectTargetPath) then
    Result := _GetProjectTargetPath;
  if Result <> '' then
    Result := IncludeTrailingPathDelimiter(Result);
end;

然后在组件注册单元中(我将其单独分离并仅链接到设计时包):

unit MyUtils;

...
implementation

function GetProjectTargetPath: String;
begin
  Result := ExtractFilePath( GetActiveProject.ProjectOptions.TargetName );
end;

procedure Register;
begin
  ...
  MyUtils._GetProjectTargetPath := GetProjectTargetPath;
end;

因此,避免实际单元依赖于ToolsAPI。

MyUtils.GetProjectTargetPath在运行时返回一个空字符串,实际上对应于应用程序exe目录。


网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接