'취미생활'에 해당되는 글 1건

  1. 2014.01.10 creating accessible ui components in delphi
2014.01.10 10:48

unit mainAcc;

interface

uses
    Winapi
.Windows,
    Winapi
.Messages,
    System
.SysUtils,
    System
.Variants,
    System
.Classes,
    Vcl
.Graphics,
    Vcl
.Controls,
    Vcl
.Forms,
    Vcl
.Dialogs,
    Vcl
.StdCtrls,
    Vcl
.ComCtrls,
    Vcl
.ExtCtrls,
    oleacc
;

type

TForm1 = class(TForm)
        lblFirstName
: TLabel; btnGetAccInfo: TButton;
        accInfoOutput
: TEdit;
       
procedure btnGetAccInfoClick(Sender: TObject);
       
procedure FormCreate(Sender: TObject);
       
procedure FormClose(Sender: TObject; var Action: TCloseAction);
    private
       
{ Private declarations }
        aEdit
: TTWEdit;
        FAccProperties
: TStringList;
    public
       
{ Public declarations }
   
end;

    TAccessibleEdit
= class(TEdit, IAccessible)
    private
        FOwner
: TComponent;
        FAccessibleItem
: IAccessible;
        FAccessibleName
: string;
        FAccessibleDescription
: string;
       
procedure WMGetMSAAObject(var Message : TMessage); message WM_GETOBJECT;
       
// IAccessible
       
function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
       
function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
       
function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
       
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
       
function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
       
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
       
function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
       
function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
       
function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
       
function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
                                                            out pidTopic
: Integer): HResult; stdcall;
       
function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
       
function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
       
function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
       
function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
       
function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
       
function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer;
                                                 out pcyHeight
: Integer; varChild: OleVariant): HResult; stdcall;
       
function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
       
function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
       
function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
       
function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
       
function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
    protected
       
function QueryInterface(const IID: TGUID; out Obj): HResult; override;
    public
       
constructor Create(AOwner: TComponent); override;
    published
       
property AccessibleItem: IAccessible read FAccessibleItem write FAccessibleItem;
       
property AccessibleName: string read FAccessibleName write FAccessibleName;
       
property AccessibleDescription: string read FAccessibleDescription write FAccessibleDescription;
   
end;

var
    Form1
: TForm1;

implementation

{$R *.dfm}

{------------------------------------------------------------------------------}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   
inherited;
    FreeAndNil
(aEdit);
end;

