{ ******************************************************* }
{ }
{ VA 508 Manager - Enable check }
{ }
{ Code is scanned to show warings about either }
{ missing translations or where the enabled property }
{ is adjusted and the manager is not monitoring the }
{ property }
{ }
{ ******************************************************* }

unit VA508AccessibilityDisableCheck;

interface

uses
  System.Classes,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.StdCtrls,
  Vcl.ExtCtrls,
  Vcl.ComCtrls,
  System.ImageList,
  Vcl.ImgList,
  System.Generics.Collections,
  VA508AccessibilityManager;

type
  TCheckObject = Class(TObject)
  Private
    FCollectionItem: TVA508AccessibilityItem;
    FMissingTranslate: Boolean;
    FLookupString: String;
    FWatchEnable: Boolean;
    FListItem: TListItem;
    FIgnoreEnable: Boolean;
    FHint: String;
  public
    Property CollectionItem: TVA508AccessibilityItem read FCollectionItem
      write FCollectionItem;
    Property WatchEnable: Boolean read FWatchEnable write FWatchEnable
      default False;
    Property MissingTranslate: Boolean read FMissingTranslate
      write FMissingTranslate;
    Property IgnoreEnable: Boolean read FIgnoreEnable write FIgnoreEnable default False;
    Property LookupString: String read FLookupString write FLookupString;
    Property ListItem: TListItem read FListItem write FListItem;
    Property Hint: String read FHint write FHint;
  End;

  TCheckObjectList = Class(TObjectList<TCheckObject>)
  private
    function GetWatchEnable(ListItem: TListItem): Boolean;
    procedure SetWatchEnable(ListItem: TListItem; const Value: Boolean);
    function GetIgnoreEnable(ListItem: TListItem): Boolean;
    procedure SetIgnoreEnable(ListItem: TListItem; const Value: Boolean);
    function GetAreItemsDisplayed: Boolean;
  public
    Procedure Assign(SrcList: TCheckObjectList);
    Property WatchEnable[ListItem: TListItem]: Boolean Read GetWatchEnable
      write SetWatchEnable;
    Property IgnoreEnable[ListItem: TListItem]: Boolean Read GetIgnoreEnable
      write SetIgnoreEnable;
    Property AreItemsDisplayed: Boolean read GetAreItemsDisplayed;
  End;

  TfrmDisableCheck = class(TForm)
    ilCheckBoxes: TImageList;
    lvControls: TListView;
    btnCancel: TButton;
    Panel1: TPanel;
    btnOK: TButton;
    Panel2: TPanel;
    procedure lvControlsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lvControlsInfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: string);
  private
    fEnableChecks: TCheckObjectList;
  public
    Property EnableChecks: TCheckObjectList read fEnableChecks
      write fEnableChecks;
  end;

procedure PerformDisabledCheck(Sender: TComponent;
  var VA508AccessibilityItems: TVA508AccessibilityCollection);

const
  // Status Images
  Missing_Translate = 2;
  Status_UnChk = 0;
  Status_Chk = 1;

implementation

uses
  Winapi.Windows,
  System.SysUtils,
  System.TypInfo,
  System.StrUtils,
  Winapi.CommCtrl,
  VA508TranslateDictionary,
  ToolsAPI;

{$R *.dfm}

procedure PerformDisabledCheck(Sender: TComponent;
  var VA508AccessibilityItems: TVA508AccessibilityCollection);

  function GetCurrentUnitPath: String;
  var
    ModuleServices: IOTAModuleServices;
    SourceEditor: IOTASourceEditor;
    Module: IOTAModule;
    idx: integer;
  begin
    Result := '';
    SourceEditor := nil;

    if System.SysUtils.Supports(BorlandIDEServices, IOTAModuleServices,
      ModuleServices) then
    begin
      Module := ModuleServices.CurrentModule;

      if System.assigned(Module) then
      begin
        idx := Module.GetModuleFileCount - 1;

        // Iterate over modules till we find a source editor or list exhausted
        while (idx >= 0) and not System.SysUtils.Supports
          (Module.GetModuleFileEditor(idx), IOTASourceEditor, SourceEditor) do
          System.Dec(idx);

        // Success if list wasn't ehausted.
        if idx >= 0 then
          Result := SourceEditor.FileName;
      end;

    end;
  end;

