delforexpert.pas

适用于 Delphi 2-7 的Delphi控件

{|----------------------------------------------------------------------
 | Unit:        DelForExpert
 |
 | Original Author: Egbert van Nes
 | Revised by: Total rewrite by Greg Eytcheson for use with Open Tools API
 |
 | Description: Main Expert Object
 |
 | Copyright (c) 2000  Egbert van Nes
 |   All rights reserved
 |   Disclaimer and licence notes: see license.txt
 |
 |----------------------------------------------------------------------
 }
unit DelForExpert;

interface

uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, OptDlg, Menus, ToolsAPI,
 {$IFDEF CS_TRACE}CodeSiteLogging, {$ENDIF}ActnList, Registry;

type
 
 TIDETextExpert = class(TNotifierObject, IOTAWizard)
 private
  FExpertFilePath: string;
  FExpertFileName: string;
  function GetExpertFilename: string;
  function GetDLLFileName: string;
  function GetExpertFilePath: string;
  function GetMenuShortCut: TShortCut;
  procedure SetMenuShortCut(AShortCut: TShortCut);
 protected
 public
  procedure OnExecute(Sender: TObject);
  //  procedure OnHint(Sender: TObject);
  function GetIDString: string;
  function GetName: string;
  function GetState: TWizardState;
  constructor Create;
  destructor Destroy; override;
  procedure Destroyed;
  function GetMenuText: string;
  property MenuShortCut: TShortCut read GetMenuShortCut write SetMenuShortCut;
  property ExpertFilePath: string read GetExpertFilePath;
  property DLLFileName: string read GetDLLFileName;
  property ExpertFileName: string read GetExpertFilename;

  procedure Execute;
 end;
 
var
 IDETextExpert: TIDETextExpert = nil;
 newMenuItem: TMenuItem;
 NewAction: TAction;
 
const
 cnstMenuItemName = 'ToolsSourceFormatterItem';
 cnstPackageDescription = 'DelForExp Source Formatter';
 cnstDLLName = 'DelForDll.dll';
 
procedure Register;

implementation

uses DelExpert;

{$R button.res}
{.$R *.res}

{ TIDETextExpert code }

function TIDETextExpert.GetName: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetName' );{$ENDIF}
 Result := 'DelForExpert';
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetName' );{$ENDIF}
end;

function TIDETextExpert.GetMenuText: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetMenuText' );{$ENDIF}
 Result := 'Source Formatter...';
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetMenuText' );{$ENDIF}
end;

function TIDETextExpert.GetState: TWizardState;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetState' );{$ENDIF}
 Result := [wsEnabled];
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetState' );{$ENDIF}
end;

function TIDETextExpert.GetIDString: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetIDString' );{$ENDIF}
 Result := 'e_van_nes.DelForExpert';
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetIDString' );{$ENDIF}
end;

constructor TIDETextExpert.Create;
var
 NTAServices: INTAServices;
 imgList: TImageList;
 bmp: TBitmap;
 imgIndex: Integer;
// j, InsertPoint: Integer;
// ToolsMenu: TMenuItem;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Create' );{$ENDIF}
 inherited;
 if Supports(BorlandIDEServices, INTAServices, NTAServices) then
  begin

   Bmp := TBitmap.Create;
   Bmp.LoadFromResourceName(HInstance, 'DELFORBUTTON');

   imgList := TImageList.Create(nil);
   imgIndex := imgList.AddMasked(bmp, clLime);
   NTAServices.AddImages(imgList);

   Bmp.Free;
   imgList.Free;
//
   NewAction := TAction.Create(nil);
   NewAction.ActionList := NTAServices.ActionList;
   NewAction.Caption := GetMenuText;
   NewAction.Category := 'Tools';
   NewAction.Hint := 'Format source files';
   NewAction.ImageIndex := ImgIndex;
   //   NewAction.OnUpdate := OnHint;
   NewAction.OnExecute := OnExecute;
//   NewAction.ShortCut := ShortCut(Word('D'), [ssCtrl]);
   NewAction.GroupIndex := 0;
   NewAction.DisableIfNoHandler := False;

   newMenuItem := TMenuItem.Create(nil);
   newMenuItem.Name := cnstMenuItemName;
   newMenuItem.Action := NewAction;