{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
    aEdit
:= TAccessibleEdit.Create(self);
    aEdit
.Visible := true;
    aEdit
.Parent := Form1;
    aEdit
.Left := 91;
    aEdit
.Top := 17;
    aEdit
.Height := 21;
    aEdit
.Width := 204;
    aEdit
.Hint := 'This is a custom accessible edit control hint';
end;

{------------------------------------------------------------------------------}
procedure TForm1.btnGetAccInfoClick(Sender: TObject);
var
    vWSTemp
: WideString;
    vAccObj
: IAccessible;
begin
    FAccProperties
:= TStringList.Create;
   
if (AccessibleObjectFromWindow(aEdit.Handle, OBJID_CLIENT, IID_IAccessible, vAccObj) = S_OK) then
   
begin
        vAccObj
.Get_accName(CHILDID_SELF, vWSTemp);
        FAccProperties
.Add('Name: ' + vWSTemp);
        vWSTemp
:= '';
        vAccObj
.Get_accDescription(CHILDID_SELF, vWSTemp);
        FAccProperties
.Add('Description: ' + vWSTemp);
        vWSTemp
:= '';
        vAccObj
.Get_accValue(CHILDID_SELF, vWSTemp);
        FAccProperties
.Add('Value: ' + vWSTemp);
   
end;
    accInfoOutput
.Text := FAccProperties.Text;
end;


       
{ TAccessibleEdit }
   
{------------------------------------------------------------------------------}
   
constructor TAccessibleEdit.Create(AOwner: TComponent);
   
begin
       
inherited Create(AOwner);
        FOwner
:= AOwner;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.QueryInterface(const IID: TGUID; out Obj): HResult;
   
begin
       
if GetInterface(IID, Obj) then
            Result
:= 0
       
else
            Result
:= E_NOINTERFACE;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.accDoDefaultAction(varChild: OleVariant): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.accHitTest(xLeft, yTop: Integer;
        out pvarChild
: OleVariant): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.accLocation(out pxLeft, pyTop, pcxWidth, pcyHeight: Integer;
        varChild
: OleVariant): HResult;
   
var
        P
: TPoint;
   
begin
        Result
:= S_FALSE;
        pxLeft
:= 0;
        pyTop
:= 0;
        pcxWidth
:= 0;
        pcyHeight
:= 0;
       
if varChild = CHILDID_SELF then
       
begin
            P
:= self.ClientToScreen(self.ClientRect.TopLeft);
            pxLeft
:= P.X;
            pyTop
:= P.Y;
            pcxWidth
:= self.Width;
            pcyHeight
:= self.Height;
            Result
:= S_OK;
       
end
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.accNavigate(navDir: Integer; varStart: OleVariant;
        out pvarEndUpAt
: OleVariant): HResult;
   
begin
        result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accChild(varChild: OleVariant;
        out ppdispChild
: IDispatch): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accChildCount(out pcountChildren: Integer): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accDefaultAction(varChild: OleVariant;
        out pszDefaultAction
: WideString): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accDescription(varChild: OleVariant;
        out pszDescription
: WideString): HResult;
   
begin
        pszDescription
:= '';
        result
:= S_FALSE;
       
if varChild = CHILDID_SELF then
       
begin
            pszDescription
:= 'TAccessibleEdit_AccessibleDescription';
            Result
:= S_OK;
       
end;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accFocus(out pvarChild: OleVariant): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accHelp(varChild: OleVariant;
        out pszHelp
: WideString): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accHelpTopic(out pszHelpFile: WideString;
        varChild
: OleVariant; out pidTopic: Integer): HResult;
   
begin
        pszHelpFile
:= '';
        pidTopic
:= 0;
        Result
:= S_FALSE;
       
if varChild = CHILDID_SELF then
       
begin
            pszHelpFile
:= '';
            pidTopic
:= self.HelpContext;
            Result
:= S_OK;
       
end;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accKeyboardShortcut(varChild: OleVariant;
        out pszKeyboardShortcut
: WideString): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
   
begin
        pszName
:= '';
        Result
:= S_FALSE;
       
if varChild = CHILDID_SELF then
       
begin
            pszName
:= 'TAccessibleEdit_AccessibleName';
            result
:= S_OK;
       
end;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accParent(out ppdispParent: IDispatch): HResult;
   
begin
        ppdispParent
:= nil;
        result
:= AccessibleObjectFromWindow(self.ParentWindow, CHILDID_SELF, IID_IAccessible, Pointer(ppDispParent));
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accRole(varChild: OleVariant;
        out pvarRole
: OleVariant): HResult;
   
begin
        Result
:= S_OK;
       
if varChild = CHILDID_SELF then
            pvarRole
:= ROLE_SYSTEM_OUTLINE;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accSelection(out pvarChildren: OleVariant): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accState(varChild: OleVariant;
        out pvarState
: OleVariant): HResult;
   
begin
        Result
:= S_OK;
       
if varChild = CHILDID_SELF then
            pvarState
:= STATE_SYSTEM_FOCUSED;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Get_accValue(varChild: OleVariant;
        out pszValue
: WideString): HResult;
   
begin
        pszValue
:= '';
        Result
:= S_FALSE;
       
if varChild = CHILDID_SELF then
       
begin
            pszValue
:= WideString(self.Text);
            result
:= S_OK;
       
end;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Set_accName(varChild: OleVariant;
       
const pszName: WideString): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
function TAccessibleEdit.Set_accValue(varChild: OleVariant;
       
const pszValue: WideString): HResult;
   
begin
        Result
:= DISP_E_MEMBERNOTFOUND;
   
end;

   
{------------------------------------------------------------------------------}
   
procedure TAccessibleEdit.WMGetMSAAObject(var Message : TMessage);
   
begin
       
if (Message.Msg = WM_GETOBJECT) then
       
begin
            QueryInterface
(IID_IAccessible, FAccessibleItem);
            Message
.Result := LresultFromObject(IID_IAccessible, Message.WParam, FAccessibleItem);
       
end
       
else
            Message
.Result := DefWindowProc(Handle, Message.Msg, Message.WParam, Message.LParam);
   
end;

   
end.

 

 

출처: http://stackoverflow.com/questions/16320914/creating-accessible-ui-components-in-delphi

'취미생활 > Delphi' 카테고리의 다른 글

creating accessible ui components in delphi  (0) 2014.01.10
Posted by 향긋한 바람 느낌

티스토리 툴바