cxaccessibility.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,048 行 · 第 1/3 页

  const riid: TGUID; out ppvObject): HRESULT;
begin
  Result := FcxAccessibleObjectFromWindow(hwnd, dwId, riid, ppvObject);
end;

{ TcxAccessibilityHelper }

constructor TcxAccessibilityHelper.Create(AOwnerObject: TObject);
begin
  inherited Create;
  FIsOwnerObjectLive := True;
  FOwnerObject := AOwnerObject;
end;

function TcxAccessibilityHelper.GetNextSelectableChildIndex(AStartIndex: Integer;
  AGoForward: Boolean): Integer;
var
  ACount, AStep, I: Integer;
begin
  Result := -1;

  ACount := ChildCount;
  if AStartIndex < 0 then
    if AGoForward then
      AStartIndex := -1
    else
      AStartIndex := ACount
  else
    if AStartIndex >= ACount then
      raise Exception.Create('');
  I := AStartIndex;

  if AGoForward then
    AStep := 1
  else
    AStep := -1;

  repeat
    Inc(I, AStep);
    if (I < 0) or (I = ACount) then
      Break;
    if Childs[I].Selectable then
      Result := I;
  until Result <> -1;
end;

// IcxAccessibilityHelper
function TcxAccessibilityHelper.GetHelper: TcxAccessibilityHelper;
begin
  Result := Self;
end;

procedure TcxAccessibilityHelper.OwnerObjectDestroyed;
begin
  FIsOwnerObjectLive := False;
end;

function TcxAccessibilityHelper.ChildIsSimpleElement(AIndex: Integer): Boolean;
begin
  raise Exception.Create('');
end;

procedure TcxAccessibilityHelper.DoDefaultAction(
  AChildID: TcxAccessibleSimpleChildElementID);
begin
end;

function TcxAccessibilityHelper.Focused(out AIsChildFocused: Boolean;
  out AFocusedChildIndex: Integer): Boolean;
begin
  Result := False;
end;

function TcxAccessibilityHelper.GetChild(
  AIndex: Integer): TcxAccessibilityHelper;
begin
  Result := nil;
end;

function TcxAccessibilityHelper.GetChildCount: Integer;
begin
  Result := 0;
end;

function TcxAccessibilityHelper.GetChildIndex(
  AChild: TcxAccessibilityHelper): Integer;
begin
  raise Exception.Create('');
end;

function TcxAccessibilityHelper.GetDefaultActionDescription(
  AChildID: TcxAccessibleSimpleChildElementID): string;
begin
  Result := '';
end;

function TcxAccessibilityHelper.GetDescription(
  AChildID: TcxAccessibleSimpleChildElementID): string;
begin
  Result := '';
end;

function TcxAccessibilityHelper.GetHitTest(AScreenX, AScreenY: Integer;
  out AChildIndex: Integer): TcxAccessibleObjectHitTest;
begin
  Result := aohtNone;
end;

procedure TcxAccessibilityHelper.GetKeyboardAccessParameters(
  AChildID: TcxAccessibleSimpleChildElementID; out AShortCut: TShortCut;
  out ACaptionWithAccelChars: string);
begin
  AShortCut := 0;
  ACaptionWithAccelChars := '';
end;

function TcxAccessibilityHelper.GetName(
  AChildID: TcxAccessibleSimpleChildElementID): string;
begin
  Result := '';
end;

function TcxAccessibilityHelper.GetOwnerObjectWindow: HWND;
begin
  Result := 0;
end;

function TcxAccessibilityHelper.GetParent: TcxAccessibilityHelper;
begin
  Result := nil;
end;

function TcxAccessibilityHelper.GetRole(
  AChildID: TcxAccessibleSimpleChildElementID): Integer;
begin
  Result := 0;
end;

function TcxAccessibilityHelper.GetScreenBounds(
  AChildID: TcxAccessibleSimpleChildElementID): TRect;
begin
  Result := Rect(0, 0, 0, 0);
end;

function TcxAccessibilityHelper.GetSelectable: Boolean;
begin
  Result := False;
end;

function TcxAccessibilityHelper.GetState(
  AChildID: TcxAccessibleSimpleChildElementID): Integer;
begin
  Result := cxSTATE_SYSTEM_NORMAL;
end;

function TcxAccessibilityHelper.GetSupportedProperties(
  AChildID: TcxAccessibleSimpleChildElementID): TcxAccessibleObjectProperties;
begin
  Result := [];
end;

function TcxAccessibilityHelper.GetValue(
  AChildID: TcxAccessibleSimpleChildElementID): string;
begin
  raise Exception.Create('');
end;

