Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/delphi/experti/d456/BROMBSCT.ZIP/uCodeTemplateLib.pas

Pascal/Delphi Source File | 2002-07-02 | 9KB | 295 lines

unit uCodeTemplateLib;

interface
uses
  Windows, Forms, Controls, Menus, Dialogs, Classes, ToolIntf, EditIntf,
  ExptIntf, VirtIntf, SysUtils, Messages, Graphics, StdCtrls;

type
  TCodeTemplateExpert = class(TIExpert)
  private
    menOptions: TIMenuItemIntf;
    menEditSep: TIMenuItemIntf;
    menEditSep2: TIMenuItemIntf;
    menInsCode: TIMenuItemIntf;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function GetName: string; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    procedure memOptionsClick(Sender: TIMenuItemIntf);
    procedure memInsCodeClick(Senfer: TIMenuItemIntf);
    procedure Execute; override;
  end;

function InitExpert(ToolServices: TIToolServices; Registerproc: TExpertRegisterproc; var Terminate:
  TExpertTerminateProc): Boolean; export; stdcall;

procedure Register;

var
  CodeTemplateExpert: TCodeTemplateExpert = nil;


implementation
uses
  uGlobCT, uMain, ULoadTemplate;
const
  LINEFEED = #10;
  CRLF = #13#10;

procedure Register;
begin
  RegisterLibraryExpert(TCodeTemplateExpert.Create);
end;


{ TCodeTemplateExpert }

constructor TCodeTemplateExpert.Create;
var
  menMain: TIMainMenuIntf;
  menViewWinList: TIMenuItemIntf;
  menViewMenu: TIMenuItemIntf;
begin
  strexpertpath := ExtractFileDir(Application.ExeName);
  inherited Create;
  menMain := ToolServices.GetMainMenu;
  if Assigned(menMain) then
  try
    menViewWinList := menMain.FindMenuItem('ToolsOptionsItem');
    if Assigned(menViewWinList) then
    try
      menViewMenu := menViewWinList.GetParent;
      if Assigned(menViewMenu) then
      try
        menEditSep := menViewMenu.InsertItem(menViewWinList.GetIndex + 1, '-',
          'EditExpertSeparator', '', 0, 0, 0, [mfVisible], nil);

        menOptions := menViewMenu.InsertItem(menEditSep.GetIndex + 1, '&Code template',
          'EditExpertOptionsItem', '', 0, 0, 0, [mfEnabled, mfVisible], memOptionsClick);

        menInsCode := menViewMenu.InsertItem(menOptions.GetIndex + 1, 'Insert code', 'EditExpertInserCodeItem',
          '', ShortCut(Word('H'), [ssCtrl]), 0, 0, [mfEnabled, mfVisible], memInsCodeClick);

        menEditSep2 := menViewMenu.InsertItem(menInsCode.GetIndex + 1, '-',
          'EditExpertSeparator2', '', 0, 0, 0, [mfVisible], nil);
      finally
        menViewMenu.Free;
      end;
    finally
      menViewWinList.Free;
    end;
  finally
    menMain.Free;
  end;
end;

destructor TCodeTemplateExpert.Destroy;
begin
  menOptions.free;
  menEditSep.free;
  menEditSep2.free;
  menInsCode.free;
  inherited Destroy;
end;

procedure TCodeTemplateExpert.Execute;
begin

end;

function TCodeTemplateExpert.GetIDString: string;
begin
  Result := 'brombs.CodeTemplate';
end;

function TCodeTemplateExpert.GetName: string;
begin
  Result := 'Code Template Expert';
end;

function TCodeTemplateExpert.GetState: TExpertState;
begin
  Result := [esEnabled];
end;

function TCodeTemplateExpert.GetStyle: TExpertStyle;
begin
  Result := esAddIn;
end;

procedure TCodeTemplateExpert.memOptionsClick(Sender: TIMenuItemIntf);
begin
  with TfmMain.create(Application) do
  begin
    ShowModal;
    Free;
  end;
end;