//   NewMenuItem.Caption := GetMenuText;
//   NewMenuItem.OnClick := OnExecute;
//   NewMenuItem.ShortCut := ShortCut(Word('D'), [ssCtrl]);
//   newMenuItem.

//   ToolsMenu := nil;
//   InsertPoint := -1;
//   for j := 0 to NTAServices.MainMenu.Items.Count - 1 do
//    begin
//     if ANSICompareText(NTAServices.MainMenu.Items[j].Name, 'ToolsMenu') = 0 then
//      begin
//       ToolsMenu := NTAServices.MainMenu.Items[j];
//       break;
//      end;
//    end;
//
//   if ToolsMenu <> nil then
//    begin
//     for j := 0 to ToolsMenu.Count - 1 do
//      begin
//       if ANSICompareText(ToolsMenu.Items[j].Name, 'ToolsOptionsItem') = 0 then
//        begin
//         InsertPoint := j + 1;
//         break;
//        end;
//      end;
//    end;
//
//   ToolsMenu.Insert(InsertPoint, NewMenuItem);
//   NTAServices.AddActionMenu('', NewAction, nil, True);
   NTAServices.AddActionMenu('ToolsOptionsItem', NewAction, NewMenuItem, True);
  end;

  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Create' );{$ENDIF}
end;

procedure TIDETextExpert.SetMenuShortCut(AShortCut: TShortCut);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetMenuShortCut' );{$ENDIF}
 newMenuItem.ShortCut := AShortCut;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetMenuShortCut' );{$ENDIF}
end;

function TIDETextExpert.GetMenuShortCut: TShortCut;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetMenuShortCut' );{$ENDIF}
 if newMenuItem <> nil then
  Result := newMenuItem.ShortCut
 else
  Result := ShortCut(Word('D'), [ssCtrl]);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetMenuShortCut' );{$ENDIF}
end;

procedure remove_action(Action: TAction; ToolBar: TToolBar);
var
 I: Integer;
 Btn: TToolButton;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'remove_action' );{$ENDIF}
 for I := ToolBar.ButtonCount - 1 downto 0 do
  begin
   Btn := ToolBar.Buttons[I];
   if Btn.Action = Action then
    begin
     { Remove "Btn" from "ToolBar" }
     ToolBar.Perform(CM_CONTROLCHANGE, WPARAM(Btn), 0);
     Btn.Free;
    end;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'remove_action' );{$ENDIF}
end;

destructor TIDETextExpert.Destroy;
var
 NTAServices: INTAServices;
// ToolsMenu: TMenuItem;
// j, InsertPoint: Integer;

begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Destroy' );{$ENDIF}

 if Assigned(DelForEx9OptionsDlg) then
  begin
   try
//    if DelForEx9OptionsDlg.Showing then
     DelForEx9OptionsDlg.Close;
//    if Assigned(DelForEx9OptionsDlg) then
//     DelForEx9OptionsDlg.Release;
    if Assigned(DelForEx9OptionsDlg) then
     DelForEx9OptionsDlg := nil;
   except
   end;
  end;
 if Assigned(DelForEx9DelExpertDlg) then
  begin
   try
//    if DelForEx9DelExpertDlg.Showing then
     DelForEx9DelExpertDlg.Close;
