777 lines
22 KiB
Plaintext
777 lines
22 KiB
Plaintext
unit VA508AccessibilityPE;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, SysUtils, DesignIntf, DesignEditors, DesignConst, TypInfo, Controls, StdCtrls,
|
|
Classes, Forms, VA508AccessibilityManager, Dialogs, ColnEdit, RTLConsts;
|
|
|
|
type
|
|
TVA508AccessibilityManager4PE = class(TVA508AccessibilityManager);
|
|
|
|
TVA508AccessibilityPropertyMapper = class(TStringProperty)
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetProperties(Proc: TGetPropProc); override;
|
|
end;
|
|
|
|
TVA508NestedPropertyType = (ptText, ptLabel, ptProperty, ptDefault); //, ptEvent);
|
|
|
|
TVA508NestedPropertyEditor = class(TNestedProperty)
|
|
strict private
|
|
FName: String;
|
|
FType: TVA508NestedPropertyType;
|
|
FManager: TVA508AccessibilityManager4PE;
|
|
protected
|
|
property Manager: TVA508AccessibilityManager4PE read FManager;
|
|
public
|
|
constructor Create(AParent: TVA508AccessibilityPropertyMapper;
|
|
AName: String; PType: TVA508NestedPropertyType);
|
|
function AllEqual: Boolean; override;
|
|
procedure Edit; override;
|
|
function GetEditLimit: Integer; override;
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
function GetName: string; override;
|
|
function GetValue: string; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
procedure SetValue(const Value: string); override;
|
|
end;
|
|
|
|
{
|
|
TVA508AccessibilityEventPropertyEditor = class(TVA508NestedPropertyEditor, IMethodProperty)
|
|
protected
|
|
function GetMethodValue(Index: Integer): TMethod;
|
|
public
|
|
function AllNamed: Boolean; virtual;
|
|
procedure Edit; override;
|
|
function GetValue: string; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
procedure SetValue(const AValue: string); override;
|
|
function GetFormMethodName: string; virtual;
|
|
function GetTrimmedEventName: string;
|
|
end;
|
|
}
|
|
|
|
TVA508CollectionPropertyEditor = class(TCollectionProperty)
|
|
public
|
|
function GetColOptions: TColOptions; override;
|
|
end;
|
|
|
|
TVA508AccessibilityLabelPropertyEditor = class(TComponentProperty)
|
|
private
|
|
FManager: TVA508AccessibilityManager4PE;
|
|
function GetManager: TVA508AccessibilityManager4PE;
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetProperties(Proc: TGetPropProc); override;
|
|
function GetValue: string; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
procedure SetValue(const Value: string); override;
|
|
end;
|
|
|
|
TVA508AccessibilityPropertyPropertyEditor = class(TStringProperty)
|
|
private
|
|
FManager: TVA508AccessibilityManager4PE;
|
|
function GetManager: TVA508AccessibilityManager4PE;
|
|
function GetRootComponent(index: integer): TWinControl;
|
|
public
|
|
function AllEqual: Boolean; override;
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
function GetEditLimit: Integer; override;
|
|
function GetValue: string; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
procedure SetValue(const Value: string); override;
|
|
end;
|
|
|
|
TVA508AccessibilityComponentPropertyEditor = class(TComponentProperty)
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
end;
|
|
|
|
const
|
|
WinControlPropertyToMap = 'Hint';
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
function GetAccessibilityManager(Editor: TPropertyEditor; Index: integer): TVA508AccessibilityManager4PE;
|
|
var
|
|
Control, Root: TComponent;
|
|
i: integer;
|
|
|
|
begin
|
|
Result := nil;
|
|
if assigned(Editor.GetComponent(Index)) and (Editor.GetComponent(Index) is TComponent) then
|
|
begin
|
|
Control := TComponent(Editor.GetComponent(Index));
|
|
Root := Control;
|
|
while (assigned(Root) and (not (Root is TCustomForm))) do
|
|
Root := Root.Owner;
|
|
if assigned(Root) and (Root is TCustomForm) then
|
|
begin
|
|
for i := 0 to Root.ComponentCount-1 do
|
|
begin
|
|
if Root.Components[i] is TVA508AccessibilityManager then
|
|
begin
|
|
Result := TVA508AccessibilityManager4PE(Root.Components[i]);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function AllComponentsHaveSameManager(Editor: TPropertyEditor): boolean;
|
|
var
|
|
i: integer;
|
|
manager: TVA508AccessibilityManager4PE;
|
|
begin
|
|
manager := GetAccessibilityManager(Editor, 0);
|
|
Result := assigned(manager);
|
|
if (not result) or (Editor.PropCount < 2) then exit;
|
|
for i := 1 to Editor.PropCount-1 do
|
|
begin
|
|
if (GetAccessibilityManager(Editor, i) <> manager) then
|
|
begin
|
|
Result := FALSE;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure GetStringPropertyNames(Manager: TVA508AccessibilityManager4PE;
|
|
Component: TWinControl; List: TStringList; Add: boolean);
|
|
var
|
|
i: Integer;
|
|
current: TStringList;
|
|
|
|
begin
|
|
current := TStringList.Create;
|
|
try
|
|
Manager.GetProperties(Component, current);
|
|
if Add then
|
|
list.Assign(current)
|
|
else
|
|
begin
|
|
for I := List.Count - 1 downto 0 do
|
|
begin
|
|
if current.IndexOf(list[i]) < 0 then
|
|
List.Delete(i);
|
|
end;
|
|
end;
|
|
finally
|
|
current.Free;
|
|
end;
|
|
end;
|
|
|
|
function QVal(txt: string): string;
|
|
begin
|
|
Result := '="' + txt + '"';
|
|
end;
|
|
|
|
function StripQVal(text: string): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i := pos('=', text);
|
|
if (i > 0) then
|
|
Result := copy(text,1,i-1)
|
|
else
|
|
Result := text;
|
|
end;
|
|
|
|
{ TVA508AccessibilityPropertyMapper }
|
|
|
|
const
|
|
DelphiPaletteName = 'VA 508';
|
|
|
|
|
|
function TVA508AccessibilityPropertyMapper.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
if AllComponentsHaveSameManager(Self) then
|
|
Result := [paMultiSelect, paRevertable, paSubProperties]
|
|
else
|
|
Result := inherited GetAttributes;
|
|
end;
|
|
|
|
procedure TVA508AccessibilityPropertyMapper.GetProperties(
|
|
Proc: TGetPropProc);
|
|
begin
|
|
if not AllComponentsHaveSameManager(Self) then exit;
|
|
Proc(TVA508NestedPropertyEditor.Create(Self, AccessibilityLabelPropertyName, ptLabel));
|
|
Proc(TVA508NestedPropertyEditor.Create(Self, AccessibilityPropertyPropertyName, ptProperty));
|
|
Proc(TVA508NestedPropertyEditor.Create(Self, AccessibilityTextPropertyName, ptText));
|
|
Proc(TVA508NestedPropertyEditor.Create(Self, AccessibilityUseDefaultPropertyName, ptDefault));
|
|
// Proc(TVA508AccessibilityEventPropertyEditor.Create(Self, AccessibilityEventPropertyName, ptEvent));
|
|
end;
|
|
|
|
{ TVA508NestedStringProperty }
|
|
|
|
function TVA508NestedPropertyEditor.AllEqual: Boolean;
|
|
var
|
|
i: Integer;
|
|
txt, prop: string;
|
|
lbl: TLabel;
|
|
// V, T: TMethod;
|
|
default: boolean;
|
|
|
|
begin
|
|
if PropCount > 1 then
|
|
begin
|
|
Result := False;
|
|
if not (GetComponent(0) is TWinControl) then exit;
|
|
case FType of
|
|
ptText:
|
|
begin
|
|
txt := FManager.AccessText[TWinControl(GetComponent(0))];
|
|
for i := 1 to PropCount - 1 do
|
|
if txt <> FManager.AccessText[TWinControl(GetComponent(i))] then exit;
|
|
end;
|
|
|
|
ptLabel:
|
|
begin
|
|
lbl := FManager.AccessLabel[TWinControl(GetComponent(0))];
|
|
for i := 1 to PropCount - 1 do
|
|
if lbl <> FManager.AccessLabel[TWinControl(GetComponent(i))] then exit;
|
|
end;
|
|
|
|
ptProperty:
|
|
begin
|
|
prop := FManager.AccessProperty[TWinControl(GetComponent(0))];
|
|
for i := 1 to PropCount - 1 do
|
|
if prop <> FManager.AccessProperty[TWinControl(GetComponent(i))] then exit;
|
|
end;
|
|
|
|
ptDefault:
|
|
begin
|
|
default := FManager.UseDefault[TWinControl(GetComponent(0))];
|
|
for i := 1 to PropCount - 1 do
|
|
if default <> FManager.UseDefault[TWinControl(GetComponent(i))] then exit;
|
|
end;
|
|
|
|
|
|
{ ptEvent:
|
|
begin
|
|
V := TMethod(FManager.OnComponentAccessRequest[TWinControl(GetComponent(0))]);
|
|
for i := 1 to PropCount - 1 do
|
|
begin
|
|
T := TMethod(FManager.OnComponentAccessRequest[TWinControl(GetComponent(i))]);
|
|
if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
|
|
end;
|
|
end;}
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
constructor TVA508NestedPropertyEditor.Create(AParent: TVA508AccessibilityPropertyMapper;
|
|
AName: String; PType: TVA508NestedPropertyType);
|
|
begin
|
|
inherited Create(AParent);
|
|
FManager := GetAccessibilityManager(AParent, 0);
|
|
FName := AName;
|
|
FType := PType;
|
|
end;
|
|
|
|
procedure TVA508NestedPropertyEditor.Edit;
|
|
var
|
|
lbl: TLabel;
|
|
|
|
begin
|
|
if (FType = ptLabel) and
|
|
(Designer.GetShiftState * [ssCtrl, ssLeft] = [ssCtrl, ssLeft]) then
|
|
begin
|
|
lbl := FManager.AccessLabel[TWinControl(GetComponent(0))];
|
|
if assigned(lbl) then
|
|
Designer.SelectComponent(lbl)
|
|
else
|
|
inherited Edit;
|
|
end
|
|
else
|
|
inherited Edit;
|
|
end;
|
|
|
|
function TVA508NestedPropertyEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
case FType of
|
|
ptText:
|
|
Result := [paMultiSelect, paRevertable, paAutoUpdate];
|
|
ptLabel, ptProperty:
|
|
Result := [paMultiSelect, paRevertable, paValueList, paSortList, paAutoUpdate];
|
|
ptDefault:
|
|
Result := [paMultiSelect, paValueList, paSortList, paRevertable];
|
|
|
|
// ptEvent:
|
|
// Result := [paMultiSelect, paValueList, paSortList, paRevertable];
|
|
else
|
|
Result := [];
|
|
end;
|
|
|
|
end;
|
|
|
|
function TVA508NestedPropertyEditor.GetEditLimit: Integer;
|
|
begin
|
|
case FType of
|
|
ptText: Result := 32767;
|
|
ptDefault : Result := 63;
|
|
// ptEvent: Result := MaxIdentLength;
|
|
else // ptLabel, ptProperty:
|
|
Result := 127;
|
|
end;
|
|
end;
|
|
|
|
function TVA508NestedPropertyEditor.GetName: string;
|
|
begin
|
|
Result := FName;
|
|
end;
|
|
|
|
function TVA508NestedPropertyEditor.GetValue: string;
|
|
var
|
|
lbl: TLabel;
|
|
Default: boolean;
|
|
begin
|
|
Result := '';
|
|
if not (GetComponent(0) is TWinControl) then exit;
|
|
case FType of
|
|
ptLabel:
|
|
begin
|
|
lbl := FManager.AccessLabel[TWinControl(GetComponent(0))];
|
|
if assigned(lbl) then
|
|
Result := FManager.GetComponentName(lbl) + QVal(lbl.Caption);
|
|
end;
|
|
ptText:
|
|
Result := FManager.AccessText[TWinControl(GetComponent(0))];
|
|
ptProperty:
|
|
begin
|
|
Result := FManager.AccessProperty[TWinControl(GetComponent(0))];
|
|
if Result <> '' then
|
|
Result := Result + QVal(GetPropValue(GetComponent(0), Result));
|
|
end;
|
|
ptDefault:
|
|
begin
|
|
Default := FManager.UseDefault[TWinControl(GetComponent(0))];
|
|
Result := GetEnumName(TypeInfo(Boolean), Ord(Default));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TVA508NestedPropertyEditor.GetValues(Proc: TGetStrProc);
|
|
var
|
|
list: TStringList;
|
|
i: integer;
|
|
name: string;
|
|
|
|
begin
|
|
list := TStringList.Create;
|
|
try
|
|
case FType of
|
|
ptLabel:
|
|
begin
|
|
FManager.GetLabelStrings(list);
|
|
for i := 0 to list.count-1 do
|
|
Proc(list[i]);
|
|
end;
|
|
|
|
ptProperty:
|
|
begin
|
|
GetStringPropertyNames(FManager, TWinControl(GetComponent(0)), list, TRUE);
|
|
if PropCount > 1 then
|
|
begin
|
|
for i := 1 to PropCount-1 do
|
|
begin
|
|
if GetComponent(i) is TWinControl then
|
|
GetStringPropertyNames(FManager, TWinControl(GetComponent(i)), list, FALSE);
|
|
end;
|
|
end;
|
|
list.Sort;
|
|
for i := 0 to list.count-1 do
|
|
begin
|
|
name := list[i];
|
|
if PropCount = 1 then
|
|
name := name + QVal(GetPropValue(GetComponent(0), name));
|
|
Proc(name);
|
|
end;
|
|
end;
|
|
|
|
ptDefault:
|
|
begin
|
|
Proc(GetEnumName(TypeInfo(Boolean), Ord(False)));
|
|
Proc(GetEnumName(TypeInfo(Boolean), Ord(True)));
|
|
end;
|
|
|
|
end;
|
|
finally
|
|
list.free;
|
|
end;
|
|
end;
|
|
|
|
procedure TVA508NestedPropertyEditor.SetValue(const Value: string);
|
|
var
|
|
i, BVal: Integer;
|
|
lbl: TLabel;
|
|
cmp: TComponent;
|
|
Name: String;
|
|
|
|
begin
|
|
BVal := Ord(FALSE);
|
|
lbl := nil;
|
|
case FType of
|
|
|
|
ptLabel:
|
|
begin
|
|
Name := StripQVal(Value);
|
|
cmp := Designer.GetComponent(Name);
|
|
if (cmp is TLabel) then
|
|
lbl := TLabel(cmp);
|
|
end;
|
|
|
|
ptProperty: Name := StripQVal(Value);
|
|
|
|
ptDefault:
|
|
begin
|
|
BVal := GetEnumValue(TypeInfo(Boolean), Value);
|
|
with GetTypeData(TypeInfo(Boolean))^ do
|
|
if (BVal < MinValue) or (BVal > MaxValue) then
|
|
raise EPropertyError.CreateRes(@SInvalidPropertyValue);
|
|
end;
|
|
|
|
end;
|
|
for i := 0 to PropCount - 1 do
|
|
begin
|
|
if GetComponent(i) is TWinControl then
|
|
begin
|
|
case FType of
|
|
ptText: FManager.AccessText[TWinControl(GetComponent(i))] := Value;
|
|
ptLabel: FManager.AccessLabel[TWinControl(GetComponent(i))] := lbl;
|
|
ptProperty: FManager.AccessProperty[TWinControl(GetComponent(i))] := Name;
|
|
ptDefault: FManager.UseDefault[TWinControl(GetComponent(i))] := Boolean(BVal);
|
|
end;
|
|
end;
|
|
end;
|
|
Modified;
|
|
end;
|
|
|
|
(*
|
|
{ TVA508AccessibilityEventPropertyEditor }
|
|
|
|
function TVA508AccessibilityEventPropertyEditor.AllNamed: Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
for I := 0 to PropCount - 1 do
|
|
if GetComponent(I).GetNamePath = '' then
|
|
begin
|
|
Result := False;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TVA508AccessibilityEventPropertyEditor.Edit;
|
|
var
|
|
FormMethodName: string;
|
|
CurDesigner: IDesigner;
|
|
begin
|
|
CurDesigner := Designer; { Local property so if designer is nil'ed out, no AV will happen }
|
|
if not AllNamed then
|
|
raise EPropertyError.CreateRes(@SCannotCreateName);
|
|
FormMethodName := GetValue;
|
|
if (FormMethodName = '') or
|
|
CurDesigner.MethodFromAncestor(GetMethodValue(0)) then
|
|
begin
|
|
if FormMethodName = '' then
|
|
FormMethodName := GetFormMethodName;
|
|
if FormMethodName = '' then
|
|
raise EPropertyError.CreateRes(@SCannotCreateName);
|
|
SetValue(FormMethodName);
|
|
end;
|
|
CurDesigner.ShowMethod(FormMethodName);
|
|
end;
|
|
|
|
function TVA508AccessibilityEventPropertyEditor.GetFormMethodName: string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if GetComponent(0) = Designer.GetRoot then
|
|
begin
|
|
Result := Designer.GetRootClassName;
|
|
if (Result <> '') and (Result[1] = 'T') then
|
|
Delete(Result, 1, 1);
|
|
end
|
|
else
|
|
begin
|
|
Result := Designer.GetObjectName(GetComponent(0));
|
|
for I := Length(Result) downto 1 do
|
|
if Result[I] in ['.', '[', ']', '-', '>'] then
|
|
Delete(Result, I, 1);
|
|
end;
|
|
if Result = '' then
|
|
raise EPropertyError.CreateRes(@SCannotCreateName);
|
|
Result := Result + GetTrimmedEventName;
|
|
end;
|
|
|
|
function TVA508AccessibilityEventPropertyEditor.GetMethodValue(Index: Integer): TMethod;
|
|
begin
|
|
if not (GetComponent(Index) is TWinControl) then
|
|
begin
|
|
Result.Code := nil;
|
|
Result.Data := nil;
|
|
end
|
|
else
|
|
Result := TMethod(Manager.OnComponentAccessRequest[TWinControl(GetComponent(Index))]);
|
|
end;
|
|
|
|
{ TVA508AccessibilityEventPropertyEditor }
|
|
|
|
function TVA508AccessibilityEventPropertyEditor.GetTrimmedEventName: string;
|
|
begin
|
|
Result := GetName;
|
|
if (Length(Result) >= 2) and
|
|
(Result[1] in ['O', 'o']) and (Result[2] in ['N', 'n']) then
|
|
Delete(Result,1,2);
|
|
end;
|
|
|
|
function TVA508AccessibilityEventPropertyEditor.GetValue: string;
|
|
begin
|
|
Result := Designer.GetMethodName(GetMethodValue(0));
|
|
end;
|
|
|
|
procedure TVA508AccessibilityEventPropertyEditor.GetValues(Proc: TGetStrProc);
|
|
begin
|
|
Designer.GetMethods(GetTypeData(TypeInfo(TVA508ComponentScreenReaderEvent)), Proc);
|
|
end;
|
|
|
|
procedure TVA508AccessibilityEventPropertyEditor.SetValue(const AValue: string);
|
|
|
|
var
|
|
CurDesigner: IDesigner;
|
|
|
|
procedure CheckChainCall(const MethodName: string; Method: TMethod);
|
|
var
|
|
Persistent: TPersistent;
|
|
Component: TComponent;
|
|
InstanceMethod: string;
|
|
Instance: TComponent;
|
|
begin
|
|
Persistent := GetComponent(0);
|
|
if Persistent is TComponent then
|
|
begin
|
|
Component := TComponent(Persistent);
|
|
if (Component.Name <> '') and (Method.Data <> CurDesigner.GetRoot) and
|
|
(TObject(Method.Data) is TComponent) then
|
|
begin
|
|
Instance := TComponent(Method.Data);
|
|
InstanceMethod := Instance.MethodName(Method.Code);
|
|
if InstanceMethod <> '' then
|
|
CurDesigner.ChainCall(MethodName, Instance.Name, InstanceMethod,
|
|
GetTypeData(TypeInfo(TVA508ComponentScreenReaderEvent)));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
NewMethod: Boolean;
|
|
CurValue: string;
|
|
OldMethod: TMethod;
|
|
i: integer;
|
|
event: TVA508ComponentScreenReaderEvent;
|
|
begin
|
|
CurDesigner := Designer;
|
|
if not AllNamed then
|
|
raise EPropertyError.CreateRes(@SCannotCreateName);
|
|
CurValue:= GetValue;
|
|
if (CurValue <> '') and (AValue <> '') and (SameText(CurValue, AValue) or
|
|
not CurDesigner.MethodExists(AValue)) and
|
|
not CurDesigner.MethodFromAncestor(GetMethodValue(0)) then
|
|
CurDesigner.RenameMethod(CurValue, AValue)
|
|
else
|
|
begin
|
|
NewMethod := (AValue <> '') and not CurDesigner.MethodExists(AValue);
|
|
OldMethod := GetMethodValue(0);
|
|
event := TVA508ComponentScreenReaderEvent(CurDesigner.CreateMethod(AValue, GetTypeData(TypeInfo(TVA508ComponentScreenReaderEvent))));
|
|
for i := 0 to PropCount - 1 do
|
|
begin
|
|
if (GetComponent(i) is TWinControl) then
|
|
Manager.OnComponentAccessRequest[TWinControl(GetComponent(i))] := event;
|
|
end;
|
|
if NewMethod then
|
|
begin
|
|
{ Designer may have been nil'ed out this point when the code editor
|
|
recieved focus. This fixes an AV by using a local variable which
|
|
keeps a reference to the designer }
|
|
if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil) then
|
|
CheckChainCall(AValue, OldMethod);
|
|
CurDesigner.ShowMethod(AValue);
|
|
end;
|
|
end;
|
|
Modified;
|
|
end;
|
|
|
|
*)
|
|
|
|
{ TVA508CollectionProperty }
|
|
|
|
function TVA508CollectionPropertyEditor.GetColOptions: TColOptions;
|
|
begin
|
|
Result := [coMove];
|
|
end;
|
|
|
|
|
|
{ TVA508AccessibilityLabelPropertyEditor }
|
|
|
|
function TVA508AccessibilityLabelPropertyEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := [paMultiSelect, paRevertable, paValueList, paSortList, paAutoUpdate];
|
|
end;
|
|
|
|
function TVA508AccessibilityLabelPropertyEditor.GetManager: TVA508AccessibilityManager4PE;
|
|
begin
|
|
if not assigned(FManager) then
|
|
FManager := TVA508AccessibilityManager4PE(TVA508AccessibilityItem(GetComponent(0)).Manager);
|
|
Result := FManager;
|
|
end;
|
|
|
|
procedure TVA508AccessibilityLabelPropertyEditor.GetProperties(
|
|
Proc: TGetPropProc);
|
|
begin
|
|
exit;
|
|
end;
|
|
|
|
function TVA508AccessibilityLabelPropertyEditor.GetValue: string;
|
|
var
|
|
lbl: TLabel;
|
|
begin
|
|
lbl := TVA508AccessibilityItem(GetComponent(0)).AccessLabel;
|
|
if assigned(lbl) then
|
|
Result := GetManager.GetComponentName(lbl) + QVal(lbl.Caption);
|
|
end;
|
|
|
|
procedure TVA508AccessibilityLabelPropertyEditor.GetValues(Proc: TGetStrProc);
|
|
var
|
|
i: integer;
|
|
list: TStringList;
|
|
begin
|
|
list := TStringList.Create;
|
|
try
|
|
GetManager.GetLabelStrings(list);
|
|
for i := 0 to list.count-1 do
|
|
Proc(list[i]);
|
|
finally
|
|
list.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TVA508AccessibilityLabelPropertyEditor.SetValue(const Value: string);
|
|
begin
|
|
inherited SetValue(StripQVal(Value));
|
|
end;
|
|
|
|
{ TVA508AccessibilityPropertyPropertyEditor }
|
|
|
|
function TVA508AccessibilityPropertyPropertyEditor.AllEqual: Boolean;
|
|
var
|
|
i: integer;
|
|
prop: string;
|
|
begin
|
|
if PropCount > 1 then
|
|
begin
|
|
Result := FALSE;
|
|
prop := GetManager.AccessProperty[TWinControl(GetComponent(0))];
|
|
for i := 1 to PropCount - 1 do
|
|
if prop <> FManager.AccessProperty[TWinControl(GetComponent(i))] then exit;
|
|
end;
|
|
Result := TRUE;
|
|
end;
|
|
|
|
function TVA508AccessibilityPropertyPropertyEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := [paMultiSelect, paRevertable, paValueList, paSortList, paAutoUpdate];
|
|
end;
|
|
|
|
function TVA508AccessibilityPropertyPropertyEditor.GetEditLimit: Integer;
|
|
begin
|
|
Result := 127;
|
|
end;
|
|
|
|
function TVA508AccessibilityPropertyPropertyEditor.GetManager: TVA508AccessibilityManager4PE;
|
|
begin
|
|
if not assigned(FManager) then
|
|
FManager := TVA508AccessibilityManager4PE(TVA508AccessibilityItem(GetComponent(0)).Manager);
|
|
Result := FManager;
|
|
end;
|
|
|
|
function TVA508AccessibilityPropertyPropertyEditor.GetRootComponent(
|
|
index: integer): TWinControl;
|
|
begin
|
|
Result := TVA508AccessibilityItem(GetComponent(index)).Component;
|
|
end;
|
|
|
|
function TVA508AccessibilityPropertyPropertyEditor.GetValue: string;
|
|
begin
|
|
Result := inherited GetValue;
|
|
if Result <> '' then
|
|
Result := Result + QVal(GetPropValue(GetRootComponent(0), Result));
|
|
end;
|
|
|
|
procedure TVA508AccessibilityPropertyPropertyEditor.GetValues(
|
|
Proc: TGetStrProc);
|
|
var
|
|
list: TStringList;
|
|
i: integer;
|
|
name: string;
|
|
|
|
begin
|
|
list := TStringList.Create;
|
|
try
|
|
GetStringPropertyNames(GetManager, GetRootComponent(0), list, TRUE);
|
|
if PropCount > 1 then
|
|
begin
|
|
for i := 1 to PropCount-1 do
|
|
GetStringPropertyNames(FManager, GetRootComponent(i), list, FALSE);
|
|
end;
|
|
list.Sort;
|
|
for i := 0 to list.count-1 do
|
|
begin
|
|
name := list[i];
|
|
if PropCount = 1 then
|
|
name := name + QVal(GetPropValue(GetRootComponent(0), name));
|
|
Proc(name);
|
|
end;
|
|
finally
|
|
list.free;
|
|
end;
|
|
end;
|
|
|
|
procedure TVA508AccessibilityPropertyPropertyEditor.SetValue(
|
|
const Value: string);
|
|
begin
|
|
inherited SetValue(StripQVal(Value));
|
|
end;
|
|
|
|
{ TVA508AccessibilityClassPropertyEditor }
|
|
|
|
function TVA508AccessibilityComponentPropertyEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := [paDisplayReadOnly];
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DelphiPaletteName, [TVA508AccessibilityManager, TVA508ComponentAccessibility,
|
|
TVA508StaticText]);
|
|
RegisterPropertyEditor(TypeInfo(TVA508AccessibilityCollection),
|
|
TVA508AccessibilityManager, VA508DataPropertyName, TVA508CollectionPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(String), TWinControl, WinControlPropertyToMap,
|
|
TVA508AccessibilityPropertyMapper);
|
|
RegisterPropertyEditor(TypeInfo(TLabel), TVA508AccessibilityItem, AccessibilityLabelPropertyName,
|
|
TVA508AccessibilityLabelPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(String), TVA508AccessibilityItem, AccessibilityPropertyPropertyName,
|
|
TVA508AccessibilityPropertyPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TComponent), TVA508AccessibilityItem, AccessDataComponentText,
|
|
TVA508AccessibilityComponentPropertyEditor);
|
|
end;
|
|
|
|
end.
|
|
|