unit uIDEExpert;

ToolsAPI;

TStaticCodeAnalyserExpert = class(TNotifierObject, IOTAWizard)

public

destructor Destroy; override;

{ IOTAWizard }

function GetIDString: string;

function GetName: string;

function GetState: TWizardState;

procedure Execute;

end;

procedure Register;

Winapi.Windows, System.SysUtils,

Vcl.Graphics, Vcl.ImgList, Vcl.Controls, Vcl.Menus, Vcl.ActnList,

uIDEAnalyserForm,

uIDEFindingsPropertiesForm;

PLUGIN_TITLE = 'Static Code Analysis';

PLUGIN_DESC = 'Static Code Analysis Tool for Delphi - findings, ' +

'metrics, leak detection, Sonar export.';

PLUGIN_VERSION = 'v0.9.8';

PLUGIN_LICENSE = 'Freeware / Open Source';

// Resource-Namen aus branding\sca_branding.rc (BITMAP-Type).

// 24x24 fuer Splash + About-Box (groesserer Header-Space).

SCA_APP_BMP_RES = 'SCA_APP_BMP';

// 16x16 fuer das IDE-Tools-Menu (Standard-Menu-Icon-Groesse).

SCA_APP_BMP16_RES = 'SCA_APP_BMP16';

// Tiny Wrapper-Klasse weil TAction.OnExecute eine Methode (procedure of

// object) erwartet, KEINE freie Prozedur. Lebt waehrend der gesamten

// BPL-Laufzeit und wird in finalization freigegeben.

TToolsMenuHandler = class

public

procedure MenuClick(Sender: TObject);

end;

// Index in der About-Box; gebraucht zum Unregister beim BPL-Unload.

// -1 = nicht registriert (z.B. wenn IDE keine AboutBoxServices liefert).

GAboutBoxIndex : Integer = -1;

// Branding-HBITMAP fuer Splash + About-Box, gecached fuer BPL-Laufzeit.

// 0 = nicht geladen (Resource fehlt oder LoadBitmap failed). Lebensdauer

// an die BPL gekoppelt - die IDE haelt das Handle waehrend Splash + About-

// Box, ein verfruehter DeleteObject wuerde dangling references erzeugen.

GBrandingHBmp : HBITMAP = 0;

// Tools-Menu-Eintrag (TMenuItem in INTAServices.MainMenu) + die zugrunde

// liegende TAction. Beide bei BPL-Unload freigeben sonst Dangling-Eintrag

// im IDE-Menue bis IDE-Neustart.

GToolsMenuItem : TMenuItem = nil;

GToolsAction : TAction = nil;

GToolsHandler : TToolsMenuHandler = nil;

procedure TToolsMenuHandler.MenuClick(Sender: TObject);

ShowAnalyserDockableForm;

end;

function BrandingHBitmap: HBITMAP;

if GBrandingHBmp = 0 then

GBrandingHBmp := LoadBitmap(HInstance, SCA_APP_BMP_RES);

Result := GBrandingHBmp;

end;

procedure RegisterSplashScreen;

if not Assigned(SplashScreenServices) then Exit;

SplashScreenServices.AddPluginBitmap(

PLUGIN_TITLE + ' ' + PLUGIN_VERSION,

BrandingHBitmap,

False, // IsUnregistered

PLUGIN_LICENSE,

''); // SKUBuild

end;

procedure RegisterAboutBox;

Svc : IOTAAboutBoxServices;

if not Supports(BorlandIDEServices, IOTAAboutBoxServices, Svc) then Exit;

GAboutBoxIndex := Svc.AddPluginInfo(

PLUGIN_TITLE + ' ' + PLUGIN_VERSION,

PLUGIN_DESC,

BrandingHBitmap,

False,

PLUGIN_LICENSE,

'');

end;

procedure UnregisterAboutBox;

Svc : IOTAAboutBoxServices;

if (GAboutBoxIndex >= 0)

and Supports(BorlandIDEServices, IOTAAboutBoxServices, Svc) then

Svc.RemovePluginInfo(GAboutBoxIndex);

GAboutBoxIndex := -1;

end;

function FindIDEToolsMenu(MainMenu: TMainMenu): TMenuItem;

i : Integer;

M : TMenuItem;

function WalkSub(AParent: TMenuItem): TMenuItem;

var

k : Integer;

begin

Result := nil;

for k := 0 to AParent.Count - 1 do

begin

if SameText(AParent[k].Name, 'ToolsMenu') then Exit(AParent[k]);

Result := WalkSub(AParent[k]);

if Result <> nil then Exit;

end;

end;

Result := nil;

if not Assigned(MainMenu) then Exit;

// Erste Welle: rekursiver Name-Match auf 'ToolsMenu'.

for i := 0 to MainMenu.Items.Count - 1 do

begin

M := MainMenu.Items[i];

if SameText(M.Name, 'ToolsMenu') then Exit(M);

Result := WalkSub(M);

if Result <> nil then Exit;

end;

// Fallback: Top-Level nach Caption '&Tools' / 'Tools' suchen.

for i := 0 to MainMenu.Items.Count - 1 do

begin

M := MainMenu.Items[i];

