DIL - de Delphi Expert

Delphi IDE Experts en Wizards
Het begrip Expert en Wizard betekent overigens voor Delphi hetzelfde. Het begon allemaal met Experts (en de TIExpert class) in Delphi, maar C++Builder veranderde de term plots in Wizards (maar bleef de interne class TIExpert noemen), en vanaf Delphi 3 is deze terminologie ongewijzigd overgenomen. We maken dus Wizards door TIExpert te implementeren. Even wennen, maar verder valt het wel mee.
Om een Wizard te maken moeten we de zojuist genoemde TIExpert class (gedefinieerd in EXPTINTF.PAS) nemen en daar een eigen class van afleiden, bijvoorbeeld TDILWizard. Dit is nodig omdat TIExpert een zgn. abstract base class is; het bevat de (interface) definitie waar een Wizard aan moet voldoen, maar niet de implementatie - die moeten we nu juist in onze TDILWizard aanbrengen door elke (abstracte) method van TIExpert te overriden en te implementeren. De class definitie van TDILWizard ziet er dan als volgt uit:

  uses
    ShareMem, { in case of a DLL Wizard }
    VirtIntf, ExptIntf, ToolIntf, Windows, SysUtils, Forms;

  type
    TDILWizard = class(TIExpert)
    public
      function GetStyle: TExpertStyle; override;
      function GetIDString: string; override;
      function GetName: string; override;
      function GetAuthor: String; override;
      function GetMenuText: string; override;
      function GetState: TExpertState; override;
      procedure Execute; override;
    end {TDILWizard};

  function TDILWizard.GetStyle: TExpertStyle;
  begin
    Result := esStandard
  end {GetStyle};

  function TDILWizard.GetIDString: String;
  begin
    Result := 'TAS-AT.BobSwart.TDILWizard.esStandard'
  end {GetIDString};

  function TDILWizard.GetName: String;
  begin
    Result := 'TDILWizard'
  end {GetName};

  function TDILWizard.GetAuthor: String;
  begin
    Result := 'Bob Swart (aka Dr.Bob - www.drbob42.com)'
  end {GetAuthor};

  function TDILWizard.GetMenuText: String;
  begin
    Result := 'UK-BUG &DIL'
  end {GetMenuText};

  function TDILWizard.GetState: TExpertState;
  begin
    Result := [esEnabled];
  end {GetState};

  procedure TDILWizard.Execute;
  begin
    try
      WinExec('c:\program files\developer information library\dil.exe', SW_NORMAL);
    except
      // if we have one, just eat the exception
    end
  end {Execute};

  function InitExpert(ToolServices: TIToolServices;
                      RegisterProc: TExpertRegisterProc;
                  var Terminate: TExpertTerminateProc): Boolean; stdcall;
  begin
    Result := True;
    try
      ExptIntf.ToolServices := ToolServices; { Save! }
      if ToolServices <> nil then
        Application.Handle := ToolServices.GetParentHandle;
      Terminate := DoneExpert;
      Result := RegisterProc(TDILWizard.Create);
    except
      HandleException
    end
  end {InitExpert};

  exports
    InitExpert name ExpertEntryPoint;

