怎样实现Delphi7的IDE的标题栏中显示打开工程的完整路径？

lcmlhs_2005 2012-08-23 09:36:27

如题：
delphi IDE开发环境中怎样显示出打开工程的完整路径，最好在IDE环境中的主窗体的标题栏上显示出来，因为这样一看就知道工程文件所在的路径，很方便。

...全文

2631 76 打赏收藏转发到动态举报

写回复

用AI写文章

76 条回复

切换为时间正序

请发表友善的回复…

发表回复

lcmlhs_2005 2012-12-31

打赏
举报

楼上的很不错，多给你点儿分

蓝色光芒 2012-12-29

打赏
举报

佩服搂主的精神,执着追求源代码的精神...!! 首先把 $(DELPHI)\Source\ToolsAPI 加入到搜索搜索路径中, 把以下代码复制到一个单元中并保存为IDEShowPath.pas; 然后点菜单 Component -> Install Component... 弹出的窗口中,Package file name中选择 ???\borland\delphi7\Lib\dclusr.dpk,这个是用户自定义包,方便搞的, 然后在Unit file name 一栏中,选择刚才保存的文件IDEShowPath.pas,然后点OK 询问是否重新编译,选择YES,然后关闭Delphi 7,关闭过程中,选择保存 dclusr 以后所有已经保存的工程就会在标题上显示全路径了.

//在Delphi 7的IDE的主窗口中显示项目全路径
//由于使用了固定名称,所以只能在Delphi7中使用,其他版本自行调整
//By 蓝色光芒
unit IDEShowPath;

interface

procedure Register;

implementation

{$IFDEF VER150}        //只有Delphi 7.0用,其它版本相应调整
Uses
  Windows, Messages, Forms, Classes, SysUtils , ToolsAPI;

Type
  TNotifyOTAObject = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
  protected
    procedure FileNotification(NotifyCode: TOTAFileNotification;
      const FileName: string; var Cancel: Boolean);
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
    procedure AfterCompile(Succeeded: Boolean); overload;

    procedure HwndProc(var Message: TMessage);
  end;

var
  Obj : TNotifyOTAObject;
  fOldHwndProc : TWndMethod;
  fFileName : String;
  liIndex : integer;

procedure SetTextProc(var Message: TMessage);
var
  fCaption : String;
  PJ : IOTAProject;
begin
  PJ := GetActiveProject;
  if PJ<>NIL then fCaption := 'Delphi 7 - ' + PJ.FileName
  else if StrScan(PChar(Message.LParam) , '-')=NIL then fCaption := 'Delphi 7'
  else fCaption := 'Delphi 7 - ' + fFileName;
  Message.LParam := integer(fCaption);
  fOldHwndProc(Message);
end;

{ TNotifyOTAObject }
procedure TNotifyOTAObject.HwndProc(var Message: TMessage);
begin
  if Message.Msg=WM_SETTEXT then SetTextProc(Message)
  else fOldHwndProc(Message);
end;


procedure TNotifyOTAObject.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TNotifyOTAObject.BeforeCompile(const Project: IOTAProject;var Cancel: Boolean);
begin
end;
procedure TNotifyOTAObject.FileNotification(NotifyCode: TOTAFileNotification;
  const FileName: string; var Cancel: Boolean);
begin
  if NotifyCode=ofnActiveProjectChanged then
    fFileName := FileName;
end;

procedure Register;
begin
  Obj := TNotifyOTAObject.Create;
  fOldHwndProc := Application.MainForm.WindowProc;
  Application.MainForm.WindowProc := Obj.HwndProc;
  liIndex := (BorlandIDEServices as IOTAServices).AddNotifier(Obj);
end;

initialization
finalization
  Application.MainForm.WindowProc := fOldHwndProc;
  (BorlandIDEServices as IOTAServices).RemoveNotifier(liIndex);
{$ELSE}
procedure Register;
begin
end;
{$ENDIF}
end.

XStar2008 2012-12-28

打赏
举报

楼主真执着呀

CCDDzclxy 2012-12-28

打赏
举报

引用 72 楼 taixinltd 的回复:

编写一个组件： Txxxx= class(TTimer) private procedure WndProc(var Msg: TMessage); public constructor Create(AOwner: TComponent);override; destructor Destroy; override; end; constru……

没看明白怎么用？？能在 delphi32.exe 中运行？？

taixinltd 2012-12-28

打赏
举报

编写一个组件： Txxxx= class(TTimer) private procedure WndProc(var Msg: TMessage); public constructor Create(AOwner: TComponent);override; destructor Destroy; override; end; constructor Txxxx.Create(AOwner: TComponent); begin ... if not (csDesigning in ComponentState) then begin FmyHandle := AllocateHWnd(WndProc); if SetTimer(FmyHandle , 1, 1000,nil) = 0 then raise EOutOfResources.Create('error '); end; end; destructor Txxxx.Destroy; begin if not (csDesigning in ComponentState) then begin KillTimer(FMyHandle, 1); DeallocateHWnd(FMyHandle); end; inherited Destroy; end; procedure Txxxx.WndProc(var Msg: TMessage); var apptitle:string; len:integer; begin if (Msg.Msg = WM_TIMER) then try apptitle:=Application.Title; len:=length(apptitle); if (len<FcmTitleSize)or(copy(apptitle,Len+1-FcmTitleSize,FcmTitleSize)<>FcmTitle)then Application.Title:=apptitle+"你的路径，自己想办法获取了！"; except Application.HandleException(Self); end else Msg.Result := DefWindowProc(FMyHandle, Msg.Msg, Msg.wParam, Msg.lParam); end;

CCDDzclxy 2012-12-28