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

Question

我编写了一个组件,它应该存储一些与项目目录相关的信息.每次更改组件的属性时,都应该写一个文件.那么组件如何在设计时确定当前项目目录.

提前致谢

编辑:
我想在每次更改组件的属性时生成delphi源文件,以便在编译代码时始终获得最新版本.可以把它想象成一种代码生成器.

目前我设置了存储源的整个路径和文件名,但我更喜欢项目的相对路径(或包含我的组件的表单/ datamodule),以便更容易在不同的开发人员机器上复制项目.

Answer 1

谢谢你的提示.Open Tools API是一种可行的方式,可以在设计时使用表单上的组件中的Open Tools API.

所以这是我的解决方案:

我需要两个单元,一个用于组件,一个用于注册组件和使用Open Tools 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.

Answer 2

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

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

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

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

(并且不需要像上面Heinz的例子那样使用两个单位)