Update VirtualTree component code to 6.0.0 (r816). Perhaps fixes the issue described here: http://www.heidisql.com/forum.php?t=18873

components/virtualtreeview/Source/VTAccessibility.pas

@@ -8,11 +8,8 @@ unit VTAccessibility;
 interface
 
 uses
-  Windows, Classes, ActiveX, Types,
-  {$if CompilerVersion >= 18}
-    oleacc, // MSAA support in Delphi 2006 or higher
-  {$ifend}
-  VirtualTrees, VTAccessibilityFactory, Controls;
+  Winapi.Windows, System.Classes, Winapi.ActiveX, System.Types, Winapi.oleacc,
+  VirtualTrees, VTAccessibilityFactory, Vcl.Controls;
 
 type
   TVirtualTreeAccessibility = class(TInterfacedObject, IDispatch, IAccessible)
@@ -74,7 +71,7 @@ type
   end;
 
   TVTMultiColumnItemAccessibility = class(TVirtualTreeItemAccessibility, IAccessible)
-    private
+  strict private
     function GetItemDescription(varChild: OleVariant; out pszDescription: WideString; IncludeMainColumn: boolean): HResult; stdcall;
   public
     { IAccessibility }
@@ -100,18 +97,7 @@ type
 implementation
 
 uses
-  SysUtils, Forms, Variants, Math;
-
-{$if CompilerVersion < 18}
-const
-  //MSAA interfaces not included in Delphi 7
-  ROLE_SYSTEM_OUTLINE = $23 ;
-  ROLE_SYSTEM_OUTLINEITEM = $24 ;
-  STATE_SYSTEM_HASPOPUP = $40000000;
-  IID_IAccessible: TGUID = '{618736E0-3C3D-11CF-810C-00AA00389B71}';
-  function AccessibleObjectFromWindow(hwnd: THandle; dwId: DWORD; const riid: TGUID; out ppvObject): HRESULT; stdcall; external 'oleacc.dll' name 'AccessibleObjectFromWindow'; 
-{$ifend}
-
+  System.SysUtils, Vcl.Forms, System.Variants, System.Math;
 
 { TVirtualTreeAccessibility }
 //----------------------------------------------------------------------------------------------------------------------
@@ -748,24 +734,24 @@ initialization
   if DefaultAccessibleProvider = nil then
   begin
     DefaultAccessibleProvider := TVTDefaultAccessibleProvider.Create;
-    GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleProvider);
+    TVTAccessibilityFactory.GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleProvider);
   end;
   if DefaultAccessibleItemProvider = nil then
   begin
     DefaultAccessibleItemProvider := TVTDefaultAccessibleItemProvider.Create;
-    GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleItemProvider);
+    TVTAccessibilityFactory.GetAccessibilityFactory.RegisterAccessibleProvider(DefaultAccessibleItemProvider);
   end;
   if MultiColumnAccessibleProvider = nil then
   begin
     MultiColumnAccessibleProvider := TVTMultiColumnAccessibleItemProvider.Create;
-    GetAccessibilityFactory.RegisterAccessibleProvider(MultiColumnAccessibleProvider);
+    TVTAccessibilityFactory.GetAccessibilityFactory.RegisterAccessibleProvider(MultiColumnAccessibleProvider);
   end;
 finalization
-  GetAccessibilityFactory.UnRegisterAccessibleProvider(MultiColumnAccessibleProvider);
+  TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(MultiColumnAccessibleProvider);
   MultiColumnAccessibleProvider := nil;
-  GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleItemProvider);
+  TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleItemProvider);
   DefaultAccessibleItemProvider := nil;
-  GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleProvider);
+  TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleProvider);
   DefaultAccessibleProvider := nil;
 
 end.

components/virtualtreeview/Source/VTAccessibilityFactory.pas

@@ -14,10 +14,7 @@ unit VTAccessibilityFactory;
 interface
 
 uses
-  {$if CompilerVersion >= 18}
-    oleacc, // MSAA support in Delphi 2006 or higher
-  {$ifend}
-  Classes, VirtualTrees;
+  Winapi.oleacc, System.Classes, VirtualTrees;
 
 type
   IVTAccessibleProvider = interface
@@ -25,24 +22,25 @@ type
   end;
 
   TVTAccessibilityFactory = class(TObject)
