CodeEditorPaintText.Main.pas

unit CodeEditorPaintText.Main;

interface

procedure Register;

implementation

uses
  System.Classes, System.Types, System.SysUtils, Winapi.Windows, System.IOUtils, System.Generics.Collections,
  ToolsAPI, ToolsAPI.Editor, Vcl.Graphics, Vcl.Controls, Vcl.GraphUtil, System.StrUtils,
  ReadPALUses;

type
//  TPALIDENotifier = class(TNotifierObject, IOTAIDENotifier)
//  private
//    procedure AfterCompile(Succeeded: Boolean);
//    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
//    procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
//  public
//		constructor Create;
//		destructor Destroy; override;
//  end;

  TIDEWizard = class(TNotifierObject, IOTAWizard, IOTAIDENotifier)
  private
    FEditorEventsNotifier: Integer;
    FNotifierIndex: Integer;
    procedure PaintText(const Rect: TRect; const ColNum: SmallInt; const Text: string;
      const SyntaxCode: TOTASyntaxCode; const Hilight, BeforeEvent: Boolean;
      var AllowDefaultPainting: Boolean; const Context: INTACodeEditorPaintContext);

    procedure AfterCompile(Succeeded: Boolean);
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
    procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
  protected
    UsesDictionary: TModulesDictIntf;
  public
    constructor Create;
    destructor Destroy; override;
    function GetIDString: string;
    procedure Execute;
    function GetName: string;
    function GetState: TWizardState;
  end;

  TCodeEditorNotifier = class(TNTACodeEditorNotifier)
  protected
    function AllowedEvents: TCodeEditorEvents; override;
  end;

procedure Register;
begin
  RegisterPackageWizard(TIDEWizard.Create);
end;

{ TIDEWizard }

procedure TIDEWizard.AfterCompile(Succeeded: Boolean);
begin

end;

procedure TIDEWizard.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin

end;

constructor TIDEWizard.Create;
begin
  inherited;
  var LNotifier := TCodeEditorNotifier.Create;

  var LEditorServices: INTACodeEditorServices;
  if Supports(BorlandIDEServices, INTACodeEditorServices, LEditorServices) then
    FEditorEventsNotifier := LEditorServices.AddEditorEventsNotifier(LNotifier)
  else
    FEditorEventsNotifier := -1;

  var	LServices: IOTAServices;
  if Supports(BorlandIDEServices, IOTAServices, LServices) then
    FNotifierIndex := LServices.AddNotifier(Self)
  else
    FNotifierIndex := -1;

  UsesDictionary := TModulesDictIntf.Create([doOwnsValues]);
  // On change of project reload data - so move elsewhere
//  UsesDictionary.loadData('MyProject'); // Filename generated by project
//  var Services: IOTAServices;
//	if not BorlandIDEServices.GetService(IOTAServices, Services) then
//		Exit;
//	NotifierIndex := Services.AddNotifier(TPALIDENotifier.Create);
//
//  UsesDictionary.runPAL('MyProject');
  //
  LNotifier.OnEditorPaintText := PaintText;

//  LIDENotifier.FileNotification := Fil
end;

destructor TIDEWizard.Destroy;
begin
  var LEditorServices: INTACodeEditorServices;
  if Supports(BorlandIDEServices, INTACodeEditorServices, LEditorServices) and
    (FEditorEventsNotifier <> -1) and Assigned(LEditorServices) then
    LEditorServices.RemoveEditorEventsNotifier(FEditorEventsNotifier);

//  var LServices: IOTAServices;
//  if Supports(BorlandIDEServices, IOTAServices, LServices) and
//    (FNotifierIndex <> -1) and Assigned(LServices) then
//    LServices.RemoveNotifier(FNotifierIndex);
//	FNotifierIndex := -1;

  inherited;
end;

procedure TIDEWizard.Execute;
begin
end;

procedure TIDEWizard.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
begin
  if NotifyCode in [ofnProjectDesktopLoad, ofnActiveProjectChanged] then
  begin
    UsesDictionary.loadData(TPath.GetFileNameWithoutExtension(FileName)); // Filename generated by project
//    CodeSite.Send(TPath.GetFileNameWithoutExtension(FileName));
//    UsesDictionary.ProjectName := FileName;
  end;
end;

function TIDEWizard.GetIDString: string;
begin
  Result := '[ED8831C6-F7F8-41DF-B93E-D503940DA689]';
end;

function TIDEWizard.GetName: string;
begin
  Result := 'CodeEditor.PaintText.Uses';
end;

function TIDEWizard.GetState: TWizardState;
begin
  Result := [wsEnabled];
end;

procedure TIDEWizard.PaintText(const Rect: TRect; const ColNum: SmallInt;
  const Text: string; const SyntaxCode: TOTASyntaxCode; const Hilight,
  BeforeEvent: Boolean; var AllowDefaultPainting: Boolean;
  const Context: INTACodeEditorPaintContext);
var
  unitList: TUsesList;
  sulist: TStringList;
  origColor: TColor;
  found: Boolean;
begin
  AllowDefaultPainting := True;
  // Unfortunately is there now way to know that we are exactly in the uses section of the code but this is close enough.
  if BeforeEvent and (SyntaxCode = atIdentifier) then
  begin
    // and in a uses statement
    AllowDefaultPainting := True;
    origColor := Context.Canvas.Font.Color;
    // Set filename on change view
    if UsesDictionary.TryGetValue(TPath.GetFileNameWithoutExtension(Context.FileName), unitList) then
    begin
      sulist := TStringList.Create;
      try
        sulist.DelimitedText := Text;
        if suList.Count>0 then
        begin
          Context.Canvas.TextOut(Rect.Left, Rect.Top, Text);
          for var str in sulist do
          begin
            Context.Canvas.Font.Color := origColor;
            Context.Canvas.Font.Style := Context.Canvas.Font.Style-[fsStrikeOut];
            found := false;
            if unitList.getflag(str)=1 then // remove
            begin
              Context.Canvas.Font.Style := Context.Canvas.Font.Style+[fsStrikeOut];
              found := True;
            end;
            if unitList.getflag(str)=2 then // move
            begin
              Context.Canvas.Font.Color := clGrayText;
              found := True;
            end;
            if found then
            begin
              var x := Context.Canvas.TextWidth(copy(Text, 0, pos(str, Text)-1));
              Context.Canvas.TextOut(Rect.Left+x, Rect.Top, str);
              AllowDefaultPainting := False;
            end;
          end;
        end
        else
          AllowDefaultPainting := True;
      finally
        sulist.Free;
      end;
    end;
  end;
end;

{ TCodeEditorNotifier }

function TCodeEditorNotifier.AllowedEvents: TCodeEditorEvents;
begin
  Result := [cevPaintTextEvents];
end;

end.