//    if Assigned(DelForEx9DelExpertDlg) then
//     DelForEx9DelExpertDlg.Release;
    if Assigned(DelForEx9DelExpertDlg) then
     DelForEx9DelExpertDlg := nil;
   except
   end;
  end;

 { Check all the toolbars, and remove any buttons that use this action. }
 {(*}
 try
  if Supports(BorlandIDEServices, INTAServices, NTAServices) then
   begin
    try remove_action(NewAction, NTAServices.ToolBar[sCustomToolBar]);  except end;
    try remove_action(NewAction, NTAServices.ToolBar[sDesktopToolBar]); except end;
    try remove_action(NewAction, NTAServices.ToolBar[sStandardToolBar]); except end;
    try remove_action(NewAction, NTAServices.ToolBar[sDebugToolBar]);  except end;
    try remove_action(NewAction, NTAServices.ToolBar[sViewToolBar]);    except end;
    try remove_action(NewAction, NTAServices.ToolBar[sInternetToolBar]); except end;
   end;
 except
 end;
//   ToolsMenu := nil;
//   InsertPoint := -1;
//   for j := 0 to NTAServices.MainMenu.Items.Count - 1 do
//    begin
//     if ANSICompareText(NTAServices.MainMenu.Items[j].Name, 'ToolsMenu') = 0 then
//      begin
//       ToolsMenu := NTAServices.MainMenu.Items[j];
//       break;
//      end;
//    end;
//
//   if ToolsMenu <> nil then
//    begin
//     for j := 0 to ToolsMenu.Count - 1 do
//      begin
//       if ANSICompareText(ToolsMenu.Items[j].Name, cnstMenuItemName) = 0 then
//        begin
//         InsertPoint := j;
//         break;
//        end;
//      end;
//    end;
//
//  ToolsMenu.Delete(InsertPoint);

 Application.ProcessMessages;
 try newMenuItem.Free; except end;
 application.processMessages;
 try newAction.Free; except end;
 Application.ProcessMessages;
 {*)}
// inherited Destroy;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Destroy' );{$ENDIF}
end; {Destroy}

procedure TIDETextExpert.OnExecute(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'OnExecute' );{$ENDIF}
 
 Execute;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'OnExecute' );{$ENDIF}
end;

procedure TIDETextExpert.Execute;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Execute' );{$ENDIF}
 if not Assigned(DelForEx9DelExpertDlg) then
  DelForEx9DelExpertDlg := TDelForEx9DelExpertDlg.Create(nil);
//  Application.CreateForm(TDelForEx9DelExpertDlg, DelForEx9DelExpertDlg);

 DelForEx9DelExpertDlg.ShowModal;
 FreeAndNil(DelForEx9DelExpertDlg);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Execute' );{$ENDIF}
end;

procedure Register;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'Register' );{$ENDIF}
 IDETextExpert := TIDETextExpert.Create;
 RegisterPackageWizard(IDETextExpert);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'Register' );{$ENDIF}
end;

function TIDETextExpert.GetDLLFileName: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetDLLFileName' );{$ENDIF}
 Result := ExpertFilePath + cnstDLLName;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetDLLFileName' );{$ENDIF}
end;

function TIDETextExpert.GetExpertFilePath: string;
var
 RegPath: string;
 j: Integer;
 RegValues: TStringList;
 Reg: TRegistry;
 OTAServices: IOTAServices;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetExpertFilePath' );{$ENDIF}
 Result := '';
 if FExpertFilePath = '' then
  begin
   OTAServices := BorlandIDEServices as IOTAServices;
   if OTAServices <> nil then
    begin
     RegPath := OTAServices.GetBaseRegistryKey;
     Reg := TRegistry.Create;
     Reg.RootKey := HKEY_CURRENT_USER;
     if Reg.OpenKeyReadOnly(RegPath + '\Known Packages') then
      begin
       RegValues := TStringList.Create;
       try
        Reg.GetValueNames(RegValues);
        for j := 0 to RegValues.Count - 1 do
         if Reg.ReadString(RegValues[j]) = cnstPackageDescription then
          begin
           FExpertFilePath := ExtractFilePath(RegValues[j]);
           FExpertFileName := ExtractFileName(RegValues[j]);
           break;
          end;
       finally
        Reg.CloseKey;
        Reg.Free;
        RegValues.Free;
       end;
      end;
    end;
  end;

 Result := FExpertFilePath;

  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetExpertFilePath' );{$ENDIF}
end;

function TIDETextExpert.GetExpertFilename: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetExpertFilename' );{$ENDIF}
 if FExpertFileName = '' then
  GetExpertFilepath;
 
 Result := FExpertFileName;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetExpertFilename' );{$ENDIF}
end;

procedure TIDETextExpert.Destroyed;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Destroyed' );{$ENDIF}
  inherited;

  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Destroyed' );{$ENDIF}
end;

end.