You've already forked lazarus-ccr
Import from old repository
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@56 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
444
components/virtualtreeview/Compilers.inc
Normal file
444
components/virtualtreeview/Compilers.inc
Normal file
@ -0,0 +1,444 @@
|
|||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
// Include file to determine which compiler is currently being used to build the project/component.
|
||||||
|
// This file uses ideas from Brad Stowers DFS.inc file.
|
||||||
|
//
|
||||||
|
// Portions created by Mike Lischke are
|
||||||
|
// Copyright (C) 1999-2005 Mike Lischke. All Rights Reserved.
|
||||||
|
// Portions created by Jim Kueneman are
|
||||||
|
// Copyright (C) 2005 Jim Kueneman. All Rights Reserved.
|
||||||
|
//
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
//
|
||||||
|
// This unit is released under the MIT license:
|
||||||
|
// Copyright (c) 1999-2005 Mike Lischke (support@soft-gems.net, www.soft-gems.net).
|
||||||
|
//
|
||||||
|
// Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
|
||||||
|
// documentation files (the "Software"), to deal in the Software without restriction, including without limitation the
|
||||||
|
// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to
|
||||||
|
// permit persons to whom the Software is furnished to do so, subject to the following conditions:
|
||||||
|
//
|
||||||
|
// The above copyright notice and this permission notice shall be included in all copies or substantial portions of the
|
||||||
|
// Software.
|
||||||
|
//
|
||||||
|
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
|
||||||
|
// WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS
|
||||||
|
// OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
|
||||||
|
// OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||||
|
//
|
||||||
|
// You are asked to give the author(s) the due credit. This means that you acknowledge the work of the author(s)
|
||||||
|
// in the product documentation, about box, help or wherever a prominent place is.
|
||||||
|
//
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
//
|
||||||
|
// The following symbols are defined:
|
||||||
|
//
|
||||||
|
// - COMPILER_1 : Kylix/Delphi/BCB 1.x is the compiler.
|
||||||
|
// - COMPILER_1_UP : Kylix/Delphi/BCB 1.x or higher is the compiler.
|
||||||
|
// - COMPILER_2 : Kylix/Delphi 2.x or BCB 1.x is the compiler.
|
||||||
|
// - COMPILER_2_UP : Kylix/Delphi 2.x or higher, or BCB 1.x or higher is the compiler.
|
||||||
|
// - COMPILER_3 : Kylix/Delphi/BCB 3.x is the compiler.
|
||||||
|
// - COMPILER_3_UP : Kylix/Delphi/BCB 3.x or higher is the compiler.
|
||||||
|
// - COMPILER_4 : Kylix/Delphi/BCB 4.x is the compiler.
|
||||||
|
// - COMPILER_4_UP : Kylix/Delphi/BCB 4.x or higher is the compiler.
|
||||||
|
// - COMPILER_5 : Kylix/Delphi/BCB 5.x is the compiler.
|
||||||
|
// - COMPILER_5_UP : Kylix/Delphi/BCB 5.x or higher is the compiler.
|
||||||
|
// - COMPILER_6 : Kylix/Delphi/BCB 6.x is the compiler.
|
||||||
|
// - COMPILER_6_UP : Kylix/Delphi/BCB 6.x or higher is the compiler.
|
||||||
|
// - COMPILER_7 : Kylix/Delphi/BCB 7.x is the compiler.
|
||||||
|
// - COMPILER_7_UP : Kylix/Delphi/BCB 7.x or higher is the compiler.
|
||||||
|
// - COMPILER_8 : Kylix/Delphi/BCB 8.x is the compiler.
|
||||||
|
// - COMPILER_8_UP : Kylix/Delphi/BCB 8.x or higher is the compiler.
|
||||||
|
// - COMPILER_9 : Kylix/Delphi/BCB 9.x is the compiler.
|
||||||
|
// - COMPILER_9_UP : Kylix/Delphi/BCB 9.x or higher is the compiler.
|
||||||
|
// - COMPILER_10 : Kylix/Delphi/BCB 10.x is the compiler.
|
||||||
|
// - COMPILER_10_UP : Kylix/Delphi/BCB 10.x or higher is the compiler.
|
||||||
|
//
|
||||||
|
// Only defined if Windows is the target:
|
||||||
|
// - CPPB : Any version of BCB is being used.
|
||||||
|
// - CPPB_1 : BCB v1.x is being used.
|
||||||
|
// - CPPB_3 : BCB v3.x is being used.
|
||||||
|
// - CPPB_3_UP : BCB v3.x or higher is being used.
|
||||||
|
// - CPPB_4 : BCB v4.x is being used.
|
||||||
|
// - CPPB_4_UP : BCB v4.x or higher is being used.
|
||||||
|
// - CPPB_5 : BCB v5.x is being used.
|
||||||
|
// - CPPB_5_UP : BCB v5.x or higher is being used.
|
||||||
|
// - CPPB_6 : BCB v6.x is being used.
|
||||||
|
// - CPPB_6_UP : BCB v6.x or higher is being used.
|
||||||
|
//
|
||||||
|
// Only defined if Windows is the target:
|
||||||
|
// - DELPHI : Any version of Delphi is being used.
|
||||||
|
// - DELPHI_1 : Delphi v1.x is being used.
|
||||||
|
// - DELPHI_2 : Delphi v2.x is being used.
|
||||||
|
// - DELPHI_2_UP : Delphi v2.x or higher is being used.
|
||||||
|
// - DELPHI_3 : Delphi v3.x is being used.
|
||||||
|
// - DELPHI_3_UP : Delphi v3.x or higher is being used.
|
||||||
|
// - DELPHI_4 : Delphi v4.x is being used.
|
||||||
|
// - DELPHI_4_UP : Delphi v4.x or higher is being used.
|
||||||
|
// - DELPHI_5 : Delphi v5.x is being used.
|
||||||
|
// - DELPHI_5_UP : Delphi v5.x or higher is being used.
|
||||||
|
// - DELPHI_6 : Delphi v6.x is being used.
|
||||||
|
// - DELPHI_6_UP : Delphi v6.x or higher is being used.
|
||||||
|
// - DELPHI_7 : Delphi v7.x is being used.
|
||||||
|
// - DELPHI_7_UP : Delphi v7.x or higher is being used.
|
||||||
|
// - DELPHI_8 : Delphi v8.x is being used.
|
||||||
|
// - DELPHI_8_UP : Delphi v8.x or higher is being used.
|
||||||
|
// - DELPHI_9 : Delphi v9.x is being used.
|
||||||
|
// - DELPHI_9_UP : Delphi v9.x or higher is being used.
|
||||||
|
// - DELPHI_XXX is not used any more, use the COMPILER_XXX defines
|
||||||
|
//
|
||||||
|
// Only defined if Linux is the target:
|
||||||
|
// - KYLIX : Any version of Kylix is being used.
|
||||||
|
// - KYLIX_1 : Kylix 1.x is being used.
|
||||||
|
// - KYLIX_1_UP : Kylix 1.x or higher is being used.
|
||||||
|
// - KYLIX_2 : Kylix 2.x is being used.
|
||||||
|
// - KYLIX_2_UP : Kylix 2.x or higher is being used.
|
||||||
|
// - KYLIX_3 : Kylix 3.x is being used.
|
||||||
|
// - KYLIX_3_UP : Kylix 3.x or higher is being used.
|
||||||
|
//
|
||||||
|
// Only defined if Linux is the target:
|
||||||
|
// - QT_CLX : Trolltech's QT library is being used.
|
||||||
|
//
|
||||||
|
// Only defined if Delphi.NET is the target:
|
||||||
|
// - DELPHI.NET : Any version of Delphi.NET is being used.
|
||||||
|
// - DELPHI.NET_1 : Delphi.NET version 1.x is being used.
|
||||||
|
// - DELPHI.NET_1_UP : Delphi.NET version 1.x is being used.
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
{$ifdef CLR} // The common language runtime symbol is only defined for the .NET platform.
|
||||||
|
{$define DELPHI.NET}
|
||||||
|
{$ifdef VER160}
|
||||||
|
{$define DELPHI.NET_1}
|
||||||
|
{$endif VER160}
|
||||||
|
|
||||||
|
// Compiler defines common to all .NET versions.
|
||||||
|
{$ifdef DELPHI.NET_1}
|
||||||
|
{$define DELHI.NET_1_UP}
|
||||||
|
{$endif DELPHI.NET_1}
|
||||||
|
{$endif CLR}
|
||||||
|
|
||||||
|
{$ifdef Win32}
|
||||||
|
|
||||||
|
// DELPHI and BCB are no longer defined, only COMPILER
|
||||||
|
{$ifdef VER180}
|
||||||
|
{$define COMPILER_10}
|
||||||
|
{$endif VER180}
|
||||||
|
|
||||||
|
{$ifdef VER170}
|
||||||
|
{$define COMPILER_9}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_9}
|
||||||
|
{$endif VER170}
|
||||||
|
|
||||||
|
{$ifdef VER160}
|
||||||
|
{$define COMPILER_8}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_8}
|
||||||
|
{$endif VER160}
|
||||||
|
|
||||||
|
{$ifdef VER150}
|
||||||
|
{$define COMPILER_7}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_7}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER140}
|
||||||
|
{$define COMPILER_6}
|
||||||
|
{$ifdef BCB}
|
||||||
|
{$define CPPB}
|
||||||
|
{$define CPPB_6}
|
||||||
|
{$else}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_6}
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER130}
|
||||||
|
{$define COMPILER_5}
|
||||||
|
{$ifdef BCB}
|
||||||
|
{$define CPPB}
|
||||||
|
{$define CPPB_5}
|
||||||
|
{$else}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_5}
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER125}
|
||||||
|
{$define COMPILER_4}
|
||||||
|
{$define CPPB}
|
||||||
|
{$define CPPB_4}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER120}
|
||||||
|
{$define COMPILER_4}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_4}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER110}
|
||||||
|
{$define COMPILER_3}
|
||||||
|
{$define CPPB}
|
||||||
|
{$define CPPB_3}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER100}
|
||||||
|
{$define COMPILER_3}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_3}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER93}
|
||||||
|
{$define COMPILER_2} // C++ Builder v1 compiler is really v2
|
||||||
|
{$define CPPB}
|
||||||
|
{$define CPPB_1}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER90}
|
||||||
|
{$define COMPILER_2}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_2}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER80}
|
||||||
|
{$define COMPILER_1}
|
||||||
|
{$define DELPHI}
|
||||||
|
{$define DELPHI_1}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_2}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_3}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_4}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$define DELPHI_4_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_5}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$define DELPHI_4_UP}
|
||||||
|
{$define DELPHI_5_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_6}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$define DELPHI_4_UP}
|
||||||
|
{$define DELPHI_5_UP}
|
||||||
|
{$define DELPHI_6_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_7}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$define DELPHI_4_UP}
|
||||||
|
{$define DELPHI_5_UP}
|
||||||
|
{$define DELPHI_6_UP}
|
||||||
|
{$define DELPHI_7_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_8}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$define DELPHI_4_UP}
|
||||||
|
{$define DELPHI_5_UP}
|
||||||
|
{$define DELPHI_6_UP}
|
||||||
|
{$define DELPHI_7_UP}
|
||||||
|
{$define DELPHI_8_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef DELPHI_9}
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$define DELPHI_4_UP}
|
||||||
|
{$define DELPHI_5_UP}
|
||||||
|
{$define DELPHI_6_UP}
|
||||||
|
{$define DELPHI_7_UP}
|
||||||
|
{$define DELPHI_8_UP}
|
||||||
|
{$define DELPHI_9_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef CPPB_3}
|
||||||
|
{$define CPPB_3_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef CPPB_4}
|
||||||
|
{$define CPPB_3_UP}
|
||||||
|
{$define CPPB_4_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef CPPB_5}
|
||||||
|
{$define CPPB_3_UP}
|
||||||
|
{$define CPPB_4_UP}
|
||||||
|
{$define CPPB_5_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef CPPB_6}
|
||||||
|
{$define CPPB_3_UP}
|
||||||
|
{$define CPPB_4_UP}
|
||||||
|
{$define CPPB_5_UP}
|
||||||
|
{$define CPPB_6_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef CPPB_3_UP}
|
||||||
|
// C++ Builder requires this if you use Delphi components in run-time packages.
|
||||||
|
{$ObjExportAll On}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$else (not Windows)}
|
||||||
|
// Linux is the target
|
||||||
|
{$define QT_CLX}
|
||||||
|
|
||||||
|
{$define KYLIX}
|
||||||
|
|
||||||
|
{$ifdef VER140}
|
||||||
|
{$define COMPILER_6}
|
||||||
|
{$ifdef conditionalexpressions}
|
||||||
|
{$if Declared(RTLVersion) and (RTLVersion = 14)}
|
||||||
|
{$define KYLIX_1}
|
||||||
|
{$ifend}
|
||||||
|
|
||||||
|
{$if Declared(RTLVersion) and (RTLVersion = 14.2)}
|
||||||
|
{$define KYLIX_2}
|
||||||
|
{$ifend}
|
||||||
|
|
||||||
|
{$if Declared(RTLVersion) and (RTLVersion = 14.5)}
|
||||||
|
{$define KYLIX_3}
|
||||||
|
{$ifend}
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER150}
|
||||||
|
{$define COMPILER_7}
|
||||||
|
{$define KYLIX_3}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef VER140}
|
||||||
|
{$define COMPILER_6}
|
||||||
|
{$define KYLIX_2}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef KYLIX_1}
|
||||||
|
{$define KYLIX_1_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef KYLIX_2}
|
||||||
|
{$define KYLIX_2_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef KYLIX_3}
|
||||||
|
{$define KYLIX_2_UP}
|
||||||
|
{$define KYLIX_3_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$endif Win32}
|
||||||
|
|
||||||
|
// Compiler defines not specific to a particlular platform.
|
||||||
|
|
||||||
|
{$ifdef COMPILER_1}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_2}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_3}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_4}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$define COMPILER_4_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_5}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$define COMPILER_4_UP}
|
||||||
|
{$define COMPILER_5_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_6}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$define COMPILER_4_UP}
|
||||||
|
{$define COMPILER_5_UP}
|
||||||
|
{$define COMPILER_6_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_7}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$define COMPILER_4_UP}
|
||||||
|
{$define COMPILER_5_UP}
|
||||||
|
{$define COMPILER_6_UP}
|
||||||
|
{$define COMPILER_7_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_8}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$define COMPILER_4_UP}
|
||||||
|
{$define COMPILER_5_UP}
|
||||||
|
{$define COMPILER_6_UP}
|
||||||
|
{$define COMPILER_7_UP}
|
||||||
|
{$define COMPILER_8_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_9}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$define COMPILER_4_UP}
|
||||||
|
{$define COMPILER_5_UP}
|
||||||
|
{$define COMPILER_6_UP}
|
||||||
|
{$define COMPILER_7_UP}
|
||||||
|
{$define COMPILER_8_UP}
|
||||||
|
{$define COMPILER_9_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef COMPILER_10}
|
||||||
|
{$define COMPILER_1_UP}
|
||||||
|
{$define COMPILER_2_UP}
|
||||||
|
{$define COMPILER_3_UP}
|
||||||
|
{$define COMPILER_4_UP}
|
||||||
|
{$define COMPILER_5_UP}
|
||||||
|
{$define COMPILER_6_UP}
|
||||||
|
{$define COMPILER_7_UP}
|
||||||
|
{$define COMPILER_8_UP}
|
||||||
|
{$define COMPILER_9_UP}
|
||||||
|
{$define COMPILER_10_UP}
|
||||||
|
// Backwards compatibility
|
||||||
|
{$define DELPHI_2_UP}
|
||||||
|
{$define DELPHI_3_UP}
|
||||||
|
{$define DELPHI_4_UP}
|
||||||
|
{$define DELPHI_5_UP}
|
||||||
|
{$define DELPHI_6_UP}
|
||||||
|
{$define DELPHI_7_UP}
|
||||||
|
{$define DELPHI_8_UP}
|
||||||
|
{$define DELPHI_9_UP}
|
||||||
|
{$define CPPB_3_UP}
|
||||||
|
{$define CPPB_4_UP}
|
||||||
|
{$define CPPB_5_UP}
|
||||||
|
{$define CPPB_6_UP}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
674
components/virtualtreeview/VTAccessibility.pas
Normal file
674
components/virtualtreeview/VTAccessibility.pas
Normal file
@ -0,0 +1,674 @@
|
|||||||
|
unit VTAccessibility;
|
||||||
|
|
||||||
|
// This unit implements iAccessible interfaces for the VirtualTree visual components
|
||||||
|
// and the currently focused node.
|
||||||
|
//
|
||||||
|
// Written by Marco Zehe. (c) 2007
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses Windows, Classes, ActiveX, oleacc, VirtualTrees, VTAccessibilityFactory, Controls;
|
||||||
|
|
||||||
|
type
|
||||||
|
TVirtualTreeAccessibility = class(TInterfacedObject, IDispatch, IAccessible)
|
||||||
|
private
|
||||||
|
FVirtualTree: TVirtualStringTree;
|
||||||
|
public
|
||||||
|
{ IAccessibility }
|
||||||
|
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;
|
||||||
|
{IDispatch}
|
||||||
|
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
|
||||||
|
NameCount: Integer; LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
|
||||||
|
function GetTypeInfo(Index: Integer; LocaleID: Integer;
|
||||||
|
out TypeInfo): HRESULT; stdcall;
|
||||||
|
function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
|
||||||
|
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)
|
||||||
|
public
|
||||||
|
{ IAccessibility }
|
||||||
|
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 accLocation(out pxLeft: Integer;
|
||||||
|
out pyTop: Integer; out pcxWidth: Integer;
|
||||||
|
out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
|
||||||
|
constructor Create(VirtualTree: TVirtualStringTree);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TVTMultiColumnItemAccessibility = class(TVirtualTreeItemAccessibility, IAccessible)
|
||||||
|
private
|
||||||
|
function GetItemDescription(varChild: OleVariant; out pszDescription: WideString; IncludeMainColumn: boolean): HResult; stdcall;
|
||||||
|
public
|
||||||
|
{ IAccessibility }
|
||||||
|
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
|
||||||
|
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TVTDefaultAccessibleProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
||||||
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TVTDefaultAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
||||||
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TVTMultiColumnAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
|
||||||
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses Variants, SysUtils, Types, Forms;
|
||||||
|
|
||||||
|
{ TVirtualTreeAccessibility }
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
function TVirtualTreeAccessibility.accDoDefaultAction(varChild: OleVariant): HResult;
|
||||||
|
// a default action is not supported.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND;
|
||||||
|
end;
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
function TVirtualTreeAccessibility.accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult;
|
||||||
|
// returns the iAccessible object at the given point, if applicable.
|
||||||
|
var
|
||||||
|
Pt: TPoint;
|
||||||
|
HitInfo: THitInfo;
|
||||||
|
begin
|
||||||
|
Result := S_FALSE;
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
// VariantInit(pvarChild);
|
||||||
|
// TVarData(pvarChild).VType := VT_I4;
|
||||||
|
Pt := fVirtualTree.ScreenToClient(Point(xLeft, yTop));
|
||||||
|
if fVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
fVirtualTree.GetHitTestInfoAt(xLeft, yTop, false, HitInfo);
|
||||||
|
if FVirtualTree.FocusedNode = HitInfo.HitNode then
|
||||||
|
begin
|
||||||
|
pvarChild := FVirtualTree.AccessibleItem;
|
||||||
|
Result := S_OK;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if PtInRect(FVirtualTree.BoundsRect, Pt) then
|
||||||
|
begin
|
||||||
|
pvarChild := CHILDID_SELF;
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.accLocation(out pxLeft: Integer;
|
||||||
|
out pyTop: Integer; out pcxWidth: Integer;
|
||||||
|
out pcyHeight: Integer; varChild: OleVariant): HResult;
|
||||||
|
// returns the location of the VirtualStringTree object.
|
||||||
|
var
|
||||||
|
P: TPoint;
|
||||||
|
begin
|
||||||
|
Result := S_FALSE;
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
P := FVirtualTree.ClientToScreen(FVirtualTree.ClientRect.TopLeft);
|
||||||
|
pxLeft := P.X;
|
||||||
|
pyTop := P.Y;
|
||||||
|
pcxWidth := FVirtualTree.Width;
|
||||||
|
pcyHeight := FVirtualTree.Height;
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.accNavigate(navDir: Integer; varStart: OleVariant;
|
||||||
|
out pvarEndUpAt: OleVariant): HResult;
|
||||||
|
// This is not supported.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accSelection(out pvarChildren: OleVariant): HResult;
|
||||||
|
// returns the selected child ID, if any.
|
||||||
|
begin
|
||||||
|
Result := s_false;
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
if fVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
pvarChildren := 1;
|
||||||
|
result := s_OK;
|
||||||
|
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;
|
||||||
|
// Not supported.
|
||||||
|
begin
|
||||||
|
Result := E_NOTIMPL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.GetTypeInfo(Index, LocaleID: Integer;
|
||||||
|
out TypeInfo): HRESULT;
|
||||||
|
// not supported.
|
||||||
|
begin
|
||||||
|
Result := E_NOTIMPL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.GetTypeInfoCount(
|
||||||
|
out Count: Integer): HRESULT;
|
||||||
|
// not supported.
|
||||||
|
begin
|
||||||
|
Result := E_NOTIMPL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult;
|
||||||
|
// returns the iAccessible child, whicfh represents the focused item.
|
||||||
|
begin
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
begin
|
||||||
|
ppdispChild := FVirtualTree.AccessibleItem;
|
||||||
|
Result := S_OK;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := E_INVALIDARG
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accChildCount(out pcountChildren: Integer): HResult;
|
||||||
|
// Returns the number 1 for the one child: The focused item.
|
||||||
|
begin
|
||||||
|
pcountChildren := 1;
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult;
|
||||||
|
// Not supported.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult;
|
||||||
|
// returns the hint of the control, if assigned.
|
||||||
|
begin
|
||||||
|
pszDescription := '';
|
||||||
|
Result := S_FALSE;
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
pszDescription := GetLongHint(fVirtualTree.Hint);
|
||||||
|
end;
|
||||||
|
if Length(pszDescription) > 0 then
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accFocus(out pvarChild: OleVariant): HResult;
|
||||||
|
// returns the child ID of 1, if assigned.
|
||||||
|
begin
|
||||||
|
Result := s_false;
|
||||||
|
if fVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
if FVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
pvarChild := fVirtualTree.AccessibleItem;
|
||||||
|
result := s_OK;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
pvarChild := childid_self;
|
||||||
|
result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult;
|
||||||
|
// Not supported.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
|
||||||
|
out pidTopic: Integer): HResult;
|
||||||
|
// Returns the HelpContext ID, if present.
|
||||||
|
begin
|
||||||
|
pszHelpFile := '';
|
||||||
|
pidTopic := 0;
|
||||||
|
Result := S_OK;
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
pszHelpFile := Application.HelpFile;
|
||||||
|
pidTopic := FVirtualTree.HelpContext;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult;
|
||||||
|
// Not supported.
|
||||||
|
begin
|
||||||
|
pszKeyboardShortcut := '';
|
||||||
|
Result := S_FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
|
||||||
|
// if set, returns the new published AccessibleName property.
|
||||||
|
// otherwise, returns the default text.
|
||||||
|
begin
|
||||||
|
pszName := '';
|
||||||
|
Result := S_FALSE;
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
if FVirtualTree.AccessibleName <> '' then
|
||||||
|
pszName := FVirtualTree.AccessibleName
|
||||||
|
else
|
||||||
|
PSZName := FVirtualTree.DefaultText;
|
||||||
|
result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accParent(out ppdispParent: IDispatch): HResult;
|
||||||
|
// Returns false, the tree itself does not have a parent.
|
||||||
|
begin
|
||||||
|
ppdispParent := nil;
|
||||||
|
Result := S_FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult;
|
||||||
|
// tells MSAA that it is a TreeView.
|
||||||
|
begin
|
||||||
|
Result := S_OK;
|
||||||
|
// VariantInit(pvarRole);
|
||||||
|
// TVarData(pvarRole).VType := VT_I4;
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
pvarRole := ROLE_SYSTEM_OUTLINE
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult;
|
||||||
|
// since we're not supporting more than one item, this is not supported currently.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult;
|
||||||
|
// returns the state of the control.
|
||||||
|
const
|
||||||
|
IsEnabled: array[Boolean] of Integer = (STATE_SYSTEM_UNAVAILABLE, 0);
|
||||||
|
HasPopup: array[Boolean] of Integer = (0, STATE_SYSTEM_HASPOPUP);
|
||||||
|
IsVisible: array[Boolean] of Integer = (STATE_SYSTEM_INVISIBLE, 0);
|
||||||
|
begin
|
||||||
|
Result := S_OK;
|
||||||
|
// VariantInit(pvarState);
|
||||||
|
// TVarData(pvarState).VType := VT_I4;
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
pvarState := STATE_SYSTEM_FOCUSED or STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_HOTTRACKED;
|
||||||
|
pvarState := pvarState or IsVisible[FVirtualTree.Visible];
|
||||||
|
pvarState := pvarState or IsEnabled[FVirtualTree.Enabled];
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := E_INVALIDARG;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult;
|
||||||
|
// the TreeView control itself does not have a value, returning false here.
|
||||||
|
begin
|
||||||
|
pszValue := '';
|
||||||
|
Result := S_FALSE;//DISP_E_MEMBERNOTFOUND;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Invoke(DispID: Integer; const IID: TGUID;
|
||||||
|
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
|
||||||
|
ArgErr: Pointer): HRESULT;
|
||||||
|
// not supported.
|
||||||
|
begin
|
||||||
|
Result := E_NOTIMPL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
|
||||||
|
// not supported.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeAccessibility.Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult;
|
||||||
|
// not supported.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TVirtualTreeItemAccessibility }
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.accLocation(out pxLeft, pyTop, pcxWidth,
|
||||||
|
pcyHeight: Integer; varChild: OleVariant): HResult;
|
||||||
|
// returns the location of the current accessible item.
|
||||||
|
var
|
||||||
|
P: TPoint;
|
||||||
|
DisplayRect: TRect;
|
||||||
|
begin
|
||||||
|
Result := S_FALSE;
|
||||||
|
if varChild = CHILDID_SELF then
|
||||||
|
begin
|
||||||
|
if FVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
DisplayRect := FVirtualTree.GetDisplayRect(FVirtualTree.FocusedNode, -1, TRUE, FALSE);
|
||||||
|
P := FVirtualTree.ClientToScreen(DisplayRect.TopLeft);
|
||||||
|
pxLeft := P.X;
|
||||||
|
pyTop := P.Y;
|
||||||
|
pcxWidth := DisplayRect.Right - DisplayRect.Left;
|
||||||
|
pcyHeight := DisplayRect.Bottom - DisplayRect.Top;
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
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.
|
||||||
|
begin
|
||||||
|
ppdispChild := nil;
|
||||||
|
Result := S_FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.Get_accChildCount(out pcountChildren: Integer): HResult;
|
||||||
|
// the item itself does not have children, returning 0.
|
||||||
|
begin
|
||||||
|
pcountChildren := 0;
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult;
|
||||||
|
// not supported for an item.
|
||||||
|
begin
|
||||||
|
Result := DISP_E_MEMBERNOTFOUND;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
|
||||||
|
// the name is the node's caption.
|
||||||
|
begin
|
||||||
|
pszName := '';
|
||||||
|
Result := S_FALSE;
|
||||||
|
if varChild = childid_self then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
if FVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
pszName := FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn];
|
||||||
|
result := S_OK;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
PSZName := FVirtualTree.DefaultText;
|
||||||
|
result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.Get_accParent(out ppdispParent: IDispatch): HResult;
|
||||||
|
// tells MSAA that the VritualStringTree is its parent.
|
||||||
|
begin
|
||||||
|
result := S_FALSE;
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
ppdispParent := FVirtualTree.Accessible;
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult;
|
||||||
|
// tells MSAA that it is a TreeView item as opposed to the TreeView itself.
|
||||||
|
begin
|
||||||
|
Result := S_OK;
|
||||||
|
// VariantInit(pvarRole);
|
||||||
|
// TVarData(pvarRole).VType := VT_I4;
|
||||||
|
if varChild = childid_self then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
pvarRole := ROLE_SYSTEM_OUTLINEITEM
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult;
|
||||||
|
// Tells MSAA the state the item is in.
|
||||||
|
const
|
||||||
|
IsEnabled: array[Boolean] of Integer = (STATE_SYSTEM_UNAVAILABLE, 0);
|
||||||
|
HasPopup: array[Boolean] of Integer = (0, STATE_SYSTEM_HASPOPUP);
|
||||||
|
IsVisible: array[Boolean] of Integer = (STATE_SYSTEM_INVISIBLE, 0);
|
||||||
|
IsChecked: array[Boolean] of Integer = (0, STATE_SYSTEM_CHECKED);
|
||||||
|
IsExpanded: array[Boolean] of Integer = (0, STATE_SYSTEM_EXPANDED);
|
||||||
|
IsCollapsed: array[Boolean] of Integer = (0, STATE_SYSTEM_COLLAPSED);
|
||||||
|
begin
|
||||||
|
Result := S_OK;
|
||||||
|
// VariantInit(pvarState);
|
||||||
|
// TVarData(pvarState).VType := VT_I4;
|
||||||
|
if varChild = childid_self then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
begin
|
||||||
|
pvarState := STATE_SYSTEM_FOCUSED or STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_HOTTRACKED;
|
||||||
|
pvarState := pvarState or IsVisible[FVirtualTree.Visible];
|
||||||
|
pvarState := pvarState or IsEnabled[FVirtualTree.Enabled];
|
||||||
|
if fVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
pvarState := pvarState or IsChecked[csCheckedNormal = FVirtualTree.FocusedNode.CheckState];
|
||||||
|
pvarState := pvarState or IsExpanded[VSExpanded in FVirtualTree.FocusedNode.States];
|
||||||
|
if not (vsExpanded in FVirtualTree.FocusedNode.States) then
|
||||||
|
pvarState:= PvarState or IsCollapsed[vsHasChildren in FVirtualTree.FocusedNode.States];
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := E_INVALIDARG;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
function TVirtualTreeItemAccessibility.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult;
|
||||||
|
// for a TreeView item, the value is the nesting level number, 0-based.
|
||||||
|
begin
|
||||||
|
pszValue := '';
|
||||||
|
Result := S_FALSE;//DISP_E_MEMBERNOTFOUND;
|
||||||
|
if varChild = childid_self then
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
if FVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
PSZValue := IntToStr(FVirtualTree.GetNodeLevel(FVirtualTree.FocusedNode));
|
||||||
|
result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TVTMultiColumnItemAccessibility }
|
||||||
|
|
||||||
|
function TVTMultiColumnItemAccessibility.GetItemDescription(
|
||||||
|
varChild: OleVariant; out pszDescription: WideString;
|
||||||
|
IncludeMainColumn: boolean): HResult;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
sTemp: WideString;
|
||||||
|
begin
|
||||||
|
pszDescription := '';
|
||||||
|
Result := S_FALSE;
|
||||||
|
if varChild = childid_self then
|
||||||
|
begin
|
||||||
|
if FVirtualTree <> nil then
|
||||||
|
if FVirtualTree.FocusedNode <> nil then
|
||||||
|
begin
|
||||||
|
if IncludeMainColumn then
|
||||||
|
pszDescription := FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn]
|
||||||
|
+'; ';
|
||||||
|
for I := 0 to FVirtualTree.Header.Columns.Count - 1 do
|
||||||
|
if FVirtualTree.Header.MainColumn <> I then
|
||||||
|
begin
|
||||||
|
sTemp := FVirtualTree.Text[FVirtualTree.FocusedNode, I];
|
||||||
|
if sTemp <> '' then
|
||||||
|
pszDescription := pszDescription
|
||||||
|
+FVirtualTree.Header.Columns[I].Text
|
||||||
|
+': '
|
||||||
|
+sTemp
|
||||||
|
+'; ';
|
||||||
|
end;
|
||||||
|
if pszDescription <> '' then
|
||||||
|
if pszDescription[Length(pszDescription)-1] = ';' then
|
||||||
|
Delete(pszDescription, length(pszDescription)-1, 2);
|
||||||
|
result := S_OK;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
PSZDescription := FVirtualTree.DefaultText;
|
||||||
|
result := S_OK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TVTMultiColumnItemAccessibility.Get_accDescription(
|
||||||
|
varChild: OleVariant; out pszDescription: WideString): HResult;
|
||||||
|
begin
|
||||||
|
result := GetItemDescription(varChild, pszDescription, false)
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TVTMultiColumnItemAccessibility.Get_accName(varChild: OleVariant;
|
||||||
|
out pszName: WideString): HResult;
|
||||||
|
begin
|
||||||
|
result := GetItemDescription(varChild, pszName, true)
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TVTDefaultAccessibleProvider }
|
||||||
|
|
||||||
|
function TVTDefaultAccessibleProvider.CreateIAccessible(
|
||||||
|
ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
begin
|
||||||
|
result := TVirtualTreeAccessibility.Create(TVirtualStringTree(ATree));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TVTDefaultAccessibleItemProvider }
|
||||||
|
|
||||||
|
function TVTDefaultAccessibleItemProvider.CreateIAccessible(
|
||||||
|
ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
begin
|
||||||
|
result := TVirtualTreeItemAccessibility.Create(TVirtualStringTree(ATree));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TVTMultiColumnAccessibleItemProvider }
|
||||||
|
|
||||||
|
function TVTMultiColumnAccessibleItemProvider.CreateIAccessible(
|
||||||
|
ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
begin
|
||||||
|
result := nil;
|
||||||
|
if TVirtualStringTree(ATree).Header.UseColumns then
|
||||||
|
result := TVTMultiColumnItemAccessibility.Create(TVirtualStringTree(ATree));
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
IDefaultAccessibleProvider: TVTDefaultAccessibleProvider;
|
||||||
|
IDefaultAccessibleItemProvider: TVTDefaultAccessibleItemProvider;
|
||||||
|
IMultiColumnAccessibleProvider: TVTMultiColumnAccessibleItemProvider;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
if VTAccessibleFactory = nil then
|
||||||
|
VTAccessibleFactory := TVTAccessibilityFactory.Create;
|
||||||
|
if IDefaultAccessibleProvider = nil then
|
||||||
|
begin
|
||||||
|
IDefaultAccessibleProvider := TVTDefaultAccessibleProvider.Create;
|
||||||
|
VTAccessibleFactory.RegisterAccessibleProvider(IDefaultAccessibleProvider);
|
||||||
|
end;
|
||||||
|
if IDefaultAccessibleItemProvider = nil then
|
||||||
|
begin
|
||||||
|
IDefaultAccessibleItemProvider := TVTDefaultAccessibleItemProvider.Create;
|
||||||
|
VTAccessibleFactory.RegisterAccessibleProvider(IDefaultAccessibleItemProvider);
|
||||||
|
end;
|
||||||
|
if IMultiColumnAccessibleProvider = nil then
|
||||||
|
begin
|
||||||
|
IMultiColumnAccessibleProvider := TVTMultiColumnAccessibleItemProvider.Create;
|
||||||
|
VTAccessibleFactory.RegisterAccessibleProvider(IMultiColumnAccessibleProvider);
|
||||||
|
end;
|
||||||
|
finalization
|
||||||
|
if VTAccessibleFactory <> nil then
|
||||||
|
begin
|
||||||
|
VTAccessibleFactory.UnRegisterAccessibleProvider(IMultiColumnAccessibleProvider);
|
||||||
|
IMultiColumnAccessibleProvider := nil;
|
||||||
|
VTAccessibleFactory.UnRegisterAccessibleProvider(IDefaultAccessibleItemProvider);
|
||||||
|
IDefaultAccessibleItemProvider := nil;
|
||||||
|
VTAccessibleFactory.UnRegisterAccessibleProvider(IDefaultAccessibleProvider);
|
||||||
|
IDefaultAccessibleProvider := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
123
components/virtualtreeview/VTAccessibilityFactory.pas
Normal file
123
components/virtualtreeview/VTAccessibilityFactory.pas
Normal file
@ -0,0 +1,123 @@
|
|||||||
|
unit VTAccessibilityFactory;
|
||||||
|
|
||||||
|
// class to create IAccessibles for the tree passed into it.
|
||||||
|
// If not already assigned, creates IAccessibles for the tree itself
|
||||||
|
// and the focused item
|
||||||
|
// the tree accessible is returned when the tree receives an WM_GETOBJECT message
|
||||||
|
// the AccessibleItem is returned when the Accessible is being asked for the first child
|
||||||
|
// To create your own IAccessibles, use the VTStandardAccessible unit as a reference,
|
||||||
|
// and assign your Accessibles to the variables in tthe unit's initialization.
|
||||||
|
// You only need to add the unit to your project, and voil�, you have an accessible string tree!
|
||||||
|
//
|
||||||
|
// Written by Marco Zehe. (c) 2007
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, oleacc, VirtualTrees;
|
||||||
|
|
||||||
|
type
|
||||||
|
IVTAccessibleProvider = interface
|
||||||
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TVTAccessibilityFactory = class(TObject)
|
||||||
|
private
|
||||||
|
FAccessibleProviders: TInterfaceList;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
procedure RegisterAccessibleProvider(AProvider: IVTAccessibleProvider);
|
||||||
|
procedure UnRegisterAccessibleProvider(AProvider: IVTAccessibleProvider);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
VTAccessibleFactory: TVTAccessibilityFactory;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TVTAccessibilityFactory }
|
||||||
|
|
||||||
|
constructor TVTAccessibilityFactory.Create;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FAccessibleProviders := TInterfaceList.Create;
|
||||||
|
FAccessibleProviders.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TVTAccessibilityFactory.CreateIAccessible(
|
||||||
|
ATree: TBaseVirtualTree): IAccessible;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
TmpIAccessible: IAccessible;
|
||||||
|
// returns an IAccessible.
|
||||||
|
// 1. If the Accessible property of the passed-in tree is nil,
|
||||||
|
// the first registered element will be returned.
|
||||||
|
// Usually, this is the IAccessible that provides information about the tree itself.
|
||||||
|
// If it is not nil, we'll check whether the AccessibleItem is nil.
|
||||||
|
// If it is, we'll look in the registered IAccessibles for the appropriate one.
|
||||||
|
// Each IAccessibleProvider will check the tree for properties to determine whether it is responsible.
|
||||||
|
// 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;
|
||||||
|
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;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if ATree.AccessibleItem = nil then
|
||||||
|
begin
|
||||||
|
if FAccessibleProviders.Count > 0 then
|
||||||
|
begin
|
||||||
|
for I := FAccessibleProviders.Count - 1 downto 1 do
|
||||||
|
begin
|
||||||
|
TmpIAccessible := IVTAccessibleProvider(FAccessibleProviders.Items[I]).CreateIAccessible(ATree);
|
||||||
|
if TmpIAccessible <> nil then
|
||||||
|
begin
|
||||||
|
result := TmpIAccessible;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if TmpIAccessible = nil then
|
||||||
|
begin
|
||||||
|
result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
result := ATree.AccessibleItem;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TVTAccessibilityFactory.Destroy;
|
||||||
|
begin
|
||||||
|
FAccessibleProviders.Free;
|
||||||
|
FAccessibleProviders := nil;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TVTAccessibilityFactory.RegisterAccessibleProvider(
|
||||||
|
AProvider: IVTAccessibleProvider);
|
||||||
|
// Ads a provider if it is not already registered
|
||||||
|
begin
|
||||||
|
if FAccessibleProviders.IndexOf(AProvider) < 0 then
|
||||||
|
FAccessibleProviders.Add(AProvider)
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TVTAccessibilityFactory.UnRegisterAccessibleProvider(
|
||||||
|
AProvider: IVTAccessibleProvider);
|
||||||
|
// Unregisters/removes an IAccessible provider if it is present
|
||||||
|
begin
|
||||||
|
if FAccessibleProviders.IndexOf(AProvider) >= 0 then
|
||||||
|
FAccessibleProviders.Remove(AProvider);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
35
components/virtualtreeview/VTConfig.inc
Normal file
35
components/virtualtreeview/VTConfig.inc
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
// Configuration file for VirtualTrees.pas (see www.soft-gems.net).
|
||||||
|
//
|
||||||
|
// The content of this file is public domain. You may do with it whatever you like, provided the header stays fully intact
|
||||||
|
// in all version and derivative work.
|
||||||
|
//
|
||||||
|
// The original code is VTConfig.inc, released October 5, 2004.
|
||||||
|
//
|
||||||
|
// The initial developer of the original code is Mike Lischke (public@soft-gems.net, www.soft-gems.net).
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
{.$define UseFlatScrollbars}
|
||||||
|
{.$define ReverseFullExpandHotKey} // Used to define Ctrl+'+' instead of Ctrl+Shift+'+' for full expand (and similar for collapsing).
|
||||||
|
|
||||||
|
// Enable this switch for Windows XP theme support. If you compile with Delphi 6 or lower you must download and install
|
||||||
|
// the Soft Gems Theme Manager package.
|
||||||
|
{.$define ThemeSupport}
|
||||||
|
|
||||||
|
// Virtual Treeview can use a tiny but very effective local memory manager for node allocation.
|
||||||
|
// The local memory manager was implemented by David Clark from Caelo Software Inc.
|
||||||
|
// See below for more info about it.
|
||||||
|
{.$define UseLocalMemoryManager}
|
||||||
|
|
||||||
|
{.$define TntSupport} // Added by Igor Afanasyev to support unicode-aware inplace editors. This implementation uses
|
||||||
|
// Troy Wolbrink's TNT controls, which can be found at:
|
||||||
|
// http://home.ccci.org/wolbrink/tnt/delphi_unicode_controls.htm.
|
||||||
|
|
||||||
|
//Lazarus port options
|
||||||
|
{$define EnableOLE}
|
||||||
|
{.$define EnableNativeTVM}
|
||||||
|
{.$define EnablePrint}
|
||||||
|
{$define NeedWindows}
|
||||||
|
{.$define EnableAdvancedGraphics}
|
||||||
|
{.$define EnableHeader}
|
||||||
|
{.$define EnableTimer}
|
||||||
|
{.$define EnableAccessible}
|
||||||
251
components/virtualtreeview/VTHeaderPopup.pas
Normal file
251
components/virtualtreeview/VTHeaderPopup.pas
Normal file
@ -0,0 +1,251 @@
|
|||||||
|
unit VTHeaderPopup;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
// The contents of this file are subject to the Mozilla Public License
|
||||||
|
// Version 1.1 (the "License"); you may not use this file except in
|
||||||
|
// compliance with the License. You may obtain a copy of the License at
|
||||||
|
// http://www.mozilla.org/MPL/
|
||||||
|
//
|
||||||
|
// Alternatively, you may redistribute this library, use and/or modify it under the terms of the
|
||||||
|
// GNU Lesser General Public License as published by the Free Software Foundation;
|
||||||
|
// either version 2.1 of the License, or (at your option) any later version.
|
||||||
|
// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/.
|
||||||
|
//
|
||||||
|
// Software distributed under the License is distributed on an "AS IS"
|
||||||
|
// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
|
||||||
|
// License for the specific language governing rights and limitations
|
||||||
|
// under the License.
|
||||||
|
//
|
||||||
|
// The Original Code is VTHeaderPopup.pas.
|
||||||
|
//
|
||||||
|
// The Initial Developer of the Original Code is Ralf Junker <delphi@zeitungsjunge.de>. All Rights Reserved.
|
||||||
|
//
|
||||||
|
// September 2004:
|
||||||
|
// - Bug fix: TVTHeaderPopupMenu.OnMenuItemClick used the wrong Tag member for the event.
|
||||||
|
//
|
||||||
|
// Modified 12 Dec 2003 by Ralf Junker <delphi@zeitungsjunge.de>.
|
||||||
|
// - Added missing default storage specifier for Options property.
|
||||||
|
// - To avoid mixing up image lists of different trees sharing the same header
|
||||||
|
// popup, set the popup's image list to nil if hoShowImages is not in the
|
||||||
|
// tree's header options.
|
||||||
|
// - Added an additional check for the PopupComponent property before casting
|
||||||
|
// it hardly to a Virtual Treeview in OnMenuItemClick. See entry 31 Mar 2003.
|
||||||
|
//
|
||||||
|
// Modified 14 Sep 2003 by Mike Lischke <public@delphi-gems.com>.
|
||||||
|
// - Renamed event type name to be consistent with other event types (e.g. used in VT).
|
||||||
|
// - Added event for hiding/showing columns.
|
||||||
|
// - DoXXX method are now virtual.
|
||||||
|
// - Conditional code rearrangement to get back Ctrl+Shift+Up/Down navigation.
|
||||||
|
//
|
||||||
|
// Modified 31 Mar 2003 by Mike Lischke <public@soft-gems.net>.
|
||||||
|
// - Added a check for the PopupComponent property before casting it hardly to
|
||||||
|
// a Virtual Treeview. People might (accidentally) misuse the header popup.
|
||||||
|
//
|
||||||
|
// Modified 20 Oct 2002 by Borut Maricic <borut.maricic@pobox.com>.
|
||||||
|
// - Added the possibility to use Troy Wolbrink's Unicode aware popup menu.
|
||||||
|
// Define the compiler symbol TNT to enable it. You can get Troy's Unicode
|
||||||
|
// controls collection from http://home.ccci.org/wolbrink/tnt/delphi_unicode_controls.htm.
|
||||||
|
//
|
||||||
|
// Modified 24 Feb 2002 by Ralf Junker <delphi@zeitungsjunge.de>.
|
||||||
|
// - Fixed a bug where the OnAddHeaderPopupItem would interfere with
|
||||||
|
// poAllowHideAll options.
|
||||||
|
// - All column indexes now consistently use TColumnIndex (instead of Integer).
|
||||||
|
//
|
||||||
|
// Modified 23 Feb 2002 by Ralf Junker <delphi@zeitungsjunge.de>.
|
||||||
|
// - Added option to show menu items in the same order as the columns or in
|
||||||
|
// original order.
|
||||||
|
// - Added option to prevent the user to hide all columns.
|
||||||
|
//
|
||||||
|
// Modified 17 Feb 2002 by Jim Kueneman <jimdk@mindspring.com>.
|
||||||
|
// - Added the event to filter the items as they are added to the menu.
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
{$I Compilers.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$ifdef TNT}
|
||||||
|
TntMenus,
|
||||||
|
{$else}
|
||||||
|
Menus,
|
||||||
|
{$endif TNT}
|
||||||
|
VirtualTrees;
|
||||||
|
|
||||||
|
type
|
||||||
|
TVTHeaderPopupOption = (
|
||||||
|
poOriginalOrder, // Show menu items in original column order as they were added to the tree.
|
||||||
|
poAllowHideAll // Allows to hide all columns, including the last one.
|
||||||
|
);
|
||||||
|
TVTHeaderPopupOptions = set of TVTHeaderPopupOption;
|
||||||
|
|
||||||
|
TAddPopupItemType = (
|
||||||
|
apNormal,
|
||||||
|
apDisabled,
|
||||||
|
apHidden
|
||||||
|
);
|
||||||
|
|
||||||
|
TAddHeaderPopupItemEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex;
|
||||||
|
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
|
||||||
|
FOptions: TVTHeaderPopupOptions;
|
||||||
|
|
||||||
|
FOnAddHeaderPopupItem: TAddHeaderPopupItemEvent;
|
||||||
|
FOnColumnChange: TColumnChangeEvent;
|
||||||
|
protected
|
||||||
|
procedure DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType); virtual;
|
||||||
|
procedure DoColumnChange(Column: TColumnIndex; Visible: Boolean); virtual;
|
||||||
|
procedure OnMenuItemClick(Sender: TObject);
|
||||||
|
public
|
||||||
|
procedure Popup(x, y: Integer); override;
|
||||||
|
published
|
||||||
|
property Options: TVTHeaderPopupOptions read FOptions write FOptions default [];
|
||||||
|
|
||||||
|
property OnAddHeaderPopupItem: TAddHeaderPopupItemEvent read FOnAddHeaderPopupItem write FOnAddHeaderPopupItem;
|
||||||
|
property OnColumnChange: TColumnChangeEvent read FOnColumnChange write FOnColumnChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$ifdef TNT}
|
||||||
|
TnTClasses
|
||||||
|
{$else}
|
||||||
|
Classes
|
||||||
|
{$endif TNT};
|
||||||
|
|
||||||
|
type
|
||||||
|
TVirtualTreeCast = class(TBaseVirtualTree); // Necessary to make the header accessible.
|
||||||
|
|
||||||
|
//----------------- TVTHeaderPopupMenu ---------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TVTHeaderPopupMenu.DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Cmd := apNormal;
|
||||||
|
if Assigned(FOnAddHeaderPopupItem) then
|
||||||
|
FOnAddHeaderPopupItem(TVirtualTreeCast(PopupComponent), Column, Cmd);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TVTHeaderPopupMenu.DoColumnChange(Column: TColumnIndex; Visible: Boolean);
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Assigned(FOnColumnChange) then
|
||||||
|
FOnColumnChange(TVirtualTreeCast(PopupComponent), Column, Visible);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TVTHeaderPopupMenu.OnMenuItemClick(Sender: TObject);
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then
|
||||||
|
with TVTMenuItem(Sender),
|
||||||
|
TVirtualTreeCast(PopupComponent).Header.Columns.Items[Tag] do
|
||||||
|
begin
|
||||||
|
if Checked then
|
||||||
|
Options := Options - [coVisible]
|
||||||
|
else
|
||||||
|
Options := Options + [coVisible];
|
||||||
|
|
||||||
|
DoColumnChange(TVTMenuItem(Sender).Tag, not Checked);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TVTHeaderPopupMenu.Popup(x, y: Integer);
|
||||||
|
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
ColPos: TColumnPosition;
|
||||||
|
ColIdx: TColumnIndex;
|
||||||
|
|
||||||
|
NewMenuItem: TVTMenuItem;
|
||||||
|
Cmd: TAddPopupItemType;
|
||||||
|
|
||||||
|
VisibleCounter: Cardinal;
|
||||||
|
VisibleItem: TVTMenuItem;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then
|
||||||
|
begin
|
||||||
|
// Delete existing menu items.
|
||||||
|
I := Items.Count;
|
||||||
|
while I > 0 do
|
||||||
|
begin
|
||||||
|
Dec(I);
|
||||||
|
Items[I].Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Add column menu items.
|
||||||
|
with TVirtualTreeCast(PopupComponent).Header do
|
||||||
|
begin
|
||||||
|
if hoShowImages in Options then
|
||||||
|
Self.Images := Images
|
||||||
|
else
|
||||||
|
// Remove a possible reference to image list of another tree previously assigned.
|
||||||
|
Self.Images := nil;
|
||||||
|
VisibleItem := nil;
|
||||||
|
VisibleCounter := 0;
|
||||||
|
for ColPos := 0 to Columns.Count - 1 do
|
||||||
|
begin
|
||||||
|
if poOriginalOrder in FOptions then
|
||||||
|
ColIdx := ColPos
|
||||||
|
else
|
||||||
|
ColIdx := Columns.ColumnFromPosition(ColPos);
|
||||||
|
|
||||||
|
with Columns[ColIdx] do
|
||||||
|
begin
|
||||||
|
if coVisible in Options then
|
||||||
|
Inc(VisibleCounter);
|
||||||
|
DoAddHeaderPopupItem(ColIdx, Cmd);
|
||||||
|
if Cmd <> apHidden then
|
||||||
|
begin
|
||||||
|
NewMenuItem := TVTMenuItem.Create(Self);
|
||||||
|
NewMenuItem.Tag := ColIdx;
|
||||||
|
NewMenuItem.Caption := Text;
|
||||||
|
NewMenuItem.Hint := Hint;
|
||||||
|
NewMenuItem.ImageIndex := ImageIndex;
|
||||||
|
NewMenuItem.Checked := coVisible in Options;
|
||||||
|
NewMenuItem.OnClick := OnMenuItemClick;
|
||||||
|
if Cmd = apDisabled then
|
||||||
|
NewMenuItem.Enabled := False
|
||||||
|
else
|
||||||
|
if coVisible in Options then
|
||||||
|
VisibleItem := NewMenuItem;
|
||||||
|
Items.Add(NewMenuItem);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Conditionally disable menu item of last enabled column.
|
||||||
|
if (VisibleCounter = 1) and (VisibleItem <> nil) and not (poAllowHideAll in FOptions) then
|
||||||
|
VisibleItem.Enabled := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
32072
components/virtualtreeview/VirtualTrees.pas
Normal file
32072
components/virtualtreeview/VirtualTrees.pas
Normal file
File diff suppressed because it is too large
Load Diff
103
components/virtualtreeview/demos/mininal/Main.lfm
Normal file
103
components/virtualtreeview/demos/mininal/Main.lfm
Normal file
@ -0,0 +1,103 @@
|
|||||||
|
object MainForm: TMainForm
|
||||||
|
Left = 353
|
||||||
|
Height = 481
|
||||||
|
Top = 172
|
||||||
|
Width = 425
|
||||||
|
HorzScrollBar.Page = 424
|
||||||
|
VertScrollBar.Page = 480
|
||||||
|
ActiveControl = VST
|
||||||
|
Caption = 'Simple Virtual Treeview demo'
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'MS Sans Serif'
|
||||||
|
OnCreate = FormCreate
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 12
|
||||||
|
Height = 14
|
||||||
|
Top = 12
|
||||||
|
Width = 117
|
||||||
|
Caption = 'Last operation duration:'
|
||||||
|
Color = clNone
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object VST: TVirtualStringTree
|
||||||
|
Left = 8
|
||||||
|
Height = 318
|
||||||
|
Top = 36
|
||||||
|
Width = 397
|
||||||
|
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||||
|
Colors.BorderColor = clWindowText
|
||||||
|
Colors.HotColor = clBlack
|
||||||
|
Header.AutoSizeIndex = -1
|
||||||
|
Header.Font.Height = -11
|
||||||
|
Header.Font.Name = 'MS Sans Serif'
|
||||||
|
Header.MainColumn = -1
|
||||||
|
Header.Options = [hoColumnResize, hoDrag]
|
||||||
|
HintAnimation = hatNone
|
||||||
|
IncrementalSearch = isAll
|
||||||
|
RootNodeCount = 100
|
||||||
|
TabOrder = 0
|
||||||
|
TreeOptions.AnimationOptions = [toAnimatedToggle]
|
||||||
|
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoTristateTracking]
|
||||||
|
TreeOptions.MiscOptions = [toEditable, toInitOnSave, toToggleOnDblClick, toWheelPanning]
|
||||||
|
TreeOptions.PaintOptions = [toShowButtons, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages]
|
||||||
|
TreeOptions.SelectionOptions = [toMultiSelect, toCenterScrollIntoView]
|
||||||
|
OnFreeNode = VSTFreeNode
|
||||||
|
OnGetText = VSTGetText
|
||||||
|
OnInitNode = VSTInitNode
|
||||||
|
Columns = <>
|
||||||
|
end
|
||||||
|
object ClearButton: TButton
|
||||||
|
Left = 97
|
||||||
|
Height = 25
|
||||||
|
Top = 421
|
||||||
|
Width = 129
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = 'Clear tree'
|
||||||
|
OnClick = ClearButtonClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object AddOneButton: TButton
|
||||||
|
Left = 96
|
||||||
|
Height = 25
|
||||||
|
Top = 361
|
||||||
|
Width = 130
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = 'Add node(s) to root'
|
||||||
|
OnClick = AddButtonClick
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object Edit1: TEdit
|
||||||
|
Left = 8
|
||||||
|
Height = 21
|
||||||
|
Top = 377
|
||||||
|
Width = 81
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
TabOrder = 3
|
||||||
|
Text = '1'
|
||||||
|
end
|
||||||
|
object Button1: TButton
|
||||||
|
Tag = 1
|
||||||
|
Left = 96
|
||||||
|
Height = 25
|
||||||
|
Top = 389
|
||||||
|
Width = 130
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = 'Add node(s) as children'
|
||||||
|
OnClick = AddButtonClick
|
||||||
|
TabOrder = 4
|
||||||
|
end
|
||||||
|
object CloseButton: TButton
|
||||||
|
Left = 330
|
||||||
|
Height = 25
|
||||||
|
Top = 421
|
||||||
|
Width = 75
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = 'Close'
|
||||||
|
OnClick = CloseButtonClick
|
||||||
|
TabOrder = 5
|
||||||
|
end
|
||||||
|
end
|
||||||
40
components/virtualtreeview/demos/mininal/Main.lrs
Normal file
40
components/virtualtreeview/demos/mininal/Main.lrs
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
{ This is an automatically generated lazarus resource file }
|
||||||
|
|
||||||
|
LazarusResources.Add('TMainForm','FORMDATA',[
|
||||||
|
'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'a'#1#6'Height'#3#225#1#3'Top'#3#172
|
||||||
|
+#0#5'Width'#3#169#1#18'HorzScrollBar.Page'#3#168#1#18'VertScrollBar.Page'#3
|
||||||
|
+#224#1#13'ActiveControl'#7#3'VST'#7'Caption'#6#28'Simple Virtual Treeview de'
|
||||||
|
+'mo'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10
|
||||||
|
+'FormCreate'#0#6'TLabel'#6'Label1'#4'Left'#2#12#6'Height'#2#14#3'Top'#2#12#5
|
||||||
|
+'Width'#2'u'#7'Caption'#6#24'Last operation duration:'#5'Color'#7#6'clNone'
|
||||||
|
+#11'ParentColor'#8#0#0#18'TVirtualStringTree'#3'VST'#4'Left'#2#8#6'Height'#3
|
||||||
|
+'>'#1#3'Top'#2'$'#5'Width'#3#141#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRigh'
|
||||||
|
+'t'#8'akBottom'#0#18'Colors.BorderColor'#7#12'clWindowText'#15'Colors.HotCol'
|
||||||
|
+'or'#7#7'clBlack'#20'Header.AutoSizeIndex'#2#255#18'Header.Font.Height'#2#245
|
||||||
|
+#16'Header.Font.Name'#6#13'MS Sans Serif'#17'Header.MainColumn'#2#255#14'Hea'
|
||||||
|
+'der.Options'#11#14'hoColumnResize'#6'hoDrag'#0#13'HintAnimation'#7#7'hatNon'
|
||||||
|
+'e'#17'IncrementalSearch'#7#5'isAll'#13'RootNodeCount'#2'd'#8'TabOrder'#2#0
|
||||||
|
+#28'TreeOptions.AnimationOptions'#11#16'toAnimatedToggle'#0#23'TreeOptions.A'
|
||||||
|
+'utoOptions'#11#16'toAutoDropExpand'#22'toAutoTristateTracking'#0#23'TreeOpt'
|
||||||
|
+'ions.MiscOptions'#11#10'toEditable'#12'toInitOnSave'#18'toToggleOnDblClick'
|
||||||
|
+#14'toWheelPanning'#0#24'TreeOptions.PaintOptions'#11#13'toShowButtons'#10't'
|
||||||
|
+'oShowRoot'#15'toShowTreeLines'#12'toThemeAware'#18'toUseBlendedImages'#0#28
|
||||||
|
+'TreeOptions.SelectionOptions'#11#13'toMultiSelect'#22'toCenterScrollIntoVie'
|
||||||
|
+'w'#0#10'OnFreeNode'#7#11'VSTFreeNode'#9'OnGetText'#7#10'VSTGetText'#10'OnIn'
|
||||||
|
+'itNode'#7#11'VSTInitNode'#7'Columns'#14#0#0#0#7'TButton'#11'ClearButton'#4
|
||||||
|
+'Left'#2'a'#6'Height'#2#25#3'Top'#3#165#1#5'Width'#3#129#0#7'Anchors'#11#6'a'
|
||||||
|
+'kLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#10'Clea'
|
||||||
|
+'r tree'#7'OnClick'#7#16'ClearButtonClick'#8'TabOrder'#2#1#0#0#7'TButton'#12
|
||||||
|
+'AddOneButton'#4'Left'#2'`'#6'Height'#2#25#3'Top'#3'i'#1#5'Width'#3#130#0#7
|
||||||
|
+'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Cap'
|
||||||
|
+'tion'#6#19'Add node(s) to root'#7'OnClick'#7#14'AddButtonClick'#8'TabOrder'
|
||||||
|
+#2#2#0#0#5'TEdit'#5'Edit1'#4'Left'#2#8#6'Height'#2#21#3'Top'#3'y'#1#5'Width'
|
||||||
|
+#2'Q'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#8'TabOrder'#2#3#4'Text'#6#1'1'#0
|
||||||
|
+#0#7'TButton'#7'Button1'#3'Tag'#2#1#4'Left'#2'`'#6'Height'#2#25#3'Top'#3#133
|
||||||
|
+#1#5'Width'#3#130#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.I'
|
||||||
|
+'nnerBorder'#2#4#7'Caption'#6#23'Add node(s) as children'#7'OnClick'#7#14'Ad'
|
||||||
|
+'dButtonClick'#8'TabOrder'#2#4#0#0#7'TButton'#11'CloseButton'#4'Left'#3'J'#1
|
||||||
|
+#6'Height'#2#25#3'Top'#3#165#1#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8'akBo'
|
||||||
|
+'ttom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#5'Close'#7'OnClick'#7
|
||||||
|
+#16'CloseButtonClick'#8'TabOrder'#2#5#0#0#0
|
||||||
|
]);
|
||||||
190
components/virtualtreeview/demos/mininal/Main.pas
Normal file
190
components/virtualtreeview/demos/mininal/Main.pas
Normal file
@ -0,0 +1,190 @@
|
|||||||
|
unit Main;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
{$define DEBUG}
|
||||||
|
|
||||||
|
// Demonstration project for TVirtualStringTree to generally show how to get started.
|
||||||
|
// Written by Mike Lischke.
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$ifdef DEBUG}
|
||||||
|
vtlogger, ipcchannel,
|
||||||
|
{$endif}
|
||||||
|
LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||||
|
VirtualTrees, StdCtrls, ExtCtrls, LResources, Buttons;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMainForm = class(TForm)
|
||||||
|
VST: TVirtualStringTree;
|
||||||
|
ClearButton: TButton;
|
||||||
|
AddOneButton: TButton;
|
||||||
|
Edit1: TEdit;
|
||||||
|
Button1: TButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
CloseButton: TButton;
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure ClearButtonClick(Sender: TObject);
|
||||||
|
procedure AddButtonClick(Sender: TObject);
|
||||||
|
procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||||
|
var Text: WideString);
|
||||||
|
procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||||
|
procedure VSTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
|
||||||
|
var InitialStates: TVirtualNodeInitStates);
|
||||||
|
procedure CloseButtonClick(Sender: TObject);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
MainForm: TMainForm;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
// This is a very simple record we use to store data in the nodes.
|
||||||
|
// Since the application is responsible to manage all data including the node's caption
|
||||||
|
// this record can be considered as minimal requirement in all VT applications.
|
||||||
|
// Extend it to whatever your application needs.
|
||||||
|
PMyRec = ^TMyRec;
|
||||||
|
TMyRec = record
|
||||||
|
Caption: WideString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TMainForm.FormCreate(Sender: TObject);
|
||||||
|
|
||||||
|
begin
|
||||||
|
{$ifdef DEBUG}
|
||||||
|
Logger.ActiveClasses:=[lcScroll];
|
||||||
|
Logger.Channels.Add(TIPCChannel.Create);
|
||||||
|
Logger.Clear;
|
||||||
|
Logger.MaxStackCount:=10;
|
||||||
|
{$endif}
|
||||||
|
// Let the tree know how much data space we need.
|
||||||
|
VST.NodeDataSize := SizeOf(TMyRec);
|
||||||
|
// Set an initial number of nodes.
|
||||||
|
VST.RootNodeCount := 20;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TMainForm.ClearButtonClick(Sender: TObject);
|
||||||
|
|
||||||
|
var
|
||||||
|
Start: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
try
|
||||||
|
Start := GetTickCount;
|
||||||
|
VST.Clear;
|
||||||
|
Label1.Caption := Format('Last operation duration: %d ms', [GetTickCount - Start]);
|
||||||
|
finally
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TMainForm.AddButtonClick(Sender: TObject);
|
||||||
|
|
||||||
|
var
|
||||||
|
Count: Cardinal;
|
||||||
|
Start: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// Add some nodes to the treeview.
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
with VST do
|
||||||
|
try
|
||||||
|
Start := GetTickCount;
|
||||||
|
case (Sender as TButton).Tag of
|
||||||
|
0: // add to root
|
||||||
|
begin
|
||||||
|
Count := StrToInt(Edit1.Text);
|
||||||
|
RootNodeCount := RootNodeCount + Count;
|
||||||
|
end;
|
||||||
|
1: // add as child
|
||||||
|
if Assigned(FocusedNode) then
|
||||||
|
begin
|
||||||
|
Count := StrToInt(Edit1.Text);
|
||||||
|
ChildCount[FocusedNode] := ChildCount[FocusedNode] + Count;
|
||||||
|
Expanded[FocusedNode] := True;
|
||||||
|
InvalidateToBottom(FocusedNode);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Label1.Caption := Format('Last operation duration: %d ms', [GetTickCount - Start]);
|
||||||
|
finally
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TMainForm.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||||
|
var Text: WideString);
|
||||||
|
|
||||||
|
var
|
||||||
|
Data: PMyRec;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// A handler for the OnGetText event is always needed as it provides the tree with the string data to display.
|
||||||
|
// Note that we are always using WideString.
|
||||||
|
Data := Sender.GetNodeData(Node);
|
||||||
|
if Assigned(Data) then
|
||||||
|
Text := Data.Caption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TMainForm.VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||||
|
|
||||||
|
var
|
||||||
|
Data: PMyRec;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Data := Sender.GetNodeData(Node);
|
||||||
|
// Explicitely free the string, the VCL cannot know that there is one but needs to free
|
||||||
|
// it nonetheless. For more fields in such a record which must be freed use Finalize(Data^) instead touching
|
||||||
|
// every member individually.
|
||||||
|
if Assigned(Data) then
|
||||||
|
Data.Caption := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TMainForm.VSTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
|
||||||
|
var InitialStates: TVirtualNodeInitStates);
|
||||||
|
|
||||||
|
var
|
||||||
|
Data: PMyRec;
|
||||||
|
|
||||||
|
begin
|
||||||
|
with Sender do
|
||||||
|
begin
|
||||||
|
Data := GetNodeData(Node);
|
||||||
|
// Construct a node caption. This event is triggered once for each node but
|
||||||
|
// appears asynchronously, which means when the node is displayed not when it is added.
|
||||||
|
Data.Caption := Format('Level %d, Index %d', [GetNodeLevel(Node), Node.Index]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure TMainForm.CloseButtonClick(Sender: TObject);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//----------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$i Main.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -0,0 +1 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity processorArchitecture="*" version="5.1.0.0" type="win32" name="Microsoft.Windows.Shell.shell32"/> <description>Windows Shell</description> <dependency> <dependentAssembly> <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*" /> </dependentAssembly> </dependency> </assembly>
|
||||||
83
components/virtualtreeview/demos/mininal/minimal_lcl.lpi
Normal file
83
components/virtualtreeview/demos/mininal/minimal_lcl.lpi
Normal file
@ -0,0 +1,83 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<AlwaysBuild Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<IconPath Value="./"/>
|
||||||
|
<TargetFileExt Value=".exe"/>
|
||||||
|
</General>
|
||||||
|
<VersionInfo>
|
||||||
|
<ProjectVersion Value=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="3">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="virtualtreeview_package"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="miscutils_package"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item3>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="3">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="minimal_lcl.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="minimal_lcl"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="fmain.pas"/>
|
||||||
|
<ComponentName Value="Form1"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="fmain.lrs"/>
|
||||||
|
<UnitName Value="fmain"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="Main.pas"/>
|
||||||
|
<ComponentName Value="MainForm"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Main.lrs"/>
|
||||||
|
<UnitName Value="Main"/>
|
||||||
|
</Unit2>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<OtherUnitFiles Value="E:\subversion\luipack\trunk\virtualtreeview\"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Generate Value="Faster"/>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
</CONFIG>
|
||||||
18
components/virtualtreeview/demos/mininal/minimal_lcl.lpr
Normal file
18
components/virtualtreeview/demos/mininal/minimal_lcl.lpr
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
program minimal_lcl;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms
|
||||||
|
{ add your units here }, Main, miscutils_package, virtualtreeview_package;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TMainForm, MainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
161
components/virtualtreeview/lclconstants.inc
Normal file
161
components/virtualtreeview/lclconstants.inc
Normal file
@ -0,0 +1,161 @@
|
|||||||
|
// Message constants that are not defined in LCL
|
||||||
|
|
||||||
|
WM_APP = $8000;
|
||||||
|
|
||||||
|
// ExtTextOut Options
|
||||||
|
|
||||||
|
ETO_RTLREADING = 128;
|
||||||
|
|
||||||
|
//DrawText options
|
||||||
|
|
||||||
|
DT_RTLREADING = 131072;
|
||||||
|
|
||||||
|
// Clipboard constants
|
||||||
|
|
||||||
|
CF_BITMAP = 2;
|
||||||
|
CF_DIB = 8;
|
||||||
|
CF_PALETTE = 9;
|
||||||
|
CF_ENHMETAFILE = 14;
|
||||||
|
CF_METAFILEPICT = 3;
|
||||||
|
CF_OEMTEXT = 7;
|
||||||
|
CF_TEXT = 1;
|
||||||
|
CF_UNICODETEXT = 13;
|
||||||
|
CF_DIF = 5;
|
||||||
|
CF_DSPBITMAP = 130;
|
||||||
|
CF_DSPENHMETAFILE = 142;
|
||||||
|
CF_DSPMETAFILEPICT = 131;
|
||||||
|
CF_DSPTEXT = 129;
|
||||||
|
CF_GDIOBJFIRST = 768;
|
||||||
|
CF_GDIOBJLAST = 1023;
|
||||||
|
CF_HDROP = 15;
|
||||||
|
CF_LOCALE = 16;
|
||||||
|
CF_OWNERDISPLAY = 128;
|
||||||
|
CF_PENDATA = 10;
|
||||||
|
CF_PRIVATEFIRST = 512;
|
||||||
|
CF_PRIVATELAST = 767;
|
||||||
|
CF_RIFF = 11;
|
||||||
|
CF_SYLK = 4;
|
||||||
|
CF_WAVE = 12;
|
||||||
|
CF_TIFF = 6;
|
||||||
|
CF_MAX = 17;
|
||||||
|
|
||||||
|
// Win32 colors
|
||||||
|
CLR_NONE = $ffffffff;
|
||||||
|
CLR_DEFAULT = $ff000000;
|
||||||
|
|
||||||
|
//DrawFrameControl constants
|
||||||
|
DFCS_HOT = $1000;
|
||||||
|
|
||||||
|
//Thread support
|
||||||
|
//This values is for win32, how about others??
|
||||||
|
INFINITE = $FFFFFFFF;
|
||||||
|
|
||||||
|
//OLE Support
|
||||||
|
E_OUTOFMEMORY = HRESULT($8007000E);
|
||||||
|
E_INVALIDARG = HRESULT($80070057);
|
||||||
|
E_NOINTERFACE = HRESULT($80004002);
|
||||||
|
E_POINTER = HRESULT($80004003);
|
||||||
|
E_HANDLE = HRESULT($80070006);
|
||||||
|
E_ABORT = HRESULT($80004004);
|
||||||
|
E_FAIL = HRESULT($80004005);
|
||||||
|
E_ACCESSDENIED = HRESULT($80070005);
|
||||||
|
|
||||||
|
DV_E_TYMED = HRESULT($80040069);
|
||||||
|
DV_E_CLIPFORMAT = HRESULT($8004006A);
|
||||||
|
DV_E_LINDEX = HRESULT($80040068);
|
||||||
|
DV_E_DVASPECT = HRESULT($8004006B);
|
||||||
|
|
||||||
|
OLE_E_ADVISENOTSUPPORTED = HRESULT($80040003);
|
||||||
|
OLE_S_USEREG = HRESULT($00040000);
|
||||||
|
|
||||||
|
DATA_S_SAMEFORMATETC = HRESULT($00040130);
|
||||||
|
|
||||||
|
DRAGDROP_S_DROP = HRESULT($00040100);
|
||||||
|
DRAGDROP_S_CANCEL = HRESULT($00040101);
|
||||||
|
DRAGDROP_S_USEDEFAULTCURSORS = HRESULT($00040102);
|
||||||
|
|
||||||
|
NOERROR = 0;
|
||||||
|
|
||||||
|
SPI_GETDRAGFULLWINDOWS = 38;
|
||||||
|
|
||||||
|
// windows management
|
||||||
|
SWP_HIDEWINDOW = 128;
|
||||||
|
SWP_SHOWWINDOW = 64;
|
||||||
|
|
||||||
|
//Imagelists
|
||||||
|
ILD_NORMAL = 0;
|
||||||
|
|
||||||
|
// Set WindowPos
|
||||||
|
SWP_FRAMECHANGED = 32;
|
||||||
|
SWP_NOOWNERZORDER = 512;
|
||||||
|
SWP_NOSENDCHANGING = 1024;
|
||||||
|
|
||||||
|
{ RedrawWindow }
|
||||||
|
RDW_ERASE = 4;
|
||||||
|
RDW_FRAME = 1024;
|
||||||
|
RDW_INTERNALPAINT = 2;
|
||||||
|
RDW_INVALIDATE = 1;
|
||||||
|
RDW_NOERASE = 32;
|
||||||
|
RDW_NOFRAME = 2048;
|
||||||
|
RDW_NOINTERNALPAINT = 16;
|
||||||
|
RDW_VALIDATE = 8;
|
||||||
|
RDW_ERASENOW = 512;
|
||||||
|
RDW_UPDATENOW = 256;
|
||||||
|
RDW_ALLCHILDREN = 128;
|
||||||
|
RDW_NOCHILDREN = 64;
|
||||||
|
|
||||||
|
//SetRedraw
|
||||||
|
WM_SETREDRAW = 11;
|
||||||
|
|
||||||
|
//Dummy
|
||||||
|
CM_PARENTFONTCHANGED = 1999;
|
||||||
|
|
||||||
|
//Wheel
|
||||||
|
WHEEL_DELTA = 120;
|
||||||
|
WHEEL_PAGESCROLL = High(DWord);
|
||||||
|
SPI_GETWHEELSCROLLLINES = 104;
|
||||||
|
|
||||||
|
//MultiByte
|
||||||
|
MB_USEGLYPHCHARS = 4;
|
||||||
|
LOCALE_IDEFAULTANSICODEPAGE = 4100;
|
||||||
|
|
||||||
|
//Image list
|
||||||
|
ILD_TRANSPARENT = $00000001;
|
||||||
|
ILD_MASK = $00000010;
|
||||||
|
ILD_IMAGE = $00000020;
|
||||||
|
|
||||||
|
ILD_ROP = $00000040;
|
||||||
|
|
||||||
|
ILD_BLEND25 = $00000002;
|
||||||
|
ILD_BLEND50 = $00000004;
|
||||||
|
ILD_OVERLAYMASK = $00000F00;
|
||||||
|
|
||||||
|
{ GetDCEx }
|
||||||
|
DCX_WINDOW = $1;
|
||||||
|
DCX_CACHE = $2;
|
||||||
|
DCX_PARENTCLIP = $20;
|
||||||
|
DCX_CLIPSIBLINGS = $10;
|
||||||
|
DCX_CLIPCHILDREN = $8;
|
||||||
|
DCX_NORESETATTRS = $4;
|
||||||
|
DCX_LOCKWINDOWUPDATE = $400;
|
||||||
|
DCX_EXCLUDERGN = $40;
|
||||||
|
DCX_INTERSECTRGN = $80;
|
||||||
|
DCX_VALIDATE = $200000;
|
||||||
|
|
||||||
|
SCantWriteResourceStreamError = 'CantWriteResourceStreamError';
|
||||||
|
|
||||||
|
//command
|
||||||
|
EN_UPDATE = 1024;
|
||||||
|
|
||||||
|
ES_AUTOHSCROLL = $80;
|
||||||
|
ES_AUTOVSCROLL = $40;
|
||||||
|
ES_CENTER = $1;
|
||||||
|
ES_LEFT = 0;
|
||||||
|
ES_LOWERCASE = $10;
|
||||||
|
ES_MULTILINE = $4;
|
||||||
|
ES_NOHIDESEL = $100;
|
||||||
|
|
||||||
|
|
||||||
|
EM_SETRECTNP = 180;
|
||||||
|
|
||||||
|
DT_END_ELLIPSIS = 32768;
|
||||||
235
components/virtualtreeview/lclfunctions.inc
Normal file
235
components/virtualtreeview/lclfunctions.inc
Normal file
@ -0,0 +1,235 @@
|
|||||||
|
//Used in DrawTextW
|
||||||
|
{
|
||||||
|
function GetTextAlign(DC: HDC): UINT;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetTextAlign');
|
||||||
|
Result:=TA_TOP or TA_LEFT;
|
||||||
|
end;
|
||||||
|
}
|
||||||
|
//Used in DrawTextW, ShortenString, TVirtualTreeColumn.ComputeHeaderLayout, TVirtualTreeColumns.DrawButtonText,
|
||||||
|
// TVTEdit.AutoAdjustSize, TCustomVirtualStringTree.PaintNormalText, TCustomVirtualStringTree.WMSetFont
|
||||||
|
// TCustomVirtualStringTree.DoTextMeasuring
|
||||||
|
{
|
||||||
|
function GetTextExtentPoint32W(DC: HDC; Str: PWideChar; Count: Integer; var Size: TSize): Boolean;
|
||||||
|
var
|
||||||
|
TempStr: String;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetTextExtentPoint32W');
|
||||||
|
TempStr:=WideCharToString(Str);
|
||||||
|
Result:=GetTextExtentPoint(DC, PChar(TempStr), Length(TempStr), Size);
|
||||||
|
end;
|
||||||
|
}
|
||||||
|
//Used in DrawTextW
|
||||||
|
{
|
||||||
|
function ExtTextOutW(DC: HDC; X, Y: Integer; Options: LongInt; Rect: PRect;
|
||||||
|
Str: PWideChar; Count: LongInt; Dx: PInteger): Boolean;
|
||||||
|
var
|
||||||
|
TempStr: String;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'ExtTextOutW');
|
||||||
|
TempStr:=WideCharToString(Str);
|
||||||
|
Result:= ExtTextOut(DC, X, Y, Options, Rect, PChar(TempStr), Length(TempStr), Dx);
|
||||||
|
end;
|
||||||
|
}
|
||||||
|
|
||||||
|
//Used in TVirtualTreeHintWindow.CalcHintRect, TVirtualTreeColumn.ComputeHeaderLayout
|
||||||
|
// TBaseVirtualTree.CollectSelectedNodesRTL, TBaseVirtualTree.DetermineHitPositionRTL
|
||||||
|
// TBaseVirtualTree.UpdateEditBounds, TBaseVirtualTree.GetDisplayRect, PaintTree,
|
||||||
|
// TStringEditLink.PrepareEdit, TCustomVirtualStringTree.ComputeNodeHeight etc
|
||||||
|
procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
|
||||||
|
begin
|
||||||
|
case Alignment of
|
||||||
|
taLeftJustify: Alignment := taRightJustify;
|
||||||
|
taRightJustify: Alignment := taLeftJustify;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function INDEXTOOVERLAYMASK(i : longint) : longint;
|
||||||
|
{ return type might be wrong }
|
||||||
|
begin
|
||||||
|
INDEXTOOVERLAYMASK:=i shl 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function MAKEROP4(fore,back : longint) : DWORD;
|
||||||
|
begin
|
||||||
|
MAKEROP4:=DWORD((DWORD(back shl 8) and $FF000000) or DWORD(fore));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function Failed(Status : HRESULT) : BOOL;
|
||||||
|
begin
|
||||||
|
Failed:=Status and HRESULT($80000000)<>0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MapWindowPoints(hWndFrom, hWndTo: HWND; lpPoints: PPoint; cPoints: UINT): Integer;
|
||||||
|
var
|
||||||
|
I:integer;
|
||||||
|
FromRect,ToRect: TRect;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'MapWiindowsPoints');
|
||||||
|
//todo: implement result
|
||||||
|
GetWindowRect(hWndFrom,FromRect);
|
||||||
|
GetWindowRect(hWndTo,ToRect);
|
||||||
|
for i:=0 to cPoints - 1 do
|
||||||
|
begin
|
||||||
|
(lpPoints+i)^.x:=(FromRect.Left - ToRect.Left) + (lpPoints+i)^.x;
|
||||||
|
(lpPoints+i)^.y:=(FromRect.Top - ToRect.Top) + (lpPoints+i)^.y;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifndef NeedWindows}
|
||||||
|
|
||||||
|
//Dummy function. Used in many places
|
||||||
|
function ImageList_DrawEx(himl:THandle; i:longint; hdcDst:HDC; x:longint;
|
||||||
|
y:longint;dx:longint; dy:longint; rgbBk:COLORREF; rgbFg:COLORREF; fStyle:UINT):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'ImageList_DrawEx');
|
||||||
|
end;
|
||||||
|
|
||||||
|
//Used in TVirtualTreeColumns.AnimatedResize
|
||||||
|
function GetWindowDC(hWnd:HWND):HDC;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetWindowDC');
|
||||||
|
end;
|
||||||
|
|
||||||
|
//Used in TVTDragImage.DragTo, TVirtualTreeColumns.AnimatedResize, TBaseVirtualTree.ToggleCallback,
|
||||||
|
//TBaseVirtualTree.TileBackground
|
||||||
|
|
||||||
|
function ScrollDC(hDC:HDC; dx:longint; dy:longint; var lprcScroll:TRECT;
|
||||||
|
var lprcClip:TRECT;hrgnUpdate:HRGN; lprcUpdate:PRECT):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'ScrollDC');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// TCustomVirtualTreeOptions.SetPaintOptions, TVTHeader.Invalidate, TVTColors.SetColor
|
||||||
|
//CMEnabledChanged, TBaseVirtualTree.WMEnable, TBaseVirtualTree.WMVScroll,
|
||||||
|
// TBaseVirtualTree.UpdateWindowAndDragImage, TBaseVirtualTree.RepaintNode
|
||||||
|
function RedrawWindow(hWnd:HWND; lprcUpdate:PRECT; hrgnUpdate:HRGN;
|
||||||
|
flags:LongWord):Boolean; overload;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'RedrawWindow');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RedrawWindow(hWnd:HWND; var lprcUpdate:TRECT; hrgnUpdate:HRGN;
|
||||||
|
flags:UINT):Boolean; overload;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
//Used in LimitPaintingToArea
|
||||||
|
function LPtoDP(_para1:HDC; _para2:PPOINT; _para3:longint):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'LPtoDP');
|
||||||
|
end;
|
||||||
|
|
||||||
|
//Used to the brush of dottedline
|
||||||
|
function CreatePatternBrush(_para1:HBITMAP):HBRUSH;
|
||||||
|
var
|
||||||
|
ALog: TLogBrush;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'CreatePatternBrush');
|
||||||
|
//lcl_todo
|
||||||
|
with ALog do
|
||||||
|
begin
|
||||||
|
lbStyle:=0;
|
||||||
|
lbColor:=0;
|
||||||
|
lbHatch:=0;
|
||||||
|
end;
|
||||||
|
Result:=CreateBrushIndirect(ALog);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetBkColor(_para1:HDC):COLORREF;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetBkColor');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function ImageList_DragShowNolock(fShow:Boolean): Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'ImageList_DragShowNoLock');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetKeyboardState(lpKeyState:PBYTE):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetKeyboardState');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ToAscii(uVirtKey:UINT; uScanCode:UINT; lpKeyState:PBYTE;
|
||||||
|
lpChar: PChar; uFlags:UINT):longint;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'ToAscii');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SystemParametersInfo(uiAction:UINT; uiParam:UINT;
|
||||||
|
pvParam:Pointer; fWinIni:UINT):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'SystemParameterInfo');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetTimer(hWnd:HWND; nIDEvent:UINT; uElapse:UINT; lpTimerFunc:Pointer):UINT;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'SetTimer');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SubtractRect(lprcDst:TRECT; lprcSrc1:TRECT; lprcSrc2:TRECT):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'SubtractRect');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DeferWindowPos(hWinPosInfo:THandle; hWnd:THandle; hWndInsertAfter:THandle;
|
||||||
|
x:longint; y:longint;cx:longint; cy:longint; uFlags:UINT):THandle;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'DeferWindowPos');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function BeginDeferWindowPos(nNumWindows:longint):THandle;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'BeginDeferWindowPos');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function EndDeferWindowPos(hWinPosInfo:THandle):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'EndDeferWindowpos');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetLocaleInfo(Locale:DWord; LCType:DWord; lpLCData:PChar; cchData:longint):longint;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetLocaleInfo');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetACP:UINT;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetACP');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar;
|
||||||
|
cchMultiByte:longint; lpWideCharStr:PWideChar; cchWideChar:longint):longint;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'MultiByteToWideChar');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetKeyboardLayout(dwLayout:DWORD):THandle;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetKeyboardLayout');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DefWindowProc(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'DefWindowProc');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetDCEx(hWnd:HWND; hrgnClip:HRGN; flags:DWORD):HDC;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'GetDCEx');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function OffsetRgn(_para1:HRGN; _para2:longint; _para3:longint):longint;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'OffsetRegion');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetBrushOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:PPOINT):Boolean;
|
||||||
|
begin
|
||||||
|
Logger.AddCheckPoint(lcDummyFunctions,'SetBrushOrgEx');
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif}
|
||||||
6
components/virtualtreeview/lcltypes.inc
Normal file
6
components/virtualtreeview/lcltypes.inc
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
//TBiDiMode = (bdLeftToRight, bdRightToLeft, bdRightToLeftNoAlign, bdRightToLeftReadingOnly);
|
||||||
|
|
||||||
|
|
||||||
176
components/virtualtreeview/port.log
Normal file
176
components/virtualtreeview/port.log
Normal file
@ -0,0 +1,176 @@
|
|||||||
|
Port started in 26/01/07
|
||||||
|
1) Remove Delphi/Windows dependencies
|
||||||
|
* Determine what windows functions are used. Store in windows_functions.txt
|
||||||
|
* Undefine ThemeSupport in VTConfig.inc
|
||||||
|
* Comment OleAcc unit from uses
|
||||||
|
* Convert windows messages to LCL correspondent. Store in windows_messages.txt
|
||||||
|
* toShowButtons duplicated in DefaultPaintOptions (Delphi compiles this!!)
|
||||||
|
* unclosed comment in OLE Drag definitions
|
||||||
|
* VTV uses OLE to drag and drop and clipboard. Necessary to see how LCL handle this. For now enclose all
|
||||||
|
clipboard and drag and drop ole under ifdefs
|
||||||
|
* added {$mode delphi}{$H+}
|
||||||
|
* Change header of TEnumFormatETC, TVTDragManager, TVTDataObject to match fpc
|
||||||
|
* Add Types unit (TSize)
|
||||||
|
* THintWindow.IsHintMsg is not implemented in LCL. Comment the code
|
||||||
|
* Commented Consts and AxCtrls units in implementation
|
||||||
|
* Isolated NC functions. They are used to paint the header
|
||||||
|
* Isolated GetControlsAlignment. (Is not used in the LCL)
|
||||||
|
* Commented TStringEditLink HideSelection and OEMConvert published formats
|
||||||
|
* Added lcltypes.inc
|
||||||
|
* Added TBidiMode and BidiMode property set default to LTR
|
||||||
|
* Commented Bevel* properties publishing
|
||||||
|
* Commented ParentBidiMode property
|
||||||
|
* Commented implementation of RaiseLastOSError
|
||||||
|
* Added missing clipboard constants
|
||||||
|
* Added LCLIntf unit
|
||||||
|
* Replaced GetClipboardFormatName by ClipboardFormatToMimeType in RegisterVTClipboardFormat
|
||||||
|
* Replaced RegisterClipboardFormat by ClipboardRegisterFormat
|
||||||
|
* Added win32 color constants
|
||||||
|
* Removed ISWin2k and XP since was not used. Assume IsWinNt true
|
||||||
|
* Removed Global HintFont var used to < Delphi4. Use Screen.HintFont.
|
||||||
|
* Commented the global imagelists code. Will be implemented later
|
||||||
|
* Added dummy GetTextAlign function
|
||||||
|
* Added simple ExtTextOutW and GetTextExtentPoint32W functions. Will be revisited later
|
||||||
|
* Commented code that was using GetCurrentObject
|
||||||
|
* Commented code for a bug in the Delphi package code
|
||||||
|
* Changed way to get NeedToUnitialize. Removed succeeded
|
||||||
|
* Replaced LoadCursor by LoadCursorFromLazarusResource.
|
||||||
|
* Added virtualtrees.lrs
|
||||||
|
* Changed WorkEvent from THandle to TEvent
|
||||||
|
* Added INFINITE constant
|
||||||
|
* Removed RaiseLastOSError
|
||||||
|
* Changed typecast of EnterStates in TWorkerThread.ChangeTreeStates
|
||||||
|
* Changed parameter of ReleaseStgMedium to a Pointer
|
||||||
|
* Replaced unkForRelease for PunkForRelease in TStgMedium records, similar with stm and stg
|
||||||
|
* Isolated DragFunctions dependent of windows
|
||||||
|
* replaced lstrLenW by fpc way
|
||||||
|
* Replace Windows.DrawTextW by customized
|
||||||
|
* Added TVirtualTreeHintWindow.BidiMode property
|
||||||
|
* Replace UpdateBounds by SetBounds in Hint show routine
|
||||||
|
* In TCustomVirtualTreeOptions.SetMiscOptions called RecreateWnd
|
||||||
|
* Commented ValidateRect functions
|
||||||
|
* Implemented procedure ChangeBiDiModeAlignment
|
||||||
|
* Isolated code from TVTDragImage.MakeAlphaChannel
|
||||||
|
* In LoadFromStream changed typecast to longword
|
||||||
|
* Added dummy ImageList_DrawEx implementation
|
||||||
|
* Replaced ZeroMemory by FillChar
|
||||||
|
* Commented BevelKind in PaintHeadder
|
||||||
|
* Implemented TBaseVirtualTree.UseRightToLeftAlignment dummy function
|
||||||
|
* Isolated Header messages handling
|
||||||
|
* Added missing SetWindowPos constants
|
||||||
|
* Implemented MapWindowPoints
|
||||||
|
* Added dummy RedrawWindow function
|
||||||
|
* Commented call to DestroyWindowHandle in Destroy. Probably will not be necessary since the header will be
|
||||||
|
in the client area
|
||||||
|
* Used Application.ProcessMessages in InterruptValidation instead of direct call
|
||||||
|
* Added dummy LPtoDP
|
||||||
|
* Replaced LoadBitmap by LoadFromLazarusResource
|
||||||
|
* Added dummy CreatePatternBrush
|
||||||
|
* Added Dummy GetBkColor
|
||||||
|
* Replaced Reader.ReadStr by Reader.ReadString
|
||||||
|
* Added WM_SETREDRAW constant
|
||||||
|
* Added MAKEROP4
|
||||||
|
* Added dummy ImageList_DragShowNolock
|
||||||
|
* Replaced GetUpdateRect in WMPaint
|
||||||
|
* Added dummy ToAscii and GetKeyboardState
|
||||||
|
* Added WHEEL_ constants
|
||||||
|
* Added Dummy SystemParametersInfo
|
||||||
|
* Added Dummy SetTimer, isolated timer functions
|
||||||
|
* Isolated CreateParams function
|
||||||
|
* Added Failed function
|
||||||
|
* Added dummy SubtractRect function
|
||||||
|
* Replaced Canvas.TextFlags by TextStyle
|
||||||
|
* Added LResources unit
|
||||||
|
* Used the PackArray Implmentation from original port
|
||||||
|
* The TCanvas of VCL does not has width and height as LCL does. This cause conflict with "with" operator
|
||||||
|
* Implemented TOLEStream
|
||||||
|
* Fixed bug in LCL.GetScrollPos
|
||||||
|
* Fixed Draw problems due to TCanvas.Color
|
||||||
|
* Fixed Align problems of TVirtualNode (Hint from original port)
|
||||||
|
* Fixed MouseWheel
|
||||||
|
|
||||||
|
|
||||||
|
#Major Tasks#
|
||||||
|
< > General Painting
|
||||||
|
[ ] The NodeBitmap width/Height is not reseted when erasing the background
|
||||||
|
< > Define the UNICODE support schema. Probably change from widestring to ansistring and let LCL do the rest
|
||||||
|
[ ] Use GetTextExtentPoint instead of GetTextExtentPoint32 since the later is a wrapper to the former in LCL
|
||||||
|
[ ] For now all rendering will be done with DrawTextW wrapper > Windows.DrawTextW
|
||||||
|
< > Find a way to mantain OLE drag and Drop in windows
|
||||||
|
[ ] Also maintain OLE ClipBoard?? Necessary??
|
||||||
|
< > Replace TWMTimer since is only called in win32. Or implement in GTK Intf?
|
||||||
|
< > Implement Imagelist handling
|
||||||
|
< > GetCurrentObject used for blending does not exists in LCL. Add it?
|
||||||
|
[ ] Gtk.GetObject does not return dmBits (is always nil)
|
||||||
|
< > Implement the header
|
||||||
|
[ ] BevelEdges is used to paint the Header. See if is worth implementing it
|
||||||
|
[ ] Process the header messages or do another way
|
||||||
|
[ ] See if DestroyWindowHandle is necessary in Destroy
|
||||||
|
< > Bidi Support
|
||||||
|
[ ]Properly Implement TBaseVirtualTree.UseRightToLeftAlignment
|
||||||
|
#Secondary Tasks#
|
||||||
|
< > (low) OleAcc: MSAA (Accessibility)
|
||||||
|
< > WMContextMenu: replace by DoContextPopup??. Add to LCL??
|
||||||
|
[ ] Fix Double MouseRUp
|
||||||
|
[ ] in line 2042 of callback simplify
|
||||||
|
< > pceltFetched in TEnumFormatEtc.Next is declared as ULong in fpc but PLongInt in Delphi
|
||||||
|
< > Implement THintWindow.IsHintMsg ?
|
||||||
|
< > Add TLMEnable ??
|
||||||
|
< > Replace WMSetFont since LM_SETFONT is not used in LCL
|
||||||
|
<*> Replace RaiseLastOSError. Is used in only one place -> Removed
|
||||||
|
< > IsWinNT is currently set to True. See if will support win98 and how do it
|
||||||
|
< > See what todo with GetTextAlign. Implement in LCL??
|
||||||
|
< > Thread support
|
||||||
|
[ ] Replace TVTCriticalSection by SyncObjs.TCriticalSection??
|
||||||
|
[ ] See appropriate value for INFINITE constant in Linux/BSD etc
|
||||||
|
< > TWorkerThread.ChangeTreeStates uses SendMessage. See if it works both in win and linux
|
||||||
|
< > In fpc TStgMedium records have PunkForRelease instead of unkForRelease, same for stm and stg
|
||||||
|
< > Add a way to replace TBitmap.Scanline and all advanced graphics routines
|
||||||
|
[ ] Use TLazIntfImage?
|
||||||
|
[ ] Properly implement CreatePatternBrush or find a way to paint the lines
|
||||||
|
< > Implement GetBkColor in LCL
|
||||||
|
< > Begin/EndUpdate uses WM_SETREDRAW message to avoid painting. See a crossplatform way of doing it
|
||||||
|
<*> Translate MAKEROP4 from C to Pascal. Done copied from fpc
|
||||||
|
< > TCMMouseWheel is not used in Lazarus. Remove
|
||||||
|
< > Revise CM* functions and messages
|
||||||
|
< > Implement SubtractRect
|
||||||
|
< > Implement WMSetFont
|
||||||
|
< > Implement PackArray using asm
|
||||||
|
[ ] Wait for fpc2.2
|
||||||
|
[ ] Adapt for fpc
|
||||||
|
[ ] Create versions for not i386
|
||||||
|
|
||||||
|
#Checks#
|
||||||
|
< > See if getting the length of PWideChar by typecasting to WideString is correct
|
||||||
|
< > See if the Hint is being show in the correct place
|
||||||
|
< > See the effect of using RecreateWnd (in TCustomVirtualTreeOptions.SetMiscOptions)
|
||||||
|
< > WM_NCPAINT: see the behavior under LCL
|
||||||
|
< > TVMGet* functions: probably it can be ignored, since is windows specific and not necessary at all
|
||||||
|
< > See if WM_COPY can be mapped to LM_COPYTOCLIP
|
||||||
|
< > See WM_ENABLE,WM_GETDLGCODE behavior under lcl/win32
|
||||||
|
< > See function of WM_GETOBJECT and if is necessary to add to LCL
|
||||||
|
< > See the difference between TWMPaint and TLMPaint
|
||||||
|
< > TWMPrint and WM_PRINT. See if is necessary
|
||||||
|
< > In SetCursor uses TLMessage. Investigate
|
||||||
|
< > See if GetRGBColor is necessary. Probably not. If so remove color constants
|
||||||
|
< > Found no way to replace ValidateRect in Hint Window animation. See a way to replace it
|
||||||
|
< > See if the typecasts to longword in TVirtualTreeColumn.LoadFromStream is correct
|
||||||
|
< > See te meaning of Bevel* properties see what values it should be in LCL
|
||||||
|
< > See if MapWindowPoints is returning correct values
|
||||||
|
< > See if Application.ProcessMessages in InterruptValidation will work (WM_QUIT handling??)
|
||||||
|
< > see if windows.GetUpdateRect is equal to PaintStruct in WM Paint
|
||||||
|
< > In TWMKillfocus the code to nullify the active control is probably not necessary
|
||||||
|
< > See if DeleteObject is necessary in AdjustCursorPanning
|
||||||
|
< > See if WHEEL_ constants are valids under gtk
|
||||||
|
< > See if is necessary WM_SYSCOLORCHANGE
|
||||||
|
< > See if is necessary handle LM_SETCURSOR (not used in LCL)
|
||||||
|
< > See how replace CreateParams
|
||||||
|
< > See if Canvas Respect TextStyle properties and if is necessary to set the bk in PaintNormalText
|
||||||
|
< > IStream.SetSize expects ULARGE_INTEGER instead of LARGE_INTEGER
|
||||||
|
< > Remove TRect copy in FillRect
|
||||||
|
< > In paint tree avoid using TBitmap.Canvas since it does a check each time is called
|
||||||
|
< > Why there's a extra 1 in the NodeBitmap that clears the backGround
|
||||||
|
< > See code duplicate in TBitmap.SetWidthHeight
|
||||||
|
< > Document problem of TCanvas.Color
|
||||||
|
< > Document differences between WMMouseWheel
|
||||||
|
|
||||||
BIN
components/virtualtreeview/resources/VT_HEADERSPLIT.cur
Normal file
BIN
components/virtualtreeview/resources/VT_HEADERSPLIT.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 326 B |
BIN
components/virtualtreeview/resources/VT_MOVEALL.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVEALL.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 326 B |
BIN
components/virtualtreeview/resources/VT_MOVEE.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVEE.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVEEW.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVEEW.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVEN.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVEN.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVENE.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVENE.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVENS.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVENS.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVENW.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVENW.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVES.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVES.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVESE.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVESE.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVESW.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVESW.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_MOVEW.cur
Normal file
BIN
components/virtualtreeview/resources/VT_MOVEW.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
BIN
components/virtualtreeview/resources/VT_XPBUTTONMINUS.bmp
Normal file
BIN
components/virtualtreeview/resources/VT_XPBUTTONMINUS.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 308 B |
BIN
components/virtualtreeview/resources/VT_XPBUTTONPLUS.bmp
Normal file
BIN
components/virtualtreeview/resources/VT_XPBUTTONPLUS.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 308 B |
1
components/virtualtreeview/resources/createres.bat
Normal file
1
components/virtualtreeview/resources/createres.bat
Normal file
@ -0,0 +1 @@
|
|||||||
|
lazres ..\virtualtrees.lrs VT_HEADERSPLIT.cur VT_MOVEALL.cur VT_MOVEE.cur VT_MOVEEW.cur VT_MOVEN.cur VT_MOVENE.cur VT_MOVENS.cur VT_MOVENW.cur VT_MOVES.cur VT_MOVESE.cur VT_MOVESW.cur VT_MOVEW.cur VT_XPBUTTONPLUS.bmp VT_XPBUTTONMINUS.bmp
|
||||||
50
components/virtualtreeview/virtualtreeview_package.lpk
Normal file
50
components/virtualtreeview/virtualtreeview_package.lpk
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<Package Version="2">
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Name Value="virtualtreeview_package"/>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Generate Value="Faster"/>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Files Count="2">
|
||||||
|
<Item1>
|
||||||
|
<Filename Value="VirtualTrees.lrs"/>
|
||||||
|
<Type Value="LRS"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Filename Value="VirtualTrees.pas"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="VirtualTrees"/>
|
||||||
|
</Item2>
|
||||||
|
</Files>
|
||||||
|
<Type Value="RunAndDesignTime"/>
|
||||||
|
<RequiredPkgs Count="3">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="multiloglaz"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="miscutils_package"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item3>
|
||||||
|
</RequiredPkgs>
|
||||||
|
<UsageOptions>
|
||||||
|
<UnitPath Value="$(PkgOutDir)\"/>
|
||||||
|
</UsageOptions>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IgnoreBinaries Value="False"/>
|
||||||
|
</PublishOptions>
|
||||||
|
</Package>
|
||||||
|
</CONFIG>
|
||||||
21
components/virtualtreeview/virtualtreeview_package.pas
Normal file
21
components/virtualtreeview/virtualtreeview_package.pas
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
{ This file was automatically created by Lazarus. Do not edit!
|
||||||
|
This source is only used to compile and install the package.
|
||||||
|
}
|
||||||
|
|
||||||
|
unit virtualtreeview_package;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
VirtualTrees, LazarusPackageIntf;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterUnit('VirtualTrees', @VirtualTrees.Register);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterPackage('virtualtreeview_package', @Register);
|
||||||
|
end.
|
||||||
71
components/virtualtreeview/vtlogger.pas
Normal file
71
components/virtualtreeview/vtlogger.pas
Normal file
@ -0,0 +1,71 @@
|
|||||||
|
unit vtlogger;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
multiloglcl, multilog;
|
||||||
|
|
||||||
|
const
|
||||||
|
//lc stands for LogClass
|
||||||
|
//it's possible to define the constants to suit any need
|
||||||
|
lcAll = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31];
|
||||||
|
lcDebug = 0;
|
||||||
|
lcError = 1;
|
||||||
|
lcInfo = 2;
|
||||||
|
lcWarning = 3;
|
||||||
|
|
||||||
|
lcEvents = 4;
|
||||||
|
lcPaint = 5;
|
||||||
|
lcPaintHeader = 6;
|
||||||
|
lcDummyFunctions = 7;
|
||||||
|
lcMessages = 8;
|
||||||
|
lcPaintSelection = 9;
|
||||||
|
lcSetCursor = 10;//it generates a lot of messages. so it will be debugged alone
|
||||||
|
lcPaintBitmap = 11;
|
||||||
|
lcScroll = 12;
|
||||||
|
|
||||||
|
var
|
||||||
|
Logger: TLCLLogger;
|
||||||
|
|
||||||
|
|
||||||
|
function GetSelectedNodes(Sender: TLogger; Data: Pointer; var DoSend: Boolean): String;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
VirtualTrees, sysutils;
|
||||||
|
|
||||||
|
type
|
||||||
|
TNodeData = record
|
||||||
|
Title: String;
|
||||||
|
end;
|
||||||
|
PNodeData = ^TNodeData;
|
||||||
|
|
||||||
|
function GetSelectedNodes(Sender: TLogger; Data: Pointer; var DoSend: Boolean): String;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
TempNode: PVirtualNode;
|
||||||
|
begin
|
||||||
|
with TBaseVirtualTree(Data) do
|
||||||
|
begin
|
||||||
|
Result:='SelectedCount: '+IntToStr(SelectedCount)+LineEnding;
|
||||||
|
TempNode:=GetFirstSelected;
|
||||||
|
if TempNode = nil then exit;
|
||||||
|
Result:=Result+PNodeData(GetNodeData(TempNode))^.Title+LineEnding;
|
||||||
|
for i:= 1 to SelectedCount -1 do
|
||||||
|
begin
|
||||||
|
TempNode:=GetNextSelected(TempNode);
|
||||||
|
Result:=Result+PNodeData(GetNodeData(TempNode))^.Title+LineEnding;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
Logger:=TLCLLogger.Create;
|
||||||
|
finalization
|
||||||
|
Logger.Free;
|
||||||
|
end.
|
||||||
|
|
||||||
Reference in New Issue
Block a user