cxaccessibility.pas

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

      case navDir of
        NAVDIR_DOWN: Result := andDown;
        NAVDIR_LEFT: Result := andLeft;
        NAVDIR_NEXT: Result := andNext;
        NAVDIR_PREVIOUS: Result := andPrev;
        NAVDIR_RIGHT: Result := andRight;
      else
        Result := andUp;
      end;
    end;

  var
    AChildIndex: Integer;
  begin
    if varStart > GetChildCount then
      Result := E_INVALIDARG
    else
      if not (aopLocation in GetSupportedProperties(cxAccessibleObjectSelfID)) then
        Result := DISP_E_MEMBERNOTFOUND
      else
      begin
        AChildIndex := NavigateToChild(varStart - 1, GetNavigationDirection);
        if AChildIndex <> varStart - 1 then
        begin
          TVarData(pvarEndUpAt).VType := VT_I4;
          pvarEndUpAt := AChildIndex + 1;
          Result := S_OK;
        end
        else
          Result := S_FALSE;
      end;
  end;

begin
  VariantInit(pvarEndUpAt);
  if not CheckIsOwnerObjectLive(Result) then
    Exit;
  if (navDir = NAVDIR_FIRSTCHILD) or (navDir = NAVDIR_LASTCHILD) then
    NavigateToFirstOrLastChild
  else
    if varStart = CHILDID_SELF then
      NavigateToNeighboringChildViaParent
    else
      NavigateToNeighboringChild;

  if Result = S_OK then
    CheckSimpleChildElementToBeReturned(pvarEndUpAt);
end;

function TcxAccessibilityHelper.accSelect(flagsSelect: Integer;
  varChild: OleVariant): HResult;
begin
  Result := DISP_E_MEMBERNOTFOUND; // TODO
end;

function TcxAccessibilityHelper.Get_accChild(varChild: OleVariant;
  out ppdispChild: IDispatch): HResult;
begin
  if not CheckIsOwnerObjectLive(Result) then
    Exit;
  if (TVarData(varChild).VType = VT_EMPTY) or (varChild > GetChildCount) then
    Result := E_INVALIDARG
  else
    if ChildIsSimpleElement(varChild - 1) then
      Result := S_FALSE
    else
    begin
      ppdispChild := GetChild(varChild - 1);
      Result := S_OK;
    end;
end;

function TcxAccessibilityHelper.Get_accChildCount(
  out pcountChildren: Integer): HResult;
begin
  if CheckIsOwnerObjectLive(Result) then
  begin
    pcountChildren := GetChildCount;
    Result := S_OK;
  end;
end;

function TcxAccessibilityHelper.Get_accDefaultAction(varChild: OleVariant;
  out pszDefaultAction: WideString): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
    if aopDefaultAction in GetSupportedProperties(ASimpleChildElementID) then
    begin
      pszDefaultAction := GetDefaultActionDescription(ASimpleChildElementID);
//      CheckStringToBeReturned(pszDefaultAction, Result);
      Result := S_OK;
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Get_accDescription(varChild: OleVariant;
  out pszDescription: WideString): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
    if aopDescription in GetSupportedProperties(ASimpleChildElementID) then
    begin
      pszDescription := GetDescription(ASimpleChildElementID);
      CheckStringToBeReturned(pszDescription, Result);
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Get_accFocus(
  out pvarChild: OleVariant): HResult;
var
  AFocusedChildIndex: Integer;
  AIsChildFocused: Boolean;
begin
  VariantInit(pvarChild);
  if CheckIsOwnerObjectLive(Result) then
    if aopFocus in GetSupportedProperties(cxAccessibleObjectSelfID) then
    begin
      if not Focused(AIsChildFocused, AFocusedChildIndex) then
        Result := S_FALSE
      else
      begin
        TVarData(pvarChild).VType := VT_I4;
        if not AIsChildFocused then
          pvarChild := CHILDID_SELF
        else
          pvarChild := AFocusedChildIndex + 1;
        CheckSimpleChildElementToBeReturned(pvarChild);
        Result := S_OK;
      end;
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Get_accHelp(varChild: OleVariant;
  out pszHelp: WideString): HResult;
begin
  Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Get_accHelpTopic(out pszHelpFile: WideString;
  varChild: OleVariant; out pidTopic: Integer): HResult;
begin
  Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Get_accKeyboardShortcut(varChild: OleVariant;
  out pszKeyboardShortcut: WideString): HResult;
var
  ACaption: string;
  AShortCut: TShortCut;
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
    if aopShortcut in GetSupportedProperties(ASimpleChildElementID) then
    begin
      GetKeyboardAccessParameters(ASimpleChildElementID, AShortCut, ACaption);
      if GetHotKey(ACaption) <> '' then
        pszKeyboardShortcut := UpperCase(GetHotKey(ACaption))
      else
        pszKeyboardShortcut := ShortCutToText(AShortCut);
      CheckStringToBeReturned(pszKeyboardShortcut, Result);
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Get_accName(varChild: OleVariant;
  out pszName: WideString): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
  begin
    pszName := GetName(ASimpleChildElementID);
    CheckStringToBeReturned(pszName, Result);
  end;