function TcxAccessibilityHelper.NavigateToChild(
  ACurrentChildIndex: Integer; ADirection: TcxAccessibilityNavigationDirection): Integer;
begin
  raise Exception.Create('');
end;

procedure TcxAccessibilityHelper.SetValue(
  AChildID: TcxAccessibleSimpleChildElementID; const Value: string);
begin
end;

function TcxAccessibilityHelper.GetRootHelper: TcxAccessibilityHelper;
var
  AParent: TcxAccessibilityHelper;
begin
  Result := Self;
  repeat
    AParent := Result.Parent;
    if AParent <> nil then
      Result := AParent;
  until (AParent = nil);
end;

// IDispatch
function TcxAccessibilityHelper.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TcxAccessibilityHelper.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TcxAccessibilityHelper.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TcxAccessibilityHelper.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params;
  VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

// IOleWindow
function TcxAccessibilityHelper.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
  Result := S_OK;
end;

function TcxAccessibilityHelper.GetWindow(out wnd: HWnd): HResult;
begin
  if CheckIsOwnerObjectLive(Result) then
  begin
    wnd := GetOwnerObjectWindow;
    Result := S_OK; // TODO
  end;
end;

// IcxAccessible
function TcxAccessibilityHelper.accDoDefaultAction(
  varChild: OleVariant): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
    if aopDefaultAction in GetSupportedProperties(ASimpleChildElementID) then
    begin
      DoDefaultAction(ASimpleChildElementID);
      Result := S_OK;
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.accHitTest(xLeft: Integer; yTop: Integer;
  out pvarChild: OleVariant): HResult;
var
  AChildIndex: Integer;
begin
  VariantInit(pvarChild);
  if CheckIsOwnerObjectLive(Result) then
    if aopLocation in GetSupportedProperties(cxAccessibleObjectSelfID) then
    begin
      if PtInRect(GetScreenBounds(cxAccessibleObjectSelfID), Point(xLeft, yTop)) then
      begin
        case GetHitTest(xLeft, yTop, AChildIndex) of
          aohtSelf:
            begin
              TVarData(pvarChild).VType := VT_I4;
              pvarChild := CHILDID_SELF;
            end;
          aohtChild:
            begin
              TVarData(pvarChild).VType := VT_I4;
              pvarChild := AChildIndex + 1;
              CheckSimpleChildElementToBeReturned(pvarChild);
            end;
        end;
      end;
      if TVarData(pvarChild).VType <> VT_EMPTY then
        Result := S_OK
      else
        Result := S_FALSE;
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.accLocation(out pxLeft: Integer;
  out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer;
  varChild: OleVariant): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
    if aopLocation in GetSupportedProperties(cxAccessibleObjectSelfID) then
      with GetScreenBounds(ASimpleChildElementID) do
      begin
        pxLeft := Left;
        pyTop := Top;
        pcxWidth := Right - Left;
        pcyHeight := Bottom - Top;
        Result := S_OK;
      end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.accNavigate(navDir: Integer;
  varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult;

  procedure NavigateToFirstOrLastChild;
  var
    AChildCount: Integer;
  begin
    if varStart <> CHILDID_SELF then
      Result := E_INVALIDARG
    else
      if not (aopLocation in GetSupportedProperties(cxAccessibleObjectSelfID)) then
        Result := DISP_E_MEMBERNOTFOUND
      else
      begin
        AChildCount := GetChildCount;
        if AChildCount = 0 then
          Result := S_FALSE
        else
        begin
          TVarData(pvarEndUpAt).VType := VT_I4;
          if navDir = NAVDIR_FIRSTCHILD then
            pvarEndUpAt := 1
          else
            pvarEndUpAt := AChildCount;
          Result := S_OK;
        end;
      end;
  end;

  procedure NavigateToNeighboringChildViaParent;
  var
    AParent: TcxAccessibilityHelper;
    AStartChildID: OleVariant;
  begin
    Result := S_FALSE;
    AParent := GetParent; // TODO get_accParent
    if (AParent <> nil) and AParent.CheckIsOwnerObjectLive(Result) and
      (aopLocation in AParent.GetSupportedProperties(cxAccessibleObjectSelfID)) then
    begin
      TVarData(AStartChildID).VType := VT_I4;
      AStartChildID := AParent.GetChildIndex(Self) + 1;
      if (AParent as IcxAccessible).accNavigate(navDir, AStartChildID, pvarEndUpAt) = S_OK then
        Result := S_OK;
    end;
  end;

  procedure NavigateToNeighboringChild;

    function GetNavigationDirection: TcxAccessibilityNavigationDirection;
    begin