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.
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;
6条答案
按热度按时间piv4azn71#
感谢您的提示。API是正确的选择,在设计时从窗体上的组件使用OpenToolsAPI是可能的。
我的解决方案是:
我需要两个单元,一个用于组件,一个用于注册组件和使用开放工具API的代码。
组件单元来了:
下面是注册组件的单元和对Open Tools API的调用:
lvmkulzt2#
从 Delphi 7开始,ToolsAPI单元定义了一个getActiveProject函数,它返回当前项目的IOTAProject接口。
IOTAProject的fileName属性返回项目主源文件(通常为.dpr文件)的完整路径。
因此,在许多情况下,可以使用简单的指令,例如:
(and不需要像上面海因茨的例子那样使用两个单元)
oyxsuwqo3#
组件无法访问源路径,因为组件位于应用程序中,并作为应用程序的一部分在 Delphi IDE之外运行。
如果您希望访问项目路径,或自动化IDE内部的任何过程;您必须使用API而不是组件来编写IDEMaven。
k10s72fa4#
我不认为它可以。你可以很容易地确定你的EXE运行的目录,但是你的组件在设计时是作为IDE的一部分运行的。我怀疑是否有一种方法可以让组件通过IDE访问项目信息。
uz75evzq5#
见
http://www.gexperts.org/otafaq.html#project
然后
www.href.com/pub/sw/ProjectOptions.html
可能会有帮助
eit6fx6z6#
我的目标有点不同如何知道项目exe在设计时的位置,以便应用程序在运行时可以与设计时功能共享某些文件。
因此,我将两个最佳答案结合起来,创建了以下函数以供应用程序使用:
然后在组件注册单元(我已经将其分离并仅链接到设计时包)中:
从而避免了实际单元对ToolsAPI的依赖。
MyUtils.GetProjectTargetPath在运行时返回一个空字符串,它实际上对应于应用程序的exe-directory。