-  private
+  strict private class var
+    FAccessibilityAvailable: Boolean;
+    FVTAccessibleFactory: TVTAccessibilityFactory;
+  strict private
     FAccessibleProviders: TInterfaceList;
+  private
+    class procedure FreeFactory;
   public
     constructor Create;
     destructor Destroy; override;
     function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
+    class function GetAccessibilityFactory: TVTAccessibilityFactory; static;
     procedure RegisterAccessibleProvider(AProvider: IVTAccessibleProvider);
     procedure UnRegisterAccessibleProvider(AProvider: IVTAccessibleProvider);
   end;
 
-function GetAccessibilityFactory: TVTAccessibilityFactory;
   
 implementation
 
-var
-  VTAccessibleFactory: TVTAccessibilityFactory = nil;
-  AccessibilityAvailable: Boolean = False;
-
 { TVTAccessibilityFactory }
 
 constructor TVTAccessibilityFactory.Create;
@@ -109,6 +107,11 @@ begin
   inherited Destroy;
 end;
 
+class procedure TVTAccessibilityFactory.FreeFactory;
+begin
+  FVTAccessibleFactory.Free;
+end;
+
 procedure TVTAccessibilityFactory.RegisterAccessibleProvider(
   AProvider: IVTAccessibleProvider);
 // Ads a provider if it is not already registered
@@ -125,21 +128,20 @@ begin
     FAccessibleProviders.Remove(AProvider);
 end;
 
-function GetAccessibilityFactory: TVTAccessibilityFactory;
-
+class function TVTAccessibilityFactory.GetAccessibilityFactory: TVTAccessibilityFactory;
 // Accessibility helper function to create a singleton class that will create or return
 // the IAccessible interface for the tree and the focused node.
 
 begin
   // first, check if we've loaded the library already
-  if not AccessibilityAvailable then
-    AccessibilityAvailable := True;
-  if AccessibilityAvailable then
+  if not FAccessibilityAvailable then
+    FAccessibilityAvailable := True;
+  if FAccessibilityAvailable then
   begin
     // Check to see if the class has already been created.
-    if VTAccessibleFactory = nil then
-      VTAccessibleFactory := TVTAccessibilityFactory.Create;
-    Result := VTAccessibleFactory;
+    if FVTAccessibleFactory = nil then
+      FVTAccessibleFactory := TVTAccessibilityFactory.Create;
+    Result := FVTAccessibleFactory;
   end
   else
     Result := nil;
@@ -148,6 +150,8 @@ end;
 initialization
 
 finalization
-  VTAccessibleFactory.Free;
+  TVTAccessibilityFactory.FreeFactory;
 
 end.
+
+

components/virtualtreeview/Source/VTHeaderPopup.pas

@@ -66,12 +66,7 @@ unit VTHeaderPopup;
 interface
 
 uses
-  {$ifdef TNT}
-    TntMenus,
-  {$else}
-    Menus,
-  {$endif TNT}
-  VirtualTrees;
+  Vcl.Menus, VirtualTrees;
 
 type
   TVTHeaderPopupOption = (
@@ -91,23 +86,15 @@ type
     var Cmd: TAddPopupItemType) of object;
   TColumnChangeEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean) of object;
 
-  {$ifdef TNT}
-    TVTMenuItem = TTntMenuItem;
-  {$else}
   TVTMenuItem = TMenuItem;
-  {$endif}
 
-  {$ifdef TNT}
-    TVTHeaderPopupMenu = class(TTntPopupMenu)
-  {$else}
   TVTHeaderPopupMenu = class(TPopupMenu)
-  {$endif}
-  private
+  strict private
     FOptions: TVTHeaderPopupOptions;
 
     FOnAddHeaderPopupItem: TAddHeaderPopupItemEvent;
     FOnColumnChange: TColumnChangeEvent;
-  protected
+  strict protected
     procedure DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType); virtual;
     procedure DoColumnChange(Column: TColumnIndex; Visible: Boolean); virtual;
     procedure OnMenuItemClick(Sender: TObject);
@@ -124,12 +111,8 @@ type
 
 implementation
 
-uses Windows,
-  {$ifdef TNT}
-    TnTClasses
-  {$else}
-    Classes
-  {$endif TNT};
+uses
+  Winapi.Windows, System.Classes;
 
 const
   cResizeToFitMenuItemName = 'VT_ResizeToFitMenuItem';