end;

function TcxAccessibilityHelper.Get_accParent(
  out ppdispParent: IDispatch): HResult;
var
  AParentWnd: HWND;
begin
  if CheckIsOwnerObjectLive(Result) then
  begin
    ppdispParent := GetParent;
    if (ppdispParent = nil) and (GetOwnerObjectWindow <> 0) then
    begin
      if IsChildClassWindow(GetOwnerObjectWindow) then
        AParentWnd := Windows.GetParent(GetOwnerObjectWindow)
      else
        AParentWnd := GetDesktopWindow;
      if cxGetAccessibleObjectFromWindow(AParentWnd, OBJID_WINDOW,
        IID_IcxAccessible, ppdispParent) <> S_OK then
          ppdispParent := nil;
    end;
    if ppdispParent <> nil then
      Result := S_OK
    else
      Result := S_FALSE;
  end;
end;

function TcxAccessibilityHelper.Get_accRole(varChild: OleVariant;
  out pvarRole: OleVariant): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
  begin
    TVarData(pvarRole).VType := VT_I4;
    pvarRole := GetRole(ASimpleChildElementID);
    Result := S_OK;
  end;
end;

function TcxAccessibilityHelper.Get_accSelection(
  out pvarChildren: OleVariant): HResult;
begin
  Result := DISP_E_MEMBERNOTFOUND; // TODO
end;

function TcxAccessibilityHelper.Get_accState(varChild: OleVariant;
  out pvarState: OleVariant): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
  begin
    TVarData(pvarState).VType := VT_I4;
    pvarState := GetState(ASimpleChildElementID);
    Result := S_OK;
  end;
end;

function TcxAccessibilityHelper.Get_accValue(varChild: OleVariant;
  out pszValue: WideString): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
    if aopValue in GetSupportedProperties(ASimpleChildElementID) then
    begin
      pszValue := GetValue(ASimpleChildElementID);
      Result := S_OK;
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Set_accName(varChild: OleVariant;
  const pszName: WideString): HResult;
begin
  Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.Set_accValue(varChild: OleVariant;
  const pszValue: WideString): HResult;
var
  ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
begin
  if GetSimpleChildElementID(varChild, ASimpleChildElementID, Result) then
    if aopValue in GetSupportedProperties(ASimpleChildElementID) then
    begin
      SetValue(ASimpleChildElementID, pszValue);
      Result := S_OK;
    end
    else
      Result := DISP_E_MEMBERNOTFOUND;
end;

function TcxAccessibilityHelper.CheckIsOwnerObjectLive(
  out AErrorCode: HResult): Boolean;
begin
  Result := FIsOwnerObjectLive;
  if not Result then
    AErrorCode := CO_E_OBJECTNOTCONNECTED;
end;

procedure TcxAccessibilityHelper.CheckSimpleChildElementToBeReturned(
  var AVarChild: OleVariant);
var
  AChild: TcxAccessibilityHelper;
begin
  if (AVarChild <> CHILDID_SELF) and
    not ChildIsSimpleElement(AVarChild - 1) then
  begin
    AChild := GetChild(AVarChild - 1);
    VariantInit(AVarChild);
    AVarChild := AChild as IDispatch;
    TVarData(AVarChild).VType := VT_DISPATCH;
  end;
end;

procedure TcxAccessibilityHelper.CheckStringToBeReturned(const AStr: WideString;
  out AResult: HResult);
begin
  if Length(AStr) <> 0 then
    AResult := S_OK
  else
    AResult := S_FALSE;
end;

function TcxAccessibilityHelper.GetSimpleChildElementID(AChildID: OleVariant;
  out ASimpleChildElementID: TcxAccessibleSimpleChildElementID;
  out AErrorCode: HResult): Boolean;
begin
  Result := CheckIsOwnerObjectLive(AErrorCode);
  if not Result then
    Exit;
  if AChildID = CHILDID_SELF then
    ASimpleChildElementID := cxAccessibleObjectSelfID
  else
    if (AChildID > GetChildCount) or not ChildIsSimpleElement(AChildID - 1) then
    begin
      AErrorCode := E_INVALIDARG;
      Result := False;
    end
    else
      ASimpleChildElementID := AChildID - 1;
end;

function TcxAccessibilityHelper.GetVisible: Boolean;
begin
  Result := States[cxAccessibleObjectSelfID] and cxSTATE_SYSTEM_INVISIBLE = 0;
end;

initialization
  FOleaccLibrary := LoadLibrary(OleaccLibraryName);
  if FOleaccLibrary <> 0 then
  begin
    FcxAccessibleObjectFromWindow := GetProcAddress(FOleaccLibrary, 'AccessibleObjectFromWindow');
    FcxLResultFromObject := GetProcAddress(FOleaccLibrary, 'LresultFromObject');
  end;

finalization
  if FOleaccLibrary <> 0 then
    FreeLibrary(FOleaccLibrary);

end.