unit1.pas

Microsoft accessible接口的delphi实现

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,oleacc, ExtCtrls, Spin, ComCtrls, ImgList;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    BoutonSuiviSouris: TButton;
    BoutonGetParent: TButton;
    BoutonFirstChild: TButton;
    BoutonPrevious: TButton;
    BoutonNext: TButton;
    Boutonlastchild: TButton;
    BoutonUp: TButton;
    BoutonDown: TButton;
    BoutonRight: TButton;
    BoutonLeft: TButton;
    Bevel1: TBevel;
    StaticText1: TStaticText;
    Bevel2: TBevel;
    StaticText2: TStaticText;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    BoutonValeur: TButton;
    BoutonArbre: TButton;
    ImageList1: TImageList;
    TreeView: TTreeView;
    Image1: TImage;
    Edit7: TEdit;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    BoutonAction: TButton;
    MemoInfo: TMemo;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BoutonSuiviSourisClick(Sender: TObject);
    procedure BoutonGetParentClick(Sender: TObject);
    procedure BoutonFirstChildClick(Sender: TObject);
    procedure BoutonlastchildClick(Sender: TObject);
    procedure BoutonPreviousClick(Sender: TObject);
    procedure BoutonNextClick(Sender: TObject);
    procedure BoutonUpClick(Sender: TObject);
    procedure BoutonDownClick(Sender: TObject);
    procedure BoutonRightClick(Sender: TObject);
    procedure BoutonLeftClick(Sender: TObject);
    procedure BoutonValeurClick(Sender: TObject);
    procedure BoutonArbreClick(Sender: TObject);
    procedure TreeViewClick(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure BoutonActionClick(Sender: TObject);
  private
    { D閏larations pri閑s }
  public
    { D閏larations publiques }
  end;

type
 composant=record handle:hwnd;pvar:variant;PAcc:IAccessible; end;
 Pcomposant=^composant;

var
  Form1: TForm1;
  pt:tpoint;
  Acc,accchild:IAccessible;
  VarParent:variant;
  res:hresult;
  xim,yim:integer;
  fond:tbitmap;

implementation


{$R *.dfm}

function max(a,b:integer):integer;
begin
 if a>b then result:=a else result:=b;
end;

function getAccstate(state:longint):string;
var
 n,i:longint;
 r:array[0..255]of char;
 s:string;
begin
 s:='';
 n:=1;
 for i:=1 to 29 do
 begin
  if state and n<>0 then
   begin
    getstatetext(n,@r,255);
    if s<>'' then s:=s+' -- ';
    s:=s+r;
   end;
  n:=n*2;
 end;
 result:=s;
end;

function getAccrole(role:longint):string;
var
 r:array[0..255]of char;
begin
 getroletext(role,@r,255);
 result:=r;
end;

function GetaccFocus(v:variant):string;
begin
case vartype(v) of
 VarEmpty:result:='Cet objet et ses enfants n''ont pas le focus clavier.';
 VarInteger:
   if v=CHILDID_SELF then result:='Cet object lui-m阭e a le focus clavier.'
                     else result:='L''enfant num閞o '+inttostr(v)+'a le focus clavier.';
 VarDispatch: result:='Un enfant a le focus clavier (IDispatch)';
end;
end;

function GetaccSelection(v:variant):string;
begin
case vartype(v) of
 VarEmpty:result:='Cet objet ou ses enfants ne sont pas s閘ectionn閟.';
 VarInteger:
   if v=CHILDID_SELF then result:='Cet object lui-m阭e est s閘ectionn