if SameText(M.Caption, '&Tools') or SameText(M.Caption, 'Tools') then

Exit(M);

end;

end;

procedure RegisterToolsMenuItem;

NTAS : INTAServices;

IL : TImageList;

BM : TBitmap;

ImageIndex : Integer;

ToolsMenu : TMenuItem;

if not Supports(BorlandIDEServices, INTAServices, NTAS) then Exit;

ToolsMenu := FindIDEToolsMenu(NTAS.MainMenu);

if not Assigned(ToolsMenu) then Exit;

ImageIndex := -1;

// ImageList nur als Transport-Vehikel - AddImages kopiert intern.

IL := TImageList.Create(nil);

try

BM := TBitmap.Create;

try

try

BM.LoadFromResourceName(HInstance, SCA_APP_BMP16_RES);

// clWhite -> transparent (24-bit BMP hat keinen Alpha-Channel,

// wir mappen den weissen Hintergrund per Mask zu Transparenz).

IL.AddMasked(BM, clWhite);

ImageIndex := NTAS.AddImages(IL);

except

// Resource-Load oder AddImages fehlgeschlagen - ImageIndex bleibt

// -1, MenuItem laeuft ohne Icon (immer noch besser als kein Eintrag).

end;

finally

BM.Free;

end;

finally

IL.Free;

end;

// TAction in der IDE-eigenen ActionList registrieren (Wichtig - sonst

// gilt der ShortCut-Code nicht und das ImageIndex-Mapping greift nicht).

// OnExecute ist TNotifyEvent (procedure of object) - braucht eine

// Methode an einer Instanz, nicht eine freie Prozedur. Daher der

// GToolsHandler-Wrapper.

if GToolsHandler = nil then

GToolsHandler := TToolsMenuHandler.Create;

GToolsAction := TAction.Create(nil);

GToolsAction.ActionList := NTAS.ActionList;

GToolsAction.Caption := PLUGIN_TITLE;

GToolsAction.OnExecute := GToolsHandler.MenuClick;

GToolsAction.Hint := PLUGIN_DESC;

GToolsAction.Category := 'SCA';

if ImageIndex >= 0 then

GToolsAction.ImageIndex := ImageIndex;

GToolsMenuItem := TMenuItem.Create(NTAS.MainMenu);

GToolsMenuItem.Action := GToolsAction;

GToolsMenuItem.Name := 'SCAToolsMenuItem';

ToolsMenu.Add(GToolsMenuItem);

end;

procedure UnregisterToolsMenuItem;

if Assigned(GToolsMenuItem) then

begin

GToolsMenuItem.Free; // entfernt aus dem Parent automatisch

GToolsMenuItem := nil;

end;

if Assigned(GToolsAction) then

begin

GToolsAction.Free;

GToolsAction := nil;

end;

if Assigned(GToolsHandler) then

begin

GToolsHandler.Free;

GToolsHandler := nil;

end;

end;

procedure Register;

RegisterAnalyserDockableForm;

// Findings-Properties-Panel (Phase 6 Integration): registriert NACH dem

// Analyser-Form, damit RegisterWatchMode darin schon gelaufen ist - der

// Wrapper-FrameCreated subscribed GWatchMode.SubscribeFindings beim

// ersten Dock-Open.

RegisterFindingsPropertiesDockableForm;

RegisterPackageWizard(TStaticCodeAnalyserExpert.Create);

RegisterAboutBox;

RegisterToolsMenuItem;

end;

destructor TStaticCodeAnalyserExpert.Destroy;

// Properties-Panel zuerst loesen - sein EditServices-Notifier soll

// gehen bevor das Analyser-Form seine eigene Cleanup-Sequenz startet.

UnregisterFindingsPropertiesDockableForm;

UnregisterAnalyserDockableForm;

inherited;

end;

function TStaticCodeAnalyserExpert.GetIDString: string;

Result := 'StaticCodeAnalyser';

end;

function TStaticCodeAnalyserExpert.GetName: string;

Result := 'Static Code Analysis';

end;

function TStaticCodeAnalyserExpert.GetState: TWizardState;

Result := [wsEnabled];

end;

procedure TStaticCodeAnalyserExpert.Execute;

ShowAnalyserDockableForm;

end;

// Splash-Screen-Eintrag: muss in initialization stehen, NICHT in Register -

// Register feuert nach Komponenten-Registrierung, da ist der Splash i.d.R.

// schon weg. initialization feuert beim BPL-Load - bei "Load on Startup"-

// Packages waehrend der IDE-Start-Sequenz, also rechtzeitig fuer den Splash.

RegisterSplashScreen;

// Tools-Menue zuerst (haengt vom Action ab, das die IDE bei UnregisterAboutBox

// noch nicht beruehrt - aber Reihenfolge schadet nicht).

UnregisterToolsMenuItem;

UnregisterAboutBox;

// Branding-HBITMAP erst NACH Unregister freigeben - die IDE haelt das

// Handle waehrend des AboutBox/Splash-Lifecycle.

if GBrandingHBmp <> 0 then

begin

DeleteObject(GBrandingHBmp);

GBrandingHBmp := 0;

end;

end.