var
  frmDisableCheck: TfrmDisableCheck;
  Item: TVA508AccessibilityItem;
  InitChecks: TCheckObjectList;
  PasFileLines: TStringList;
  aCheckObj: TCheckObject;
  PropInfo: PPropInfo;
  s, PasFile: string;
  i: integer;
begin
  PasFile := GetCurrentUnitPath;

  If Trim(PasFile) <> '' then
  begin
    InitChecks := TCheckObjectList.Create;
    try
      PasFileLines := TStringList.Create;
      try
        PasFileLines.LoadFromFile(PasFile);

        // get all items with an enabled property and not monitored
        // or items that are watched but missing translation
        for i := 0 to VA508AccessibilityItems.Count - 1 do
        begin
          Item := VA508AccessibilityItems.Items[i];
          PropInfo := GetPropInfo(Item.Component.ClassInfo, 'Enabled');
          If (PropInfo <> nil) and
            ((not Item.WatchEnable) and (not Item.IgnoreEnabled)) or
            ((Item.WatchEnable) and
            (Trim(TVA508AccessibilityTranslation.TranslateClassName
            (Item.Component)) = '')) then
          begin
            aCheckObj := TCheckObject.Create;
            InitChecks.Add(aCheckObj);
            aCheckObj.MissingTranslate :=
              Trim(TVA508AccessibilityTranslation.TranslateClassName
              (Item.Component)) = '';
            aCheckObj.LookupString := Item.Component.Name + '.enabled';
            aCheckObj.CollectionItem := Item;
            aCheckObj.ListItem := nil;
            aCheckObj.Hint := '';
          end;
        end;

        // look through what was found
        If InitChecks.Count > 0 then
        begin
          frmDisableCheck := TfrmDisableCheck.Create(Sender);
          try
            frmDisableCheck.EnableChecks.Assign(InitChecks);

            // Look for the controls where the enabled exist at runtime
            // or items that are watched but missing translation
            // for s in PasFileLines do
            For i := 0 to PasFileLines.Count - 1 do
            begin
              s := PasFileLines.Strings[i];
              // Do we even need to check
              If ContainsText(s, 'Enabled') then
              begin
                For aCheckObj in frmDisableCheck.EnableChecks do
                begin
                  // Do we need to add this to the listview
                  if (not assigned(aCheckObj.ListItem)) and
                    (not aCheckObj.CollectionItem.WatchEnable) and
                    ContainsText(s, aCheckObj.LookupString) then
                  begin
                    If not aCheckObj.CollectionItem.WatchEnable then
                      aCheckObj.Hint := 'Modified at line #' + IntToStr(i);
                    aCheckObj.ListItem := frmDisableCheck.lvControls.Items.Add;
                    aCheckObj.ListItem.Caption :=
                      aCheckObj.CollectionItem.Component.Name;
                    aCheckObj.ListItem.Data := aCheckObj;
                    aCheckObj.ListItem.ImageIndex := -1;
                    aCheckObj.ListItem.StateIndex := -1;

                    aCheckObj.ListItem.SubItems.Add('');
                    aCheckObj.ListItem.SubItems.Add('');

                    aCheckObj.WatchEnable :=
                      aCheckObj.CollectionItem.WatchEnable;
                    case aCheckObj.CollectionItem.WatchEnable of
                      True:
                        aCheckObj.ListItem.SubItemImages[0] := Status_Chk;
                      False:
                        aCheckObj.ListItem.SubItemImages[0] := Status_UnChk;
                    end;

                    aCheckObj.IgnoreEnable :=
                      aCheckObj.CollectionItem.IgnoreEnabled;
                    case aCheckObj.CollectionItem.IgnoreEnabled of
                      True:
                        aCheckObj.ListItem.SubItemImages[1] := Status_Chk;
                      False:
                        aCheckObj.ListItem.SubItemImages[1] := Status_UnChk;
                    end;

                  end;
                end;
              end;
            end;

            // display any missign translation only
            For aCheckObj in frmDisableCheck.EnableChecks do
            begin
              If (not assigned(aCheckObj.ListItem)) and
                aCheckObj.CollectionItem.WatchEnable and aCheckObj.MissingTranslate
              then
              begin
                aCheckObj.ListItem := frmDisableCheck.lvControls.Items.Add;
                aCheckObj.ListItem.Caption :=
                  aCheckObj.CollectionItem.Component.Name;
                aCheckObj.ListItem.Data := aCheckObj;
                aCheckObj.ListItem.ImageIndex := -1;
                aCheckObj.ListItem.StateIndex := Missing_Translate;
                aCheckObj.ListItem.SubItems.Add('');
                aCheckObj.ListItem.SubItems.Add('');
                aCheckObj.WatchEnable := aCheckObj.CollectionItem.WatchEnable;
                Case aCheckObj.CollectionItem.WatchEnable of
                  True:
                    aCheckObj.ListItem.SubItemImages[0] := Status_Chk;
                  False:
                    aCheckObj.ListItem.SubItemImages[0] := Status_UnChk;
                end;

                aCheckObj.IgnoreEnable :=
                  aCheckObj.CollectionItem.IgnoreEnabled;
                Case aCheckObj.CollectionItem.IgnoreEnabled of
                  True:
                    aCheckObj.ListItem.SubItemImages[1] := Status_Chk;
                  False:
                    aCheckObj.ListItem.SubItemImages[1] := Status_UnChk;
                end;
              end;
            end;

            If frmDisableCheck.EnableChecks.AreItemsDisplayed and
              (frmDisableCheck.ShowModal = mrOk) then
            begin
              // Check the boxes
              For aCheckObj in frmDisableCheck.EnableChecks do
              begin
                If assigned(aCheckObj.ListItem) then
                begin
                  aCheckObj.CollectionItem.WatchEnable := aCheckObj.WatchEnable;
                  aCheckObj.CollectionItem.IgnoreEnabled :=
                    aCheckObj.IgnoreEnable;
                end;
              end;
            end;
          finally
            FreeAndNil(frmDisableCheck);
          end;
        end;
      finally
        FreeAndNil(PasFileLines);
      end;
    finally
      FreeAndNil(InitChecks);
    end;
  end;
