unit u508Interceptors;

interface

uses
  SysUtils,
  Windows,
  Messages,
  Graphics,
  System.Classes,
  Vcl.Controls,
  Vcl.StdCtrls,
  Vcl.Buttons,
  Vcl.ComCtrls,
  ORCtrls,
  VAUtils,
  VA508AccessibilityRouter,
  VA508AccessibilityManager;

type
  // adapted from some post on SO
  TStaticTextFocusRect = class(Vcl.StdCtrls.TStaticText)
  private
    FFocused: boolean;
    FCanvas: TCanvas;
  protected
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  public
    constructor Create(AOwner: TComponent); reintroduce;
  end;

  TButton = class(Vcl.StdCtrls.TButton)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TBitBtn = class(Vcl.Buttons.TBitBtn)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TGroupBox = class(Vcl.StdCtrls.TGroupBox)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TCheckBox = class(Vcl.StdCtrls.TCheckBox)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TRadioButton = class(Vcl.StdCtrls.TRadioButton)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TListBox = class(Vcl.StdCtrls.TListBox)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TEdit = class(Vcl.StdCtrls.TEdit)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TDateTimePicker = class(Vcl.ComCtrls.TDateTimePicker)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TCaptionEdit = class(ORCtrls.TCaptionEdit)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

  TORComboBox = class(ORCtrls.TORComboBox)
  private
    FStaticText: TStaticTextFocusRect;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
  end;

var
  ScreenReaderActiveOnStartup: boolean;

implementation

uses
  ORFn;

constructor TStaticTextFocusRect.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;

procedure TStaticTextFocusRect.WMSetFocus(var Message: TWMSetFocus);
begin
  FFocused := True;
  Invalidate;
  inherited;
end;

procedure TStaticTextFocusRect.WMKillFocus(var Message: TWMKillFocus);
begin
  FFocused := False;
  Invalidate;
  inherited;
end;

procedure TStaticTextFocusRect.WMPaint(var Message: TWMPaint);
begin
  inherited;
  FCanvas.Lock;
  try
    FCanvas.Handle := Message.DC;
    try
      TControlCanvas(FCanvas).UpdateTextFlags;
      FCanvas.Brush.Color := Color;
      FCanvas.FillRect(ClientRect);
      if FFocused then
        FCanvas.DrawFocusRect(ClientRect);
    finally
      FCanvas.Handle := 0;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

function CreateHiddenStaticText(aControl: TWinControl;
  const aType, aCaption: string): TStaticTextFocusRect;
const
  Offset = 1;
begin
  Result := TStaticTextFocusRect.Create(aControl.Owner);
  Result.Parent := aControl.Parent;
  Result.SendToBack;
  Result.AutoSize := False;
  Result.TabStop := True;
  Result.TabOrder := aControl.TabOrder;
  Result.Caption := Format('%s %s Disabled', [aType, aCaption]);
  Result.SetBounds(aControl.Left - Offset, aControl.Top - Offset,
    aControl.Width + Offset * 2, aControl.Height + Offset * 2);
end;

procedure TButton.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Button', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TButton.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Button', Caption);
    end;
end;

procedure TBitBtn.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Button', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TBitBtn.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Button', Caption);
    end;
end;

procedure TGroupBox.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Group Box', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TGroupBox.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Group Box', Caption);
    end;
end;

procedure TCheckBox.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Check Box', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TCheckBox.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Check Box', Caption);
    end;
end;

procedure TRadioButton.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Radio Button', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TRadioButton.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Radio Button', Caption);
    end;
end;

procedure TListBox.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'List Box', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TListBox.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'List Box', Caption);
    end;
end;

procedure TEdit.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Edit', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TEdit.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Edit', Caption);
    end;
end;

procedure TDateTimePicker.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Date Time Picker', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TDateTimePicker.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Date Time Picker', Caption);
    end;
end;

procedure TCaptionEdit.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Edit', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TCaptionEdit.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Edit', Caption);
    end;
end;

procedure TORComboBox.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not(csLoading in ComponentState) then
    if ScreenReaderActiveOnStartup then
    begin
      if not Enabled then
        FStaticText := CreateHiddenStaticText(Self, 'Combo Box', Caption)
      else
        FreeAndNil(FStaticText);
    end;
end;

procedure TORComboBox.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    if ScreenReaderActiveOnStartup and not Enabled then
    begin
      if FStaticText = nil then
        FStaticText := CreateHiddenStaticText(Self, 'Combo Box', Caption);
    end;
end;

initialization

ScreenReaderActiveOnStartup := VA508AccessibilityRouter.ScreenReaderActive;

end.
