mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
Update VirtualTree component to r320
This commit is contained in:
Ansgar Becker
@ -7,26 +7,14 @@ interface
|
||||
|
||||
{$include Compilers.inc}
|
||||
|
||||
{$ifdef COMPILER_7_UP}
|
||||
// For some things to work we need code, which is classified as being unsafe for .NET.
|
||||
{$warn UNSAFE_TYPE off}
|
||||
{$warn UNSAFE_CAST off}
|
||||
{$warn UNSAFE_CODE off}
|
||||
{$endif COMPILER_7_UP}
|
||||
|
||||
{$ifdef COMPILER_4}
|
||||
{$R 'VirtualTreesD.dcr'}
|
||||
{$endif COMPILER_4}
|
||||
// For some things to work we need code, which is classified as being unsafe for .NET.
|
||||
{$warn UNSAFE_TYPE off}
|
||||
{$warn UNSAFE_CAST off}
|
||||
{$warn UNSAFE_CODE off}
|
||||
|
||||
uses
|
||||
Windows, Classes,
|
||||
{$ifdef COMPILER_6_UP}
|
||||
DesignIntf, DesignEditors, VCLEditors, PropertyCategories,
|
||||
{$else}
|
||||
DsgnIntf,
|
||||
{$endif}
|
||||
ColnEdit,
|
||||
VirtualTrees, VTHeaderPopup;
|
||||
Windows, Classes, DesignIntf, DesignEditors, VCLEditors, PropertyCategories,
|
||||
ColnEdit, VirtualTrees, VTHeaderPopup;
|
||||
|
||||
type
|
||||
TVirtualTreeEditor = class (TDefaultEditor)
|
||||
@ -41,18 +29,13 @@ procedure Register;
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef COMPILER_5_UP}
|
||||
StrEdit,
|
||||
{$else}
|
||||
StrEditD4,
|
||||
{$endif COMPILER_5_UP}
|
||||
Dialogs, TypInfo, SysUtils, Graphics, CommCtrl, ImgList, Controls;
|
||||
StrEdit, Dialogs, TypInfo, SysUtils, Graphics, CommCtrl, ImgList, Controls;
|
||||
|
||||
type
|
||||
// The usual trick to make a protected property accessible in the ShowCollectionEditor call below.
|
||||
TVirtualTreeCast = class(TBaseVirtualTree);
|
||||
|
||||
TClipboardElement = class(TNestedProperty {$ifdef COMPILER_6_UP}, ICustomPropertyDrawing {$endif COMPILER_6_UP})
|
||||
TClipboardElement = class(TNestedProperty, ICustomPropertyDrawing)
|
||||
private
|
||||
FElement: string;
|
||||
protected
|
||||
@ -65,79 +48,37 @@ type
|
||||
procedure GetValues(Proc: TGetStrProc); override;
|
||||
procedure SetValue(const Value: string); override;
|
||||
|
||||
{$ifdef COMPILER_5_UP}
|
||||
{$ifdef COMPILER_6_UP}
|
||||
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
{$endif COMPILER_6_UP}
|
||||
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
{$ifndef COMPILER_6_UP} override; {$endif COMPILER_6_UP}
|
||||
{$endif COMPILER_5_UP}
|
||||
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
end;
|
||||
|
||||
// This is a special property editor to make the strings in the clipboard format string list
|
||||
// being shown as subproperties in the object inspector. This way it is shown what formats are actually available
|
||||
// and the user can pick them with a simple yes/no choice.
|
||||
|
||||
{$ifdef COMPILER_6_UP}
|
||||
TGetPropEditProc = TGetPropProc;
|
||||
{$endif}
|
||||
TGetPropEditProc = TGetPropProc;
|
||||
|
||||
TClipboardFormatsProperty = class(TStringListProperty {$ifdef COMPILER_6_UP}, ICustomPropertyDrawing {$endif COMPILER_6_UP})
|
||||
TClipboardFormatsProperty = class(TStringListProperty, ICustomPropertyDrawing)
|
||||
public
|
||||
function GetAttributes: TPropertyAttributes; override;
|
||||
procedure GetProperties(Proc: TGetPropEditProc); override;
|
||||
{$ifdef COMPILER_5_UP}
|
||||
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
{$ifndef COMPILER_6_UP} override; {$endif}
|
||||
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
{$ifndef COMPILER_6_UP} override; {$endif}
|
||||
{$endif}
|
||||
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
end;
|
||||
|
||||
// Property categories. They are defined this way only for Delphi 5 & BCB 5.
|
||||
{$ifdef COMPILER_5}
|
||||
TVTHeaderCategory = class(TPropertyCategory)
|
||||
public
|
||||
class function Name: string; override;
|
||||
class function Description: string; override;
|
||||
end;
|
||||
|
||||
TVTPaintingCategory = class(TPropertyCategory)
|
||||
public
|
||||
class function Name: string; override;
|
||||
class function Description: string; override;
|
||||
end;
|
||||
|
||||
TVTIncrementalSearchCategory = class(TPropertyCategory)
|
||||
public
|
||||
class function Name: string; override;
|
||||
class function Description: string; override;
|
||||
end;
|
||||
{$endif COMPILER_5}
|
||||
|
||||
TCheckImageKindProperty = class(TEnumProperty {$ifdef COMPILER_6_UP}, ICustomPropertyDrawing, ICustomPropertyListDrawing {$endif COMPILER_6_UP})
|
||||
TCheckImageKindProperty = class(TEnumProperty, ICustomPropertyDrawing, ICustomPropertyListDrawing)
|
||||
public
|
||||
{$ifdef COMPILER_5_UP}
|
||||
procedure ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);
|
||||
{$ifndef COMPILER_6_UP} override; {$endif}
|
||||
procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
|
||||
{$ifndef COMPILER_6_UP} override; {$endif}
|
||||
procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
{$ifndef COMPILER_6_UP} override; {$endif}
|
||||
{$ifdef COMPILER_6_UP}
|
||||
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
{$endif}
|
||||
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
{$ifndef COMPILER_6_UP} override; {$endif}
|
||||
{$endif}
|
||||
procedure ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);
|
||||
procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
|
||||
procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
end;
|
||||
|
||||
{$ifdef COMPILER_6_UP}
|
||||
resourcestring
|
||||
sVTHeaderCategoryName = 'Header';
|
||||
sVTPaintingCategoryName = 'Custom painting';
|
||||
sVTIncremenalCategoryName = 'Incremental search';
|
||||
{$endif}
|
||||
resourcestring
|
||||
sVTHeaderCategoryName = 'Header';
|
||||
sVTPaintingCategoryName = 'Custom painting';
|
||||
sVTIncremenalCategoryName = 'Incremental search';
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
@ -251,62 +192,54 @@ end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
{$ifdef COMPILER_5_UP}
|
||||
procedure DrawBoolean(Checked: Boolean; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
procedure DrawBoolean(Checked: Boolean; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
var
|
||||
BoxSize,
|
||||
EntryWidth: Integer;
|
||||
R: TRect;
|
||||
State: Cardinal;
|
||||
var
|
||||
BoxSize,
|
||||
EntryWidth: Integer;
|
||||
R: TRect;
|
||||
State: Cardinal;
|
||||
|
||||
begin
|
||||
with ACanvas do
|
||||
begin
|
||||
with ACanvas do
|
||||
begin
|
||||
FillRect(ARect);
|
||||
FillRect(ARect);
|
||||
|
||||
BoxSize := ARect.Bottom - ARect.Top;
|
||||
EntryWidth := ARect.Right - ARect.Left;
|
||||
BoxSize := ARect.Bottom - ARect.Top;
|
||||
EntryWidth := ARect.Right - ARect.Left;
|
||||
|
||||
R := Rect(ARect.Left + (EntryWidth - BoxSize) div 2, ARect.Top, ARect.Left + (EntryWidth + BoxSize) div 2,
|
||||
ARect.Bottom);
|
||||
InflateRect(R, -1, -1);
|
||||
State := DFCS_BUTTONCHECK;
|
||||
if Checked then
|
||||
State := State or DFCS_CHECKED;
|
||||
DrawFrameControl(Handle, R, DFC_BUTTON, State);
|
||||
end;
|
||||
R := Rect(ARect.Left + (EntryWidth - BoxSize) div 2, ARect.Top, ARect.Left + (EntryWidth + BoxSize) div 2,
|
||||
ARect.Bottom);
|
||||
InflateRect(R, -1, -1);
|
||||
State := DFCS_BUTTONCHECK;
|
||||
if Checked then
|
||||
State := State or DFCS_CHECKED;
|
||||
DrawFrameControl(Handle, R, DFC_BUTTON, State);
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
{$ifdef COMPILER_6_UP}
|
||||
procedure TClipboardElement.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
procedure TClipboardElement.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
begin
|
||||
DefaultPropertyDrawName(Self, ACanvas, ARect);
|
||||
end;
|
||||
|
||||
{$endif COMPILER_6_UP}
|
||||
begin
|
||||
DefaultPropertyDrawName(Self, ACanvas, ARect);
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TClipboardElement.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure TClipboardElement.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
begin
|
||||
DrawBoolean(CompareText(GetVisualValue, 'True') = 0, ACanvas, ARect, ASelected);
|
||||
end;
|
||||
|
||||
{$endif COMPILER_5_UP}
|
||||
begin
|
||||
DrawBoolean(CompareText(GetVisualValue, 'True') = 0, ACanvas, ARect, ASelected);
|
||||
end;
|
||||
|
||||
//----------------- TClipboardFormatsProperty --------------------------------------------------------------------------
|
||||
|
||||
function TClipboardFormatsProperty.GetAttributes: TPropertyAttributes;
|
||||
|
||||
begin
|
||||
Result := inherited GetAttributes + [paSubProperties {$ifdef COMPILER_5_UP}, paFullWidthName {$endif COMPILER_5_UP}];
|
||||
Result := inherited GetAttributes + [paSubProperties, paFullWidthName];
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
@ -328,192 +261,119 @@ end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
{$ifdef COMPILER_5_UP}
|
||||
procedure TClipboardFormatsProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
procedure TClipboardFormatsProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
var
|
||||
S: string;
|
||||
Width: Integer;
|
||||
R: TRect;
|
||||
var
|
||||
S: string;
|
||||
Width: Integer;
|
||||
R: TRect;
|
||||
|
||||
begin
|
||||
with ACanvas do
|
||||
begin
|
||||
with ACanvas do
|
||||
begin
|
||||
Font.Name := 'Arial';
|
||||
R := ARect;
|
||||
Font.Color := clBlack;
|
||||
S := GetName;
|
||||
Width := TextWidth(S);
|
||||
TextRect(R, R.Left + 1, R.Top + 1, S);
|
||||
Font.Name := 'Arial';
|
||||
R := ARect;
|
||||
Font.Color := clBlack;
|
||||
S := GetName;
|
||||
Width := TextWidth(S);
|
||||
TextRect(R, R.Left + 1, R.Top + 1, S);
|
||||
|
||||
Inc(R.Left, Width + 8);
|
||||
Font.Height := 14;
|
||||
Font.Color := clBtnHighlight;
|
||||
S := '(OLE drag and clipboard)';
|
||||
SetBkMode(Handle, TRANSPARENT);
|
||||
ExtTextOut(Handle, R.Left + 1, R.Top + 1, ETO_CLIPPED, @R, PChar(S), Length(S), nil);
|
||||
Font.Color := clBtnShadow;
|
||||
ExtTextOut(Handle, R.Left, R.Top, ETO_CLIPPED, @R, PChar(S), Length(S), nil);
|
||||
end;
|
||||
Inc(R.Left, Width + 8);
|
||||
Font.Height := 14;
|
||||
Font.Color := clBtnHighlight;
|
||||
S := '(OLE drag and clipboard)';
|
||||
SetBkMode(Handle, TRANSPARENT);
|
||||
ExtTextOut(Handle, R.Left + 1, R.Top + 1, ETO_CLIPPED, @R, PChar(S), Length(S), nil);
|
||||
Font.Color := clBtnShadow;
|
||||
ExtTextOut(Handle, R.Left, R.Top, ETO_CLIPPED, @R, PChar(S), Length(S), nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TClipboardFormatsProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure TClipboardFormatsProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
begin
|
||||
// Nothing to do here.
|
||||
end;
|
||||
|
||||
{$endif COMPILER_5_UP}
|
||||
|
||||
{$ifdef COMPILER_5}
|
||||
|
||||
//----------------- TVTPaintingCategory --------------------------------------------------------------------------------
|
||||
|
||||
class function TVTPaintingCategory.Name: string;
|
||||
|
||||
begin
|
||||
Result := 'Custom Painting';
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
class function TVTPaintingCategory.Description: string;
|
||||
|
||||
begin
|
||||
Result := 'Custom Painting';
|
||||
end;
|
||||
|
||||
//----------------- TVTHeaderCategory ----------------------------------------------------------------------------------
|
||||
|
||||
class function TVTHeaderCategory.Name: string;
|
||||
|
||||
begin
|
||||
Result := 'Header';
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
class function TVTHeaderCategory.Description: string;
|
||||
|
||||
begin
|
||||
Result := 'Header';
|
||||
end;
|
||||
|
||||
//----------------- TVTIncrementalSearchCategory -----------------------------------------------------------------------
|
||||
|
||||
class function TVTIncrementalSearchCategory.Name: string;
|
||||
|
||||
begin
|
||||
Result := 'Incremental Search';
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
class function TVTIncrementalSearchCategory.Description: string;
|
||||
|
||||
begin
|
||||
Result := 'Incremental Search';
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
{$endif COMPILER_5}
|
||||
begin
|
||||
// Nothing to do here.
|
||||
end;
|
||||
|
||||
//----------------- TCheckImageKindProperty ----------------------------------------------------------------------------
|
||||
|
||||
{$ifdef COMPILER_5_UP}
|
||||
|
||||
const
|
||||
cCheckImageKindComboItemBorder = 0;
|
||||
cCheckImageKindComboItemSpacing = 2;
|
||||
cCheckImageKindComboBitmapHeight = 16;
|
||||
cCheckImageKindComboBitmapWidth = 16;
|
||||
const
|
||||
cCheckImageKindComboItemBorder = 0;
|
||||
cCheckImageKindComboItemSpacing = 2;
|
||||
cCheckImageKindComboBitmapHeight = 16;
|
||||
cCheckImageKindComboBitmapWidth = 16;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
{$ifdef COMPILER_6_UP}
|
||||
procedure TCheckImageKindProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
procedure TCheckImageKindProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
begin
|
||||
DefaultPropertyDrawName(Self, ACanvas, ARect);
|
||||
end;
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TCheckImageKindProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
begin
|
||||
if GetVisualValue <> '' then
|
||||
ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected)
|
||||
else
|
||||
DefaultPropertyDrawValue(Self, ACanvas, ARect);
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TCheckImageKindProperty.ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
|
||||
var
|
||||
RighPosition: Integer;
|
||||
OldPenColor: TColor;
|
||||
CheckKind: TCheckImageKind;
|
||||
ImageList: TCustomImageList;
|
||||
RemainingRect: TRect;
|
||||
|
||||
begin
|
||||
RighPosition := ARect.Left + cCheckImageKindComboBitmapWidth;
|
||||
with ACanvas do
|
||||
try
|
||||
OldPenColor := Pen.Color;
|
||||
Pen.Color := Brush.Color;
|
||||
Rectangle(ARect.Left, ARect.Top, RighPosition, ARect.Bottom);
|
||||
|
||||
CheckKind := TCheckImageKind(GetEnumValue(GetPropInfo^.PropType^, Value));
|
||||
ImageList := TVirtualTreeCast.GetCheckImageListFor(CheckKind);
|
||||
if ImageList <> nil then
|
||||
begin
|
||||
DefaultPropertyDrawName(Self, ACanvas, ARect);
|
||||
ImageList_DrawEx(ImageList.Handle, ckCheckCheckedNormal, ACanvas.Handle, ARect.Left + cCheckImageKindComboItemBorder,
|
||||
ARect.Top + cCheckImageKindComboItemBorder, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT);
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
Pen.Color := OldPenColor;
|
||||
finally
|
||||
RemainingRect := Rect(RighPosition, ARect.Top, ARect.Right, ARect.Bottom);
|
||||
DefaultPropertyListDrawValue(Value, ACanvas, RemainingRect, ASelected);
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TCheckImageKindProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure TCheckImageKindProperty.ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);
|
||||
|
||||
begin
|
||||
if GetVisualValue <> '' then
|
||||
ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected)
|
||||
else
|
||||
{$ifdef COMPILER_6_UP}
|
||||
DefaultPropertyDrawValue(Self, ACanvas, ARect);
|
||||
{$else}
|
||||
inherited PropDrawValue(ACanvas, ARect, ASelected);
|
||||
{$endif}
|
||||
end;
|
||||
begin
|
||||
AHeight := cCheckImageKindComboBitmapHeight;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TCheckImageKindProperty.ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
||||
procedure TCheckImageKindProperty.ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
|
||||
|
||||
var
|
||||
RighPosition: Integer;
|
||||
OldPenColor: TColor;
|
||||
CheckKind: TCheckImageKind;
|
||||
ImageList: TCustomImageList;
|
||||
RemainingRect: TRect;
|
||||
|
||||
begin
|
||||
RighPosition := ARect.Left + cCheckImageKindComboBitmapWidth;
|
||||
with ACanvas do
|
||||
try
|
||||
OldPenColor := Pen.Color;
|
||||
Pen.Color := Brush.Color;
|
||||
Rectangle(ARect.Left, ARect.Top, RighPosition, ARect.Bottom);
|
||||
|
||||
CheckKind := TCheckImageKind(GetEnumValue(GetPropInfo^.PropType^, Value));
|
||||
ImageList := TVirtualTreeCast.GetCheckImageListFor(CheckKind);
|
||||
if ImageList <> nil then
|
||||
begin
|
||||
ImageList_DrawEx(ImageList.Handle, ckCheckCheckedNormal, ACanvas.Handle, ARect.Left + cCheckImageKindComboItemBorder,
|
||||
ARect.Top + cCheckImageKindComboItemBorder, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT);
|
||||
end;
|
||||
|
||||
Pen.Color := OldPenColor;
|
||||
finally
|
||||
RemainingRect := Rect(RighPosition, ARect.Top, ARect.Right, ARect.Bottom);
|
||||
{$ifdef COMPILER_6_UP}
|
||||
DefaultPropertyListDrawValue(Value, ACanvas, RemainingRect, ASelected);
|
||||
{$else}
|
||||
inherited ListDrawValue(Value, ACanvas, RemainingRect, ASelected);
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TCheckImageKindProperty.ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);
|
||||
|
||||
begin
|
||||
AHeight := cCheckImageKindComboBitmapHeight;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TCheckImageKindProperty.ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
|
||||
|
||||
begin
|
||||
AWidth := AWidth + cCheckImageKindComboBitmapWidth;
|
||||
end;
|
||||
|
||||
{$endif COMPILER_5_UP}
|
||||
begin
|
||||
AWidth := AWidth + cCheckImageKindComboBitmapWidth;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
@ -527,13 +387,9 @@ begin
|
||||
RegisterPropertyEditor(TypeInfo(TCheckImageKind), nil, '', TCheckImageKindProperty);
|
||||
|
||||
// Categories:
|
||||
{$ifdef COMPILER_5_UP}
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TActionCategory, {$endif} {$ifdef COMPILER_6_UP} sActionCategoryName, {$endif COMPILER_6_UP}
|
||||
TBaseVirtualTree,
|
||||
['ChangeDelay',
|
||||
'EditDelay']);
|
||||
RegisterPropertiesInCategory(sActionCategoryName, TBaseVirtualTree, ['ChangeDelay', 'EditDelay']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TDataCategory, {$endif} {$ifdef COMPILER_6_UP} sDataCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sDataCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['NodeDataSize',
|
||||
'RootNodeCount',
|
||||
@ -554,7 +410,7 @@ begin
|
||||
'OnNewText',
|
||||
'OnShortenString']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TLayoutCategory, {$endif} {$ifdef COMPILER_6_UP} slayoutCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(slayoutCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['AnimationDuration',
|
||||
'AutoExpandDelay',
|
||||
@ -573,7 +429,7 @@ begin
|
||||
'SelectionCurveRadius',
|
||||
'TextMargin']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TVisualCategory, {$endif} {$ifdef COMPILER_6_UP} sVisualCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sVisualCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['Background*',
|
||||
'ButtonFillMode',
|
||||
@ -581,11 +437,11 @@ begin
|
||||
'Colors',
|
||||
'LineMode']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} THelpCategory, {$endif} {$ifdef COMPILER_6_UP} sHelpCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sHelpCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['AccessibleName', 'Hint*', 'On*Hint*', 'On*Help*']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TDragNDropCategory, {$endif} {$ifdef COMPILER_6_UP} sDragNDropCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sDragNDropCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['ClipboardFormats',
|
||||
'DefaultPasteMode',
|
||||
@ -596,7 +452,7 @@ begin
|
||||
'OnDragAllowed',
|
||||
'OnRenderOLEData']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TInputCategory, {$endif} {$ifdef COMPILER_6_UP} sInputCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sInputCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['DefaultText',
|
||||
'DrawSelectionMode',
|
||||
@ -613,20 +469,19 @@ begin
|
||||
'OnNodeHeightTracking',
|
||||
'OnHotChange']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TVTHeaderCategory, {$endif} {$ifdef COMPILER_6_UP} sVTHeaderCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sVTHeaderCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['OnHeader*', 'OnGetHeader*']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TVTPaintingCategory, {$endif} {$ifdef COMPILER_6_UP} sVTPaintingCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sVTPaintingCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['On*Paint*',
|
||||
'OnDraw*',
|
||||
'On*Erase*']);
|
||||
|
||||
RegisterPropertiesInCategory({$ifdef COMPILER_5} TVTIncrementalSearchCategory, {$endif} {$ifdef COMPILER_6_UP} sVTIncremenalCategoryName, {$endif COMPILER_6_UP}
|
||||
RegisterPropertiesInCategory(sVTIncremenalCategoryName,
|
||||
TBaseVirtualTree,
|
||||
['*Incremental*']);
|
||||
{$endif COMPILER_5_UP}
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
@ -19,6 +19,7 @@ uses
|
||||
{$ifndef COMPILER_10_UP}
|
||||
MSAAIntf, // MSAA support for Delphi up to 2005
|
||||
{$else}
|
||||
Types,
|
||||
oleacc, // MSAA support in Delphi 2006 or higher
|
||||
{$endif COMPILER_10_UP}
|
||||
VirtualTrees, VTAccessibilityFactory, Controls;
|
||||
@ -28,6 +29,8 @@ type
|
||||
private
|
||||
FVirtualTree: TVirtualStringTree;
|
||||
public
|
||||
constructor Create(AVirtualTree: TVirtualStringTree);
|
||||
|
||||
{ IAccessibility }
|
||||
function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
|
||||
function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
|
||||
@ -61,7 +64,6 @@ type
|
||||
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
|
||||
Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
|
||||
ArgErr: Pointer): HRESULT; stdcall;
|
||||
constructor Create(VirtualTree: TVirtualStringTree);
|
||||
end;
|
||||
|
||||
TVirtualTreeItemAccessibility = class(TVirtualTreeAccessibility, IAccessible)
|
||||
@ -78,9 +80,6 @@ type
|
||||
function accLocation(out pxLeft: Integer;
|
||||
out pyTop: Integer; out pcxWidth: Integer;
|
||||
out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
|
||||
|
||||
|
||||
constructor Create(VirtualTree: TVirtualStringTree);
|
||||
function Get_accFocus(out pvarChild: OleVariant): HRESULT; stdcall;
|
||||
end;
|
||||
|
||||
@ -94,23 +93,35 @@ type
|
||||
end;
|
||||
|
||||
TVTDefaultAccessibleProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
||||
public
|
||||
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||
end;
|
||||
|
||||
TVTDefaultAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
||||
public
|
||||
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||
end;
|
||||
|
||||
TVTMultiColumnAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
||||
public
|
||||
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses SysUtils, Forms, Variants, Math;
|
||||
uses
|
||||
SysUtils, Forms, Variants, Math;
|
||||
|
||||
|
||||
{ TVirtualTreeAccessibility }
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
constructor TVirtualTreeAccessibility.Create(AVirtualTree: TVirtualStringTree);
|
||||
// assigns the parent and current fields, and lets the control's IAccessible object know its address.
|
||||
begin
|
||||
inherited Create;
|
||||
FVirtualTree := AVirtualTree;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
function TVirtualTreeAccessibility.accDoDefaultAction(varChild: OleVariant): HResult;
|
||||
@ -176,7 +187,7 @@ begin
|
||||
// return the location of the focused node
|
||||
if (FVirtualTree <> nil) and (FVirtualTree.AccessibleItem <> nil) then
|
||||
begin
|
||||
RESULT := FVirtualTree.AccessibleItem.accLocation(pxLeft,pyTop,pcxWidth,pcyHeight,CHILDID_SELF);
|
||||
Result := FVirtualTree.AccessibleItem.accLocation(pxLeft, pyTop, pcxWidth, pcyHeight, CHILDID_SELF);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -202,13 +213,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
constructor TVirtualTreeAccessibility.Create(VirtualTree: TVirtualStringTree);
|
||||
// assigns the parent and current fields, and lets the control's iAccessible object know its address.
|
||||
begin
|
||||
fVirtualTree := VirtualTree;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
function TVirtualTreeAccessibility.GetIDsOfNames(const IID: TGUID;
|
||||
Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
|
||||
@ -284,15 +288,11 @@ begin
|
||||
if fVirtualTree <> nil then
|
||||
begin
|
||||
if FVirtualTree.FocusedNode <> nil then
|
||||
begin
|
||||
pvarChild := fVirtualTree.AccessibleItem;
|
||||
result := s_OK;
|
||||
end
|
||||
else begin
|
||||
pvarChild := FVirtualTree.AccessibleItem
|
||||
else
|
||||
pvarChild := childid_self;
|
||||
result := S_OK;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
@ -354,7 +354,7 @@ begin
|
||||
// return the name for the inner accessible item
|
||||
if (FVirtualTree <> nil) and (FVirtualTree.AccessibleItem <> nil) then
|
||||
begin
|
||||
RESULT := FVirtualTree.AccessibleItem.Get_accName(CHILDID_SELF,pszName);
|
||||
Result := FVirtualTree.AccessibleItem.Get_accName(CHILDID_SELF, pszName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -363,9 +363,9 @@ end;
|
||||
function TVirtualTreeAccessibility.Get_accParent(out ppdispParent: IDispatch): HResult;
|
||||
// Returns false, the tree itself does not have a parent.
|
||||
var
|
||||
hParent :HWND;
|
||||
hParent: HWND;
|
||||
begin
|
||||
Result :=E_INVALIDARG;
|
||||
Result := E_INVALIDARG;
|
||||
ppdispParent := nil;
|
||||
|
||||
// Addition - Simon Moscrop 7/5/2009
|
||||
@ -392,7 +392,7 @@ begin
|
||||
if varChild = CHILDID_SELF then
|
||||
begin
|
||||
if FVirtualTree <> nil then
|
||||
pvarRole := ROLE_SYSTEM_OUTLINE
|
||||
pvarRole := ROLE_SYSTEM_OUTLINE;
|
||||
end
|
||||
else if VarType(varChild) = VT_I4 then
|
||||
begin
|
||||
@ -438,7 +438,7 @@ begin
|
||||
// return the state of the inner accessible item
|
||||
if (FVirtualTree <> nil) and (FVirtualTree.AccessibleItem <> nil) then
|
||||
begin
|
||||
RESULT := FVirtualTree.AccessibleItem.Get_accState(CHILDID_SELF,pVarState)
|
||||
Result := FVirtualTree.AccessibleItem.Get_accState(CHILDID_SELF, pVarState);
|
||||
end
|
||||
else
|
||||
RESULT := E_INVALIDARG;
|
||||
@ -497,7 +497,7 @@ begin
|
||||
begin
|
||||
if FVirtualTree.FocusedNode <> nil then
|
||||
begin
|
||||
DisplayRect := FVirtualTree.GetDisplayRect(FVirtualTree.FocusedNode, FVirtualTree.Header.Columns.GetFirstVisibleColumn, TRUE, FALSE);//Use fisrt visible column instead of -1
|
||||
DisplayRect := FVirtualTree.GetDisplayRect(FVirtualTree.FocusedNode, FVirtualTree.Header.Columns.GetFirstVisibleColumn, True, False);//Use first visible column instead of -1
|
||||
P := FVirtualTree.ClientToScreen(DisplayRect.TopLeft);
|
||||
pxLeft := P.X;
|
||||
pyTop := P.Y;
|
||||
@ -508,13 +508,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
constructor TVirtualTreeItemAccessibility.Create(VirtualTree: TVirtualStringTree);
|
||||
// sets up the parent/child relationship.
|
||||
begin
|
||||
fVirtualTree := VirtualTree;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
function TVirtualTreeItemAccessibility.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult;
|
||||
// the item does not have children. Returning false.
|
||||
@ -539,8 +532,7 @@ begin
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
function TVirtualTreeItemAccessibility.Get_accFocus(
|
||||
out pvarChild: OleVariant): HRESULT;
|
||||
function TVirtualTreeItemAccessibility.Get_accFocus(out pvarChild: OleVariant): HResult;
|
||||
begin
|
||||
// must override this or we get an infinite loop when using MS narrator
|
||||
// when navigating using the arrow keys.
|
||||
@ -556,7 +548,7 @@ function TVirtualTreeItemAccessibility.Get_accName(varChild: OleVariant; out psz
|
||||
// the name is the node's caption.
|
||||
var
|
||||
kind: TVTImageKind;
|
||||
sTemp: WideString;
|
||||
ImgText: WideString;
|
||||
begin
|
||||
pszName := '';
|
||||
Result := S_FALSE;
|
||||
@ -567,9 +559,9 @@ begin
|
||||
begin
|
||||
for kind := ikNormal to ikOverlay do
|
||||
begin
|
||||
sTemp := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, FVirtualTree.Header.MainColumn];
|
||||
if sTemp <> '' then
|
||||
pszName := pszName + sTemp + ' ';
|
||||
ImgText := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, FVirtualTree.Header.MainColumn];
|
||||
if ImgText <> '' then
|
||||
pszName := pszName + ImgText + ' ';
|
||||
end;
|
||||
pszName := pszName + FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn];
|
||||
result := S_OK;
|
||||
@ -603,7 +595,7 @@ begin
|
||||
if varChild = childid_self then
|
||||
begin
|
||||
if FVirtualTree <> nil then
|
||||
pvarRole := ROLE_SYSTEM_OUTLINEITEM
|
||||
pvarRole := ROLE_SYSTEM_OUTLINEITEM;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -663,7 +655,7 @@ function TVTMultiColumnItemAccessibility.GetItemDescription(
|
||||
IncludeMainColumn: boolean): HResult;
|
||||
var
|
||||
I: Integer;
|
||||
sTemp, sTemp2: WideString;
|
||||
ImgText: WideString;
|
||||
kind: TVTImageKind;
|
||||
begin
|
||||
pszDescription := '';
|
||||
@ -677,28 +669,27 @@ begin
|
||||
begin
|
||||
for kind := ikNormal to ikOverlay do
|
||||
begin
|
||||
sTemp2 := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, FVirtualTree.Header.MainColumn];
|
||||
if sTemp2 <> '' then
|
||||
sTemp2 := sTemp2 + ' ';
|
||||
ImgText := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, FVirtualTree.Header.MainColumn];
|
||||
if ImgText <> '' then
|
||||
ImgText := ImgText + ' ';
|
||||
end;
|
||||
pszDescription := sTemp2 + FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn]
|
||||
+'; ';
|
||||
pszDescription := ImgText + FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn] + '; ';
|
||||
end;
|
||||
for I := 0 to FVirtualTree.Header.Columns.Count - 1 do
|
||||
if (FVirtualTree.Header.MainColumn <> I) and (coVisible in FVirtualTree.Header.Columns[I].Options) then
|
||||
begin
|
||||
for kind := ikNormal to ikOverlay do
|
||||
begin
|
||||
sTemp2 := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, I];
|
||||
if sTemp2 <> '' then
|
||||
sTemp := sTemp2 + ' ';
|
||||
ImgText := FVirtualTree.ImageText[FVirtualTree.FocusedNode, Kind, I];
|
||||
if ImgText <> '' then
|
||||
ImgText := ImgText + ' ';
|
||||
end;
|
||||
sTemp := sTemp + FVirtualTree.Text[FVirtualTree.FocusedNode, I];
|
||||
if sTemp <> '' then
|
||||
ImgText := ImgText + FVirtualTree.Text[FVirtualTree.FocusedNode, I];
|
||||
if ImgText <> '' then
|
||||
pszDescription := pszDescription
|
||||
+FVirtualTree.Header.Columns[I].Text
|
||||
+': '
|
||||
+sTemp
|
||||
+ ImgText
|
||||
+'; ';
|
||||
end;
|
||||
if pszDescription <> '' then
|
||||
@ -727,24 +718,21 @@ end;
|
||||
|
||||
{ TVTDefaultAccessibleProvider }
|
||||
|
||||
function TVTDefaultAccessibleProvider.CreateIAccessible(
|
||||
ATree: TBaseVirtualTree): IAccessible;
|
||||
function TVTDefaultAccessibleProvider.CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||
begin
|
||||
result := TVirtualTreeAccessibility.Create(TVirtualStringTree(ATree));
|
||||
end;
|
||||
|
||||
{ TVTDefaultAccessibleItemProvider }
|
||||
|
||||
function TVTDefaultAccessibleItemProvider.CreateIAccessible(
|
||||
ATree: TBaseVirtualTree): IAccessible;
|
||||
function TVTDefaultAccessibleItemProvider.CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||
begin
|
||||
result := TVirtualTreeItemAccessibility.Create(TVirtualStringTree(ATree));
|
||||
end;
|
||||
|
||||
{ TVTMultiColumnAccessibleItemProvider }
|
||||
|
||||
function TVTMultiColumnAccessibleItemProvider.CreateIAccessible(
|
||||
ATree: TBaseVirtualTree): IAccessible;
|
||||
function TVTMultiColumnAccessibleItemProvider.CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||
begin
|
||||
result := nil;
|
||||
if TVirtualStringTree(ATree).Header.UseColumns then
|
||||
@ -752,33 +740,34 @@ begin
|
||||
end;
|
||||
|
||||
var
|
||||
IDefaultAccessibleProvider: TVTDefaultAccessibleProvider;
|
||||
IDefaultAccessibleItemProvider: TVTDefaultAccessibleItemProvider;
|
||||
IMultiColumnAccessibleProvider: TVTMultiColumnAccessibleItemProvider;
|
||||
DefaultAccessibleProvider: TVTDefaultAccessibleProvider;
|
||||
DefaultAccessibleItemProvider: TVTDefaultAccessibleItemProvider;
|
||||
MultiColumnAccessibleProvider: TVTMultiColumnAccessibleItemProvider;
|
||||
|
||||
initialization
|
||||
if IDefaultAccessibleProvider = nil then
|
||||
if DefaultAccessibleProvider = nil then
|
||||
begin
|
||||
IDefaultAccessibleProvider := TVTDefaultAccessibleProvider.Create;
|
||||
GetAccessibilityFactory.RegisterAccessibleProvider(IDefaultAccessibleProvider);
|
||||
DefaultAccessibleProvider := TVTDefaultAccessibleProvider.Create;
|
||||
GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleProvider);
|
||||
end;
|
||||
if IDefaultAccessibleItemProvider = nil then
|
||||
if DefaultAccessibleItemProvider = nil then
|
||||
begin
|
||||
IDefaultAccessibleItemProvider := TVTDefaultAccessibleItemProvider.Create;
|
||||
GetAccessibilityFactory.RegisterAccessibleProvider(IDefaultAccessibleItemProvider);
|
||||
DefaultAccessibleItemProvider := TVTDefaultAccessibleItemProvider.Create;
|
||||
GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleItemProvider);
|
||||
end;
|
||||
if IMultiColumnAccessibleProvider = nil then
|
||||
if MultiColumnAccessibleProvider = nil then
|
||||
begin
|
||||
IMultiColumnAccessibleProvider := TVTMultiColumnAccessibleItemProvider.Create;
|
||||
GetAccessibilityFactory.RegisterAccessibleProvider(IMultiColumnAccessibleProvider);
|
||||
MultiColumnAccessibleProvider := TVTMultiColumnAccessibleItemProvider.Create;
|
||||
GetAccessibilityFactory.RegisterAccessibleProvider(MultiColumnAccessibleProvider);
|
||||
end;
|
||||
finalization
|
||||
GetAccessibilityFactory.UnRegisterAccessibleProvider(IMultiColumnAccessibleProvider);
|
||||
IMultiColumnAccessibleProvider := nil;
|
||||
GetAccessibilityFactory.UnRegisterAccessibleProvider(IDefaultAccessibleItemProvider);
|
||||
IDefaultAccessibleItemProvider := nil;
|
||||
GetAccessibilityFactory.UnRegisterAccessibleProvider(IDefaultAccessibleProvider);
|
||||
IDefaultAccessibleProvider := nil;
|
||||
GetAccessibilityFactory.UnRegisterAccessibleProvider(MultiColumnAccessibleProvider);
|
||||
MultiColumnAccessibleProvider := nil;
|
||||
GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleItemProvider);
|
||||
DefaultAccessibleItemProvider := nil;
|
||||
GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleProvider);
|
||||
DefaultAccessibleProvider := nil;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
@ -50,14 +50,13 @@ implementation
|
||||
|
||||
var
|
||||
VTAccessibleFactory: TVTAccessibilityFactory = nil;
|
||||
AccessibilityAvailable: boolean = false;
|
||||
|
||||
AccessibilityAvailable: Boolean = False;
|
||||
|
||||
{ TVTAccessibilityFactory }
|
||||
|
||||
constructor TVTAccessibilityFactory.Create;
|
||||
begin
|
||||
inherited;
|
||||
inherited Create;
|
||||
FAccessibleProviders := TInterfaceList.Create;
|
||||
FAccessibleProviders.Clear;
|
||||
end;
|
||||
@ -77,15 +76,15 @@ var
|
||||
// We'll work top to bottom, from the most complicated to the most simple.
|
||||
// The index for these should all be greater than 0, e g the IAccessible for the tree itself should always be registered first, then any IAccessible items.
|
||||
begin
|
||||
result := nil;
|
||||
Result := nil;
|
||||
if ATree <> nil then
|
||||
begin
|
||||
if ATree.Accessible = nil then
|
||||
begin
|
||||
if FAccessibleProviders.Count > 0 then
|
||||
begin
|
||||
result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree);
|
||||
exit;
|
||||
Result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
if ATree.AccessibleItem = nil then
|
||||
@ -97,19 +96,18 @@ begin
|
||||
TmpIAccessible := IVTAccessibleProvider(FAccessibleProviders.Items[I]).CreateIAccessible(ATree);
|
||||
if TmpIAccessible <> nil then
|
||||
begin
|
||||
result := TmpIAccessible;
|
||||
break;
|
||||
Result := TmpIAccessible;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
if TmpIAccessible = nil then
|
||||
begin
|
||||
result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree);
|
||||
Result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
else
|
||||
Result := ATree.AccessibleItem;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -120,7 +118,7 @@ begin
|
||||
{$ifndef COMPILER_10_UP}
|
||||
FreeAccLibrary;
|
||||
{$endif COMPILER_10_UP}
|
||||
inherited;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TVTAccessibilityFactory.RegisterAccessibleProvider(
|
||||
@ -157,15 +155,15 @@ begin
|
||||
// Check to see if the class has already been created.
|
||||
if VTAccessibleFactory = nil then
|
||||
VTAccessibleFactory := TVTAccessibilityFactory.Create;
|
||||
result := VTAccessibleFactory;
|
||||
Result := VTAccessibleFactory;
|
||||
end
|
||||
else
|
||||
result := nil;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
finalization
|
||||
VTAccessibleFactory.free;
|
||||
VTAccessibleFactory.Free;
|
||||
|
||||
end.
|
||||
|
||||
@ -68,7 +68,7 @@ unit VTHeaderPopup;
|
||||
{$ifdef COMPILER_12_UP}
|
||||
{$WARN IMPLICIT_STRING_CAST OFF}
|
||||
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
|
||||
{$endif COMPILER_7_UP}
|
||||
{$endif COMPILER_12_UP}
|
||||
|
||||
interface
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -82,7 +82,6 @@ object connform: Tconnform
|
||||
Anchors = [akLeft, akTop, akBottom]
|
||||
EditDelay = 250
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
|
||||
@ -92,7 +92,6 @@ object CopyTableForm: TCopyTableForm
|
||||
Height = 88
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
|
||||
@ -102,7 +102,6 @@ object frmInsertFiles: TfrmInsertFiles
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
EditDelay = 0
|
||||
Header.AutoSizeIndex = 2
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
@ -180,7 +179,6 @@ object frmInsertFiles: TfrmInsertFiles
|
||||
Height = 128
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
|
||||
@ -407,7 +407,6 @@ object MainForm: TMainForm
|
||||
DragMode = dmAutomatic
|
||||
DragType = dtVCL
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
@ -621,7 +620,6 @@ object MainForm: TMainForm
|
||||
Height = 273
|
||||
Align = alClient
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.PopupMenu = popupListHeader
|
||||
@ -705,7 +703,6 @@ object MainForm: TMainForm
|
||||
Align = alClient
|
||||
DragOperations = []
|
||||
Header.AutoSizeIndex = 1
|
||||
Header.DefaultHeight = 17
|
||||
Header.Height = 20
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
@ -757,7 +754,6 @@ object MainForm: TMainForm
|
||||
Align = alClient
|
||||
DragOperations = []
|
||||
Header.AutoSizeIndex = 1
|
||||
Header.DefaultHeight = 17
|
||||
Header.Height = 20
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
@ -829,7 +825,6 @@ object MainForm: TMainForm
|
||||
Height = 200
|
||||
Align = alClient
|
||||
Header.AutoSizeIndex = 7
|
||||
Header.DefaultHeight = 17
|
||||
Header.Height = 20
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
@ -976,7 +971,6 @@ object MainForm: TMainForm
|
||||
Height = 273
|
||||
Align = alClient
|
||||
Header.AutoSizeIndex = 4
|
||||
Header.DefaultHeight = 17
|
||||
Header.Height = 20
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
@ -1049,7 +1043,6 @@ object MainForm: TMainForm
|
||||
Align = alClient
|
||||
EditDelay = 500
|
||||
Header.AutoSizeIndex = -1
|
||||
Header.DefaultHeight = 17
|
||||
Header.Height = 20
|
||||
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
@ -1418,7 +1411,6 @@ object MainForm: TMainForm
|
||||
AutoScrollDelay = 50
|
||||
EditDelay = 0
|
||||
Header.AutoSizeIndex = -1
|
||||
Header.DefaultHeight = 17
|
||||
Header.Height = 20
|
||||
Header.Images = ImageListMain
|
||||
Header.MainColumn = -1
|
||||
@ -1550,7 +1542,6 @@ object MainForm: TMainForm
|
||||
DragMode = dmAutomatic
|
||||
DragType = dtVCL
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
@ -1600,7 +1591,6 @@ object MainForm: TMainForm
|
||||
AutoScrollDelay = 50
|
||||
EditDelay = 0
|
||||
Header.AutoSizeIndex = -1
|
||||
Header.DefaultHeight = 17
|
||||
Header.Height = 20
|
||||
Header.Images = ImageListMain
|
||||
Header.MainColumn = -1
|
||||
|
||||
@ -887,7 +887,6 @@ object optionsform: Toptionsform
|
||||
Height = 353
|
||||
Align = alLeft
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
|
||||
@ -258,7 +258,6 @@ object frmRoutineEditor: TfrmRoutineEditor
|
||||
DragType = dtVCL
|
||||
EditDelay = 0
|
||||
Header.AutoSizeIndex = 1
|
||||
Header.DefaultHeight = 17
|
||||
Header.MainColumn = 1
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
|
||||
@ -44,7 +44,6 @@ object frmSelectDBObject: TfrmSelectDBObject
|
||||
Height = 206
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
|
||||
@ -102,7 +102,6 @@ object frmSQLhelp: TfrmSQLhelp
|
||||
Margins.Bottom = 0
|
||||
Align = alClient
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
|
||||
@ -43,7 +43,6 @@ object frmSyncDB: TfrmSyncDB
|
||||
AccessibleName = 'tree'
|
||||
Anchors = [akLeft, akTop, akBottom]
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
@ -206,7 +205,6 @@ object frmSyncDB: TfrmSyncDB
|
||||
Height = 115
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
|
||||
@ -61,7 +61,6 @@ object frmTableEditor: TfrmTableEditor
|
||||
DragMode = dmAutomatic
|
||||
EditDelay = 0
|
||||
Header.AutoSizeIndex = -1
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.PopupMenu = MainForm.popupListHeader
|
||||
@ -398,7 +397,6 @@ object frmTableEditor: TfrmTableEditor
|
||||
DragMode = dmAutomatic
|
||||
EditDelay = 0
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Images = MainForm.ImageListMain
|
||||
@ -561,7 +559,6 @@ object frmTableEditor: TfrmTableEditor
|
||||
Align = alClient
|
||||
EditDelay = 0
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Images = MainForm.ImageListMain
|
||||
|
||||
@ -70,7 +70,6 @@ object frmTableTools: TfrmTableTools
|
||||
Height = 336
|
||||
Align = alLeft
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Font.Charset = DEFAULT_CHARSET
|
||||
Header.Font.Color = clWindowText
|
||||
Header.Font.Height = -11
|
||||
@ -119,7 +118,6 @@ object frmTableTools: TfrmTableTools
|
||||
Height = 191
|
||||
Align = alClient
|
||||
Header.AutoSizeIndex = -1
|
||||
Header.DefaultHeight = 17
|
||||
Header.Images = MainForm.ImageListMain
|
||||
Header.MainColumn = -1
|
||||
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
|
||||
@ -104,7 +104,6 @@ object UserManagerForm: TUserManagerForm
|
||||
Height = 275
|
||||
Align = alClient
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.SortColumn = 0
|
||||
@ -224,7 +223,6 @@ object UserManagerForm: TUserManagerForm
|
||||
Height = 149
|
||||
Align = alClient
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.DefaultHeight = 17
|
||||
Header.MainColumn = -1
|
||||
Header.ParentFont = True
|
||||
Images = MainForm.ImageListMain
|
||||
|
||||
Reference in New Issue
Block a user