end;

procedure TfrmDisableCheck.FormCreate(Sender: TObject);
begin
  fEnableChecks := TCheckObjectList.Create;
end;

procedure TfrmDisableCheck.FormDestroy(Sender: TObject);
begin
  FreeAndNil(fEnableChecks);
end;

procedure TfrmDisableCheck.lvControlsClick(Sender: TObject);
var
  hittestinfo: TLVHitTestInfo;
  aCheckObj: TCheckObject;
  lstItm: TListItem;
  lvCurPos: TPoint;
begin
  inherited;

  lvCurPos := lvControls.ScreenToClient(Mouse.CursorPos);
  lstItm := lvControls.GetItemAt(lvCurPos.X, lvCurPos.y);
  if not assigned(lstItm) then
  begin
    FillChar(hittestinfo, sizeof(hittestinfo), 0);
    hittestinfo.pt := lvCurPos;
    If -1 <> lvControls.perform(LVM_SUBITEMHITTEST, 0,
      lparam(@hittestinfo)) Then
    Begin
      lstItm := lvControls.Items[hittestinfo.iItem];
      if assigned(lstItm) and assigned(lstItm.Data) then
      begin
        aCheckObj := TCheckObject(lstItm.Data);

        // Set the image
        case lvControls.Items[hittestinfo.iItem].SubItemImages
          [hittestinfo.iSubItem - 1] of
          Status_UnChk:
            begin
              lvControls.Items[hittestinfo.iItem].SubItemImages
                [hittestinfo.iSubItem - 1] := Status_Chk;
            end;
          Status_Chk:
            begin
              lvControls.Items[hittestinfo.iItem].SubItemImages
                [hittestinfo.iSubItem - 1] := Status_UnChk;
            end;
        else
          exit;
        End;

        // Set the property
        case (hittestinfo.iSubItem - 1) of
          0:
            begin
              If lvControls.Items[hittestinfo.iItem].SubItemImages[1] = Status_Chk
              then
                lvControls.Items[hittestinfo.iItem].SubItemImages[1] :=
                  Status_UnChk;
              aCheckObj.WatchEnable := lvControls.Items[hittestinfo.iItem]
                .SubItemImages[0] = Status_Chk;
              If aCheckObj.WatchEnable then
                aCheckObj.IgnoreEnable := False;
            end;
          1:
            begin
              If lvControls.Items[hittestinfo.iItem].SubItemImages[0] = Status_Chk
              then
                lvControls.Items[hittestinfo.iItem].SubItemImages[0] :=
                  Status_UnChk;
              aCheckObj.IgnoreEnable := lvControls.Items[hittestinfo.iItem]
                .SubItemImages[1] = Status_Chk;
              If aCheckObj.IgnoreEnable then
                aCheckObj.WatchEnable := False;
            end;
        else
          exit;
        End;
      end;
    end;
  end;
end;

procedure TfrmDisableCheck.lvControlsInfoTip(Sender: TObject; Item: TListItem;
  var InfoTip: string);
var
  aCheckObj: TCheckObject;
  HintStr: String;
begin
  HintStr := '';
  if assigned(Item.Data) then
  begin
    aCheckObj := TCheckObject(Item.Data);
    If (Trim(aCheckObj.Hint) <> '') and aCheckObj.MissingTranslate then
      HintStr := aCheckObj.Hint +
        ' and translation not found in VA508TranslateDictionary'
    else if Trim(aCheckObj.Hint) <> '' then
      HintStr := aCheckObj.Hint
    else if aCheckObj.MissingTranslate then
      HintStr := 'Translation not found in VA508TranslateDictionary';
  end;
  InfoTip := HintStr;
end;

{ TCheckObjectList }

procedure TCheckObjectList.Assign(SrcList: TCheckObjectList);
var
  SrcObj, DestObj: TCheckObject;
begin
  self.Clear;
  For SrcObj in SrcList do
  begin
    DestObj := TCheckObject.Create;
    self.Add(DestObj);
    DestObj.MissingTranslate := SrcObj.MissingTranslate;
    DestObj.CollectionItem := SrcObj.CollectionItem;
    DestObj.LookupString := SrcObj.LookupString;
    DestObj.WatchEnable := SrcObj.WatchEnable;
    DestObj.IgnoreEnable := SrcObj.IgnoreEnable;
    DestObj.ListItem := SrcObj.ListItem;
  end;
end;

function TCheckObjectList.GetAreItemsDisplayed: Boolean;
var
  aCheckObj: TCheckObject;
begin
  Result := False;
  For aCheckObj in self do
  begin
    If assigned(aCheckObj.ListItem) then
    begin
      Result := true;
      break;
    end;
  end;
end;

function TCheckObjectList.GetIgnoreEnable(ListItem: TListItem): Boolean;
var
  aCheckObj: TCheckObject;
begin
  Result := False;
  For aCheckObj in self do
  begin
    If aCheckObj.ListItem = ListItem then
    begin
      Result := aCheckObj.IgnoreEnable;
      break;
    end;
  end;
end;

function TCheckObjectList.GetWatchEnable(ListItem: TListItem): Boolean;
var
  aCheckObj: TCheckObject;
begin
  Result := False;
  For aCheckObj in self do
  begin
    If aCheckObj.ListItem = ListItem then
    begin
      Result := aCheckObj.WatchEnable;
      break;
    end;
  end;

end;

procedure TCheckObjectList.SetIgnoreEnable(ListItem: TListItem; const Value: Boolean);
var
  aCheckObj: TCheckObject;
begin
  For aCheckObj in self do
  begin
    If aCheckObj.ListItem = ListItem then
    begin
      aCheckObj.IgnoreEnable := Value;
      break;
    end;
  end;
end;

procedure TCheckObjectList.SetWatchEnable(ListItem: TListItem;
  const Value: Boolean);
var
  aCheckObj: TCheckObject;
begin
  For aCheckObj in self do
  begin
    If aCheckObj.ListItem = ListItem then
    begin
      aCheckObj.WatchEnable := Value;
      break;
    end;
  end;
end;

end.