Wie tot nu heeft mee zitten typen: gooi de source code maar weer weg. In plaats van een esStandard Wizard gaan we nu een esAddIn Wizard maken. Ik zal niet alle source code laten zien (die is te downloaden van mijn website), maar met name naar de interesssante onderdelen kijken. We beginnen met de Shift+F1 shortcut. Dit is niet mogelijk als esStandard Wizard (dan is het helemaal niet mogelijk om een shortcut op te geven), maar wel bij een AddIn Wizard. Bij dit soort Wizards, moeten we de constructor zelf overriden om een nieuw menu item aan te maken (in dit geval ergens in het Tools menu), en daarbij een shortcut meegeven:

  constructor TDrBobDIL.Create;
  var
    MainMenu: TIMainMenuIntf;
    MainItem: TIMenuItemIntf;
    MenuItem: TIMenuItemIntf;

  begin
    inherited Create;
    NewMenuItem := nil;
    if ToolServices <> nil then
    try
      MainMenu := ToolServices.GetMainMenu;
      if MainMenu <> nil then { main menu }
      try
        MenuItem := MainMenu.FindMenuItem('ToolsOptionsItem');
        if MenuItem <> nil then
        try
          MainItem := MenuItem.GetParent;
          if MainItem <> nil then
          try
            NewMenuItem :=
              MainItem.InsertItem(MenuItem.GetIndex+1,
                                 'UK-BUG &DIL',
                                 'DrBobDIL1','',
                                  ShortCut(VK_F1,[ssShift]),0,0,
                                 [mfEnabled, mfVisible], OnClick)
          finally
            MainItem.DestroyMenuItem
          end
        finally
          MenuItem.DestroyMenuItem
        end
      finally
        MainMenu.Free
      end
    except
      HandleException
    end
  end {Create};

  procedure TDrBobDIL.Execute;
  var
    ModIntf: TIModuleInterface;
    EditIntf: TIEditorInterface;
    EditView: TIEditView;
    EditRead: TIEditReader;
    FileName: ShortString;
  const
    IdentSet = ['A'..'Z','0'..'9','.'];
  var
    HWnd: THandle;
    EditPos: TEditPos;
    CharPos: TCharPos;
    Position: LongInt;
  begin
    try
      FileName := ToolServices.GetCurrentFile;
      if Pos('.PAS',UpperCase(FileName)) > 0 then
      begin
        ModIntf := ToolServices.GetModuleInterface(FileName);
        if ModIntf <> nil then
        try
          EditIntf := ModIntf.GetEditorInterface;
          if EditIntf <> nil then
          try
            EditView := EditIntF.GetView(0);
            if EditView <> nil then
            try
              EditPos := EditView.CursorPos;
              EditView.ConvertPos(True,EditPos,CharPos);
              Position := EditView.CharPosToPos(CharPos)
            finally
              EditView.Free
            end
            else Position := 0;
            EditRead := EditIntF.CreateReader;
            if EditRead <> nil then
            try
              repeat
                FileName[0] := Chr(EditRead.GetText(Position,@FileName[1],255));
                Dec(Position)
              until (Position = 0) or not (UpCase(FileName[1]) in IdentSet);
              Delete(FileName,1,1); { remove leading space character }
              Position := 0;
              repeat
                Inc(Position)
              until not (UpCase(FileName[Position]) in IdentSet);
              Delete(FileName,Position,255);
            finally
              EditRead.Free
            end
          finally
            EditIntf.Free
          end
        finally
          ModIntf.Free
        end
      end;
      ....

      ....
      HWnd := FindWindowEx(0,0,'TfmDilSearch',nil);
      if HWnd <> 0 then
      begin
        SetForeGroundWindow(HWnd);
        BringWindowToTop(HWnd);
        SetFocus(HWnd);
        SendKeys(FileName)
      end
      else
        if WinExec('c:\program files\developer information library\dil.exe',
                    SW_NORMAL) > 32 then
          SendKeys(FileName)
    except
      HandleException
    end
  end {Execute};

  procedure SimulateKeyDown(Key : byte);
  begin
    keybd_event(Key, 0, 0, 0)
  end;

  procedure SimulateKeyUp(Key : byte);
  begin
    keybd_event(Key, 0, KEYEVENTF_KEYUP, 0)
  end;

  procedure SimulateKeystroke(Key : byte; extra : DWORD);
  begin
    keybd_event(Key, extra, 0, 0);
    keybd_event(Key, extra, KEYEVENTF_KEYUP, 0)
  end;

  procedure SendKeys(s: String);
  var
    i: integer;
    flag: bool;
    w: word;
  begin
    flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
    if flag then SimulateKeystroke(VK_CAPITAL, 0);
    for i := 1 to Length(s) do
    begin
      w := VkKeyScan(s[i]);
      if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then
      begin
        if HiByte(w) and 1 = 1 then SimulateKeyDown(VK_SHIFT);
        SimulateKeystroke(LoByte(w), 0);
        if HiByte(w) and 1 = 1 then SimulateKeyUp(VK_SHIFT)
      end;
    end;
    if flag then SimulateKeystroke(VK_CAPITAL, 0);
  end;