procedure TCodeTemplateExpert.memInsCodeClick(Senfer: TIMenuItemIntf);
var
  MoInt: TIModuleInterface; // module interface
  EdInt: TIEditorInterface; // editor interface
  EdView: TIEditView; // the editor view
  EdWrite: TiEditWriter; // Edit Writer
  EdRead: TIEditReader; // Edit Reader
  Ep: TEditPos; // the editorposition
  FName: string; // The File Name
  Lf: array[0..1] of Char; // Local Buffer
  EdPos: Integer; // Current Position in Editor Buffer
  Eof: Boolean; // True if at end of Edit Buffer
  FoundIt: Boolean; // True if Line Found
  i: integer;

  function ReadEditorLine: string; // Read a return a line from the Editor
  var
    CharPos: Integer; // Current Position in the result string
  begin
    SetLength(Result, 1024); // Longest Line !!!!
    CharPos := 1; // begin at the beginning
    repeat
      try
              // Read a character
        Eof := EdRead.GetText(EdPos,
          @Result[CharPos], 1) <> 1;
      except
        begin
          Eof := True; // Eof JIC
          Result := ''; // No Result
        end;
      end;
      Inc(EdPos);
      if Result[CharPos] = LINEFEED then begin // was it a LineFeed and if so...
        Result[CharPos] := #0; // Null the last char
        SetLength(Result, CharPos - 1); // set the length
        Exit; // bye bye
      end;
    until Eof; // repeat till end of file
    Result := ''; // if we get here we are eof so ''
  end;

  function GotoLine(LineNo: Integer): Boolean; // Goto line from file start
  var
    Lines: Integer; // Line count
  begin
    Result := False; // assume failure
    if LineNo = 1 then
      exit; // if first line we are there already
    EdPos := 0; // zap editor pos
    Lines := 1; // First line
    while (not Result) do begin // while not done
      try
        Eof := EdRead.GetText(EdPos, Lf, 1) <> 1; // read a character
      except
        Eof := True; // assume EOF on exception
      end;
      Inc(EdPos); // Bump Editor position
      if Lf[0] = LINEFEED then
        Inc(Lines); // if EOL then bump count
      if Lines = LineNo then begin // if this is the line we want
        Eof := False; //  not EOF
        Result := True; // got it
      end;
    end;
  end;

begin
  if Toolservices = nil then // No toolservices, no can do
    exit;
  Fname := Toolservices.GetCurrentFile; // Get the file name
  if Pos('.DFM', UpperCase(FName)) > 0 then begin // if this is a DFM
    ShowMessage('Pascal source must have focus'); // Tell em not to be stupid
    Exit; // Bye Bye
  end;

  if not Toolservices.IsFileOpen(FName) then begin // if file is not open
    if not Toolservices.OpenFile(FName) then begin // try and open it
      MessageDlg(Format('Can''t open %s', [FName]),
        mtError, [mbOk], 0); // tell em we failed
      Exit; // bye bye
    end;
  end;

  MoInt := Toolservices.GetModuleInterface(Fname); // get the module interface for the file
  try
    EdInt := MoInt.GetEditorInterface; // get the editor interface
    try
      EdView := EdInt.GetView(0); // get the view
      try
        Ep := EdView.CursorPos; // get the current cursor position
      finally
        EdView.Free; // free the view
      end;

      EdRead := EdInt.CreateReader; // Create the Reader
      try
        FoundIt := GotoLine(Ep.Line); // jump to the required line
      finally
        EdRead.Free; // Free the buffer
      end;
      if not FoundIt then
        exit; // bomb out if not found

      EdWrite := EdInt.CreateWriter; // get the vWriter
      try
        fmLoadTemplate := TfmLoadTemplate.Create(Application);
        try
          fmLoadTemplate.ShowModal;
          with EdWrite do begin // with the writer
            if fmLoadTemplate.ModalResult = mrOK then
            begin
              CopyTo(EdPos); // move down to the first char of the line
              Insert(CRLF);
              if fmLoadTemplate.Code.Count > 0 then
                for i := 0 to fmLoadTemplate.Code.Count - 1 do
                  Insert(PChar(fmLoadTemplate.Code[i] + CRLF));
              Insert(CRLF);
            end;
          end;
        finally
          fmLoadTemplate.Free;
        end;
      finally
        EdWrite.Free; // free the writer
      end;
      EdView := EdInt.GetView(0); // get the view
      try
        Ep := EdView.CursorPos; // get the cursor position
        Ep.Line := Ep.Line + 1; // We inserted line
        EdView.CursorPos := Ep; // Set the cursor position
      finally
        EdView.Free; // free the view
      end;
    finally
      EdInt.Free; // free the interface
    end;
  finally
    MoInt.Free; // free the module
  end;
end;


function InitExpert(
  ToolServices: TIToolServices;
  Registerproc: TExpertRegisterproc;
  var Terminate: TExpertTerminateProc): Boolean; export; stdcall;
begin
  Result := ExptIntf.ToolServices = nil;
  if not Result then
    exit;
  ExptIntf.ToolServices := ToolServices;
  if Assigned(ToolServices) then
    Application.Handle := ToolServices.GetParentHandle;
  Terminate := nil;
  CodeTemplateExpert := TCodeTemplateExpert.Create;
  RegisterProc(CodeTemplateExpert);
end;


end.