paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Renamed virtualtreview to virtualtreeview-unstable - Finish

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@64 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum 2007-02-19 18:39:10 +00:00
parent cf38e876cc
commit e607006dd8
47 changed files with 0 additions and 38277 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

444
components/virtualtreeview/Compilers.inc
View File

@ -1,444 +0,0 @@
//----------------------------------------------------------------------------------------------------------------------
// 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
View File

@ -1,674 +0,0 @@
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
View File

@ -1,123 +0,0 @@
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.

36
components/virtualtreeview/VTConfig.inc
View File

@ -1,36 +0,0 @@
// 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 EnableNCFunctions}
{.$define EnableAdvancedGraphics}
{.$define EnableHeader}
{.$define EnableTimer}
{.$define EnableAccessible}

251
components/virtualtreeview/VTHeaderPopup.pas
View File

@ -1,251 +0,0 @@
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.

32122
components/virtualtreeview/VirtualTrees.pas
View File

File diff suppressed because it is too large Load Diff

103
components/virtualtreeview/demos/mininal/Main.lfm
View File

@ -1,103 +0,0 @@
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

38
components/virtualtreeview/demos/mininal/Main.lrs
View File

@ -1,38 +0,0 @@
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
View File

@ -1,190 +0,0 @@
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,lcPaint];
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.

1
components/virtualtreeview/demos/mininal/Minimal.exe.Manifest
View File

@ -1 +0,0 @@
<?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>

73
components/virtualtreeview/demos/mininal/minimal_lcl.lpi
View File

@ -1,73 +0,0 @@
<?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="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

18
components/virtualtreeview/demos/mininal/minimal_lcl.lpr
View File

@ -1,18 +0,0 @@
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.

212
components/virtualtreeview/demos/objects/MVCDemoMain.lfm
View File

@ -1,212 +0,0 @@
object fmMVCDemo: TfmMVCDemo
Left = 258
Height = 480
Top = 174
Width = 709
HorzScrollBar.Page = 708
VertScrollBar.Page = 479
ActiveControl = edCaption
Caption = 'Virtual Tree - MVC Demo written by Marian Aldenhövel'
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
object pnlControls: TPanel
Height = 84
Top = 396
Width = 709
Align = alBottom
BevelInner = bvLowered
BevelOuter = bvNone
Caption = ' '
TabOrder = 0
object Label1: TLabel
Left = 51
Height = 14
Top = 8
Width = 42
Alignment = taRightJustify
Caption = 'Caption:'
Color = clNone
ParentColor = False
end
object Label3: TLabel
Left = 33
Height = 14
Top = 31
Width = 58
Alignment = taRightJustify
Caption = 'Subcaption:'
Color = clNone
ParentColor = False
end
object Label4: TLabel
Left = 7
Height = 14
Top = 56
Width = 88
Alignment = taRightJustify
Caption = 'Incidence (0..63):'
Color = clNone
ParentColor = False
end
object Label2: TLabel
Left = 212
Height = 92
Top = 4
Width = 186
Caption = 'Edit the current node.'#13#10#13#10'Note that you are setting data in a structure without referring to a visual component except for the information about what node currently has the focus.'
Color = clNone
ParentColor = False
WordWrap = True
end
object edCaption: TEdit
Left = 92
Height = 21
Top = 5
Width = 112
OnChange = edCaptionChange
TabOrder = 0
Text = 'edCaption'
end
object edSubcaption: TEdit
Left = 92
Height = 21
Top = 29
Width = 112
OnChange = edSubcaptionChange
TabOrder = 1
Text = 'edCaption'
end
object edIncidence: TEdit
Left = 92
Height = 21
Top = 53
Width = 59
OnChange = edIncidenceChange
OnKeyDown = nil
OnKeyPress = edIncidenceKeyPress
TabOrder = 2
Text = '0'
end
object UpDown1: TUpDown
Left = 151
Height = 21
Top = 53
Width = 15
Associate = edIncidence
Max = 63
TabOrder = 3
end
object btnAdd: TButton
Left = 429
Height = 25
Top = 4
Width = 75
BorderSpacing.InnerBorder = 4
Caption = '+ Add a child'
OnClick = btnAddClick
TabOrder = 4
end
object btnDelete: TButton
Left = 429
Height = 25
Top = 32
Width = 75
BorderSpacing.InnerBorder = 4
Caption = '- delete node'
OnClick = btnDeleteClick
TabOrder = 5
end
object cbLive: TCheckBox
Left = 618
Height = 13
Top = 9
Width = 48
Caption = 'Live!'
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
OnClick = cbLiveClick
TabOrder = 6
end
end
object ImageList1: TImageList
left = 120
top = 143
Bitmap = {
6C690500000010000000100000009C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023464646464646222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
2C2C2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C
2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E
2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C
2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2C2C2C2E
2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0A9C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023303043304330222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
2C2C2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C
2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E
2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C
2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2C2C2C2E
2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0A9C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023303043303030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
2C2C2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C
2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E
2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C
2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2C2C2C2E
2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0A9C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023464630303030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
2C2C2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C
2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E
2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C
2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2C2C2C2E
2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0A9C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023464646463030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
2C2C2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C
2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2D2C2E2E2E222C0A222E2E2E2E2E
2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C
2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2C2D2D2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C2C2C2C2E
2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0A
}
end
object timLive: TTimer
Enabled = False
Interval = 100
OnTimer = timLiveTimer
left = 120
top = 172
end
end

77
components/virtualtreeview/demos/objects/MVCDemoMain.lrs
View File

@ -1,77 +0,0 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TfmMVCDemo','FORMDATA',[
'TPF0'#10'TfmMVCDemo'#9'fmMVCDemo'#4'Left'#3#2#1#6'Height'#3#224#1#3'Top'#3
+#174#0#5'Width'#3#197#2#18'HorzScrollBar.Page'#3#196#2#18'VertScrollBar.Page'
+#3#223#1#13'ActiveControl'#7#9'edCaption'#7'Caption'#6'5Virtual Tree - MVC D'
+'emo written by Marian Aldenh'#195#182'vel'#11'Font.Height'#2#245#9'Font.Nam'
+'e'#6#13'MS Sans Serif'#8'OnCreate'#7#10'FormCreate'#0#6'TPanel'#11'pnlContr'
+'ols'#6'Height'#2'T'#3'Top'#3#140#1#5'Width'#3#197#2#5'Align'#7#8'alBottom'
+#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#1' '#8
+'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2'3'#6'Height'#2#14#3'Top'#2#8#5
+'Width'#2'*'#9'Alignment'#7#14'taRightJustify'#7'Caption'#6#8'Caption:'#5'Co'
+'lor'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2'!'#6'H'
+'eight'#2#14#3'Top'#2#31#5'Width'#2':'#9'Alignment'#7#14'taRightJustify'#7'C'
+'aption'#6#11'Subcaption:'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLab'
+'el'#6'Label4'#4'Left'#2#7#6'Height'#2#14#3'Top'#2'8'#5'Width'#2'X'#9'Alignm'
+'ent'#7#14'taRightJustify'#7'Caption'#6#18'Incidence (0..63):'#5'Color'#7#6
+'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3#212#0#6'Height'
+#2'\'#3'Top'#2#4#5'Width'#3#186#0#7'Caption'#6#179'Edit the current node.'#13
+#10#13#10'Note that you are setting data in a structure without referring to'
+' a visual component except for the information about what node currently ha'
+'s the focus.'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#0#0#5'TE'
+'dit'#9'edCaption'#4'Left'#2'\'#6'Height'#2#21#3'Top'#2#5#5'Width'#2'p'#8'On'
+'Change'#7#15'edCaptionChange'#8'TabOrder'#2#0#4'Text'#6#9'edCaption'#0#0#5
+'TEdit'#12'edSubcaption'#4'Left'#2'\'#6'Height'#2#21#3'Top'#2#29#5'Width'#2
+'p'#8'OnChange'#7#18'edSubcaptionChange'#8'TabOrder'#2#1#4'Text'#6#9'edCapti'
+'on'#0#0#5'TEdit'#11'edIncidence'#4'Left'#2'\'#6'Height'#2#21#3'Top'#2'5'#5
+'Width'#2';'#8'OnChange'#7#17'edIncidenceChange'#9'OnKeyDown'#13#10'OnKeyPre'
+'ss'#7#19'edIncidenceKeyPress'#8'TabOrder'#2#2#4'Text'#6#1'0'#0#0#7'TUpDown'
+#7'UpDown1'#4'Left'#3#151#0#6'Height'#2#21#3'Top'#2'5'#5'Width'#2#15#9'Assoc'
+'iate'#7#11'edIncidence'#3'Max'#2'?'#8'TabOrder'#2#3#0#0#7'TButton'#6'btnAdd'
+#4'Left'#3#173#1#6'Height'#2#25#3'Top'#2#4#5'Width'#2'K'#25'BorderSpacing.In'
+'nerBorder'#2#4#7'Caption'#6#13'+ Add a child'#7'OnClick'#7#11'btnAddClick'#8
+'TabOrder'#2#4#0#0#7'TButton'#9'btnDelete'#4'Left'#3#173#1#6'Height'#2#25#3
+'Top'#2' '#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#13'-'
+' delete node'#7'OnClick'#7#14'btnDeleteClick'#8'TabOrder'#2#5#0#0#9'TCheckB'
+'ox'#6'cbLive'#4'Left'#3'j'#2#6'Height'#2#13#3'Top'#2#9#5'Width'#2'0'#7'Capt'
+'ion'#6#5'Live!'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#10'F'
+'ont.Style'#11#6'fsBold'#0#7'OnClick'#7#11'cbLiveClick'#8'TabOrder'#2#6#0#0#0
+#10'TImageList'#10'ImageList1'#4'left'#2'x'#3'top'#3#143#0#6'Bitmap'#10'.'#8
+#0#0'li'#5#0#0#0#16#0#0#0#16#0#0#0#156#1#0#0'/* XPM */'#10'static char *grap'
+'hic[] = {'#10'"16 16 3 1",'#10'". c None",'#10'", c #000000",'#10'"- c #FFF'
+'FFF",'#10'"................",'#10'"................",'#10'".........,,.....'
+'",'#10'"........,--,....",'#10'"........,---,...",'#10'"........,---,...",'
+#10'"........,---,...",'#10'"........,--,....",'#10'"........,--,....",'#10
+'"........,--,....",'#10'"........,,,,....",'#10'"........,--,....",'#10'"..'
+'......,--,....",'#10'"........,,,,....",'#10'"................",'#10'".....'
+'..........."}'#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"1'
+'6 16 3 1",'#10'". c None",'#10'", c #000000",'#10'"- c #00C0C0",'#10'".....'
+'...........",'#10'"................",'#10'".........,,.....",'#10'"........'
+',--,....",'#10'"........,---,...",'#10'"........,---,...",'#10'"........,--'
+'-,...",'#10'"........,--,....",'#10'"........,--,....",'#10'"........,--,..'
+'..",'#10'"........,,,,....",'#10'"........,--,....",'#10'"........,--,...."'
+','#10'"........,,,,....",'#10'"................",'#10'"................"}'
+#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'#10
+'". c None",'#10'", c #000000",'#10'"- c #00C000",'#10'"................",'
+#10'"................",'#10'".........,,.....",'#10'"........,--,....",'#10
+'"........,---,...",'#10'"........,---,...",'#10'"........,---,...",'#10'"..'
+'......,--,....",'#10'"........,--,....",'#10'"........,--,....",'#10'".....'
+'...,,,,....",'#10'"........,--,....",'#10'"........,--,....",'#10'"........'
+',,,,....",'#10'"................",'#10'"................"}'#10#156#1#0#0'/*'
+' XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'#10'". c None",'#10
+'", c #000000",'#10'"- c #FF0000",'#10'"................",'#10'"............'
+'....",'#10'".........,,.....",'#10'"........,--,....",'#10'"........,---,..'
+'.",'#10'"........,---,...",'#10'"........,---,...",'#10'"........,--,....",'
+#10'"........,--,....",'#10'"........,--,....",'#10'"........,,,,....",'#10
+'"........,--,....",'#10'"........,--,....",'#10'"........,,,,....",'#10'"..'
,'..............",'#10'"................"}'#10#156#1#0#0'/* XPM */'#10'static'
+' char *graphic[] = {'#10'"16 16 3 1",'#10'". c None",'#10'", c #000000",'#10
+'"- c #FFFF00",'#10'"................",'#10'"................",'#10'".......'
+'..,,.....",'#10'"........,--,....",'#10'"........,---,...",'#10'"........,-'
+'--,...",'#10'"........,---,...",'#10'"........,--,....",'#10'"........,--,.'
+'...",'#10'"........,--,....",'#10'"........,,,,....",'#10'"........,--,....'
+'",'#10'"........,--,....",'#10'"........,,,,....",'#10'"................",'
+#10'"................"}'#10#0#0#6'TTimer'#7'timLive'#7'Enabled'#8#8'Interval'
+#2'd'#7'OnTimer'#7#12'timLiveTimer'#4'left'#2'x'#3'top'#3#172#0#0#0#0
]);

218
components/virtualtreeview/demos/objects/MVCDemoMain.pas
View File

@ -1,218 +0,0 @@
unit MVCDemoMain;
{$MODE Delphi}
{ (c) 2000 Marian Aldenhövel
Hainstraße 8
53121 Bonn
+49 228 6203366
Fax: +49 228 624031
marian@mba-software.de
Free: You may use this code in every way you find it useful or fun.
Main form for the MVCDemo-Project. See MVCTypes.pas for Details. }
interface
uses LCLIntf,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
MVCTypes,MVCPanel,StdCtrls,ExtCtrls,ImgList,VirtualTrees,ComCtrls,
Buttons, LResources, vtlogger,ipcchannel;
type TfmMVCDemo=class(TForm)
pnlControls:TPanel;
ImageList1:TImageList;
edCaption:TEdit;
Label1:TLabel;
Label2:TLabel;
edSubcaption:TEdit;
Label3:TLabel;
edIncidence: TEdit;
Label4: TLabel;
UpDown1: TUpDown;
btnAdd: TButton;
btnDelete: TButton;
cbLive: TCheckBox;
timLive: TTimer;
procedure FormCreate(Sender:TObject);
procedure edCaptionChange(Sender:TObject);
procedure TreeViewChange(Sender:TBaseVirtualTree;Node:PVirtualNode);
procedure edIncidenceKeyPress(Sender:TObject;var Key:Char);
procedure edSubcaptionChange(Sender:TObject);
procedure edIncidenceChange(Sender:TObject);
procedure btnAddClick(Sender:TObject);
procedure btnDeleteClick(Sender: TObject);
procedure cbLiveClick(Sender: TObject);
procedure timLiveTimer(Sender: TObject);
private
P:TMVCPanel;
FTree:TMVCTree;
procedure UpdateFromNode;
function FocusedNode:TMVCNode;
function CreateDefaultTree:TMVCTree;
end;
var fmMVCDemo:TfmMVCDemo;
implementation
function TfmMVCDemo.CreateDefaultTree:TMVCTree;
{ recurse and curse :-) }
var i,j,k:integer;
begin
Result:=TMVCTree.Create;
for i:=0 to 2 do
with Result.Root.CreateChild do
begin
Caption:='Root';
SubCaption:='Number '+IntToStr(i);
Incidence:=5+random(30);
for j:=0 to 2 do
with CreateChild do
begin
Caption:='Child';
SubCaption:='Number '+IntToStr(j);
Incidence:=random(64);
for k:=0 to 1 do
with CreateChild do
begin
Caption:='Grandchild';
SubCaption:='Number '+IntToStr(k);
Incidence:=random(64);
end;
end;
end;
end;
procedure TfmMVCDemo.FormCreate(Sender: TObject);
begin
Logger.Channels.Add(TIPCChannel.Create);
Logger.ActiveClasses:=[lcEditLink];
Logger.Clear;
P:=TMVCPanel.Create(Self);
with P do
begin
Parent:=Self;
Align:=alClient;
TreeView.Images:=ImageList1;
{ Now this is what it's all about:
You have a structure - represented here by a call that creates
a tree. All you do is assign it to a property of the Viewer,
bingo. }
FTree:=CreateDefaultTree;
Tree:=FTree;
P.TreeView.OnChange:=TreeViewChange;
P.TreeView.FullExpand(NIL);
UpdateFromNode;
end;
end;
procedure TfmMVCDemo.TreeViewChange(Sender:TBaseVirtualTree;Node:PVirtualNode);
begin
UpdateFromNode;
end;
procedure TfmMVCDemo.UpdateFromNode;
begin
if FocusedNode=NIL
then
begin
edCaption.Text:= '';
edCaption.Enabled:= False;
edSubCaption.Text:= '';
edSubCaption.Enabled:=False;
edIncidence.Text:= '';
edIncidence.Enabled:= False;
btnDelete.Enabled:=False;
end
else
begin
edCaption.Text:= FocusedNode.Caption;
edCaption.Enabled:= True;
edSubCaption.Text:= FocusedNode.SubCaption;
edSubCaption.Enabled:=True;
edIncidence.Text:= IntToStr(FocusedNode.Incidence);
edIncidence.Enabled:= True;
btnDelete.Enabled:= True;
end;
end;
function TfmMVCDemo.FocusedNode:TMVCNode;
begin
with P.TreeView do
if FocusedNode<>NIL
then Result:=MVCNode[FocusedNode]
else Result:=NIL;
end;
procedure TfmMVCDemo.edIncidenceKeyPress(Sender:TObject;var Key:Char);
begin
if not(Key in ['0'..'9',#8]) then Key:=#0;
end;
procedure TfmMVCDemo.edSubcaptionChange(Sender:TObject);
begin
if FocusedNode<>NIL
then FocusedNode.SubCaption:=edSubCaption.Text;
end;
procedure TfmMVCDemo.edCaptionChange(Sender:TObject);
begin
if FocusedNode<>NIL then FocusedNode.Caption:=edCaption.Text;
end;
procedure TfmMVCDemo.edIncidenceChange(Sender:TObject);
begin
try
if FocusedNode<>NIL then
if edIncidence.Text=''
then FocusedNode.Incidence:=0
else FocusedNode.Incidence:=StrToInt(edIncidence.Text);
except
ShowMessage('Enter a number between 0 and 63');
end;
end;
procedure TfmMVCDemo.btnAddClick(Sender:TObject);
var R:TMVCNode;
begin
if FocusedNode<>NIL
then R:=FocusedNode
else R:=FTree.Root;
with R do
begin
R:=CreateChild;
R.Caption:='New';
end;
end;
procedure TfmMVCDemo.btnDeleteClick(Sender: TObject);
begin
FocusedNode.Free;
end;
procedure TfmMVCDemo.cbLiveClick(Sender: TObject);
begin
timLive.Enabled:=cbLive.Checked;
end;
procedure TfmMVCDemo.timLiveTimer(Sender: TObject);
var N:TMVCNode;
begin
{ Change the Incidence-Field of one node on every
level in one branch of the tree. }
N:=FTree.Root;
while Assigned(N) do
begin
N.Incidence:=5+random(63);
if N.ChildCount>0
then N:=N.Child[random(N.ChildCount)]
else N:=NIL;
end;
end;
initialization
{$i MVCDemoMain.lrs}
Randomize;
end.

127
components/virtualtreeview/demos/objects/MVCPanel.pas
View File

@ -1,127 +0,0 @@
unit MVCPanel;
{$MODE Delphi}
{ (c) 2000 Marian Aldenhövel
Hainstraße 8
53121 Bonn
+49 228 6203366
Fax: +49 228 624031
marian@mba-software.de
Free: You may use this code in every way you find it useful or fun.
This declares a Panel that hold another Panel and a TMVCTreeView. In
this Application is not at all useful, you could just as well create the
components at designtime.
The reason why the component is here is because it hints at the
possibility to use a TMVCTreeView in a hypothetical compound component
TMVMTreeEditor that adds more controls that modify the same structure.
It also shows how to initialize the Columns of a runtime-created
TVirtualTree.
}
interface
uses LCLIntf,Controls,Graphics,SysUtils,Classes,ExtCtrls,StdCtrls,
MVCTypes,VirtualTrees;
type TMVCPanel=class(TCustomPanel)
private
FpnlTop:TPanel;
FTrvItems:TMVCTreeView;
procedure SetItems(aTree:TMVCTree);
function GetItems:TMVCTree;
protected
procedure CreateWnd; override;
public
constructor Create(aOwner:TComponent); override;
property TreeView:TMVCTreeView read FtrvItems;
property Tree:TMVCTree read GetItems write SetItems;
end;
implementation
procedure TMVCPanel.SetItems(aTree:TMVCTree);
begin
{ Just link the Items to the TreeView, no processing of our own. }
FtrvItems.Tree:=aTree;
end;
function TMVCPanel.GetItems:TMVCTree;
begin
Result:=FtrvItems.Tree;
end;
constructor TMVCPanel.Create(aOwner:TComponent);
begin
inherited Create(aOwner);
BevelOuter:=bvNone;
Caption:=' ';
FpnlTop:=TPanel.Create(Self);
with FpnlTop do
begin
Parent:=Self;
Align:=alTop;
Height:=30;
Caption:='SomePanel';
BevelOuter:=bvNone;
BevelInner:=bvLowered;
end;
FtrvItems:=TMVCTreeView.Create(Self);
with FtrvItems do
begin
Parent:=Self;
Align:=alClient;
end;
end;
procedure TMVCPanel.CreateWnd;
begin
inherited CreateWnd;
with FtrvItems, TreeOptions do
begin
PaintOptions:=PaintOptions+[toShowButtons, // display collapse/expand
toShowHorzGridLines, // display horizontal lines
toShowRoot, // show lines also at root level
toShowTreeLines, // display tree lines to show
// hierarchy of nodes
// buttons left to a node
toShowVertGridLines]; // display vertical lines
// (depending on columns) to
// simulate a grid
MiscOptions := MiscOptions+[toEditable];
SelectionOptions := SelectionOptions+[toExtendedFocus];
// to simulate a grid
with Header do
begin
Height:=18;
Options:=Options+[hoVisible];
Background:=clBtnFace;
AutoSize:=True;
with Columns.Add do
begin
Text:='Caption';
Width:=300;
end;
with Columns.Add do
begin
Text:='SubCaption';
Width:=100;
end;
with Columns.Add do
begin
Text:='Incidence';
Width:=100;
end;
end;
end;
end;
end.

1048
components/virtualtreeview/demos/objects/MVCTypes.pas
View File

File diff suppressed because it is too large Load Diff

76
components/virtualtreeview/demos/objects/mvcdemo.lpi
View File

@ -1,76 +0,0 @@
<?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="4">
<Unit0>
<Filename Value="mvcdemo.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mvcdemo"/>
</Unit0>
<Unit1>
<Filename Value="MVCDemoMain.pas"/>
<ComponentName Value="fmMVCDemo"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="MVCDemoMain.lrs"/>
<UnitName Value="MVCDemoMain"/>
</Unit1>
<Unit2>
<Filename Value="MVCPanel.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="MVCPanel"/>
</Unit2>
<Unit3>
<Filename Value="MVCTypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="MVCTypes"/>
</Unit3>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

18
components/virtualtreeview/demos/objects/mvcdemo.lpr
View File

@ -1,18 +0,0 @@
program mvcdemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, MVCDemoMain;
begin
Application.Initialize;
Application.CreateForm(TfmMVCDemo, fmMVCDemo);
Application.Run;
end.

161
components/virtualtreeview/lclconstants.inc
View File

@ -1,161 +0,0 @@
// 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;

246
components/virtualtreeview/lclfunctions.inc
View File

@ -1,246 +0,0 @@
//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;
function InvalidateRect(aHandle : HWND; ARect : pRect; bErase : Boolean) : Boolean;
begin
Logger.EnterMethod(lcPaint,'InvalidateRect');
Logger.Send(lcPaint,'Rect',ARect^);
Logger.SendCallStack(lcPaint,'CallStack');
Result:=Windows.InvalidateRect(aHandle,ARect,bErase);
Logger.ExitMethod(lcPaint,'InvalidateRect');
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
View File

@ -1,6 +0,0 @@
//TBiDiMode = (bdLeftToRight, bdRightToLeft, bdRightToLeftNoAlign, bdRightToLeftReadingOnly);

187
components/virtualtreeview/port.log
View File

@ -1,187 +0,0 @@
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
* Fixed drawing problem when using ScrollBar or MouseWheel
* Implemented Support for check images
#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
[ ] See a properly way to setup the ImageLists (avoid current hack)
< > GetCurrentObject used for blending does not exists in LCL. Add it?
[ ] Gtk.GetObject does not return dmBits (is always nil) -> Is not viable to implement
GetObject under Gtk. See another way to do alpha blend (Disable in GTK??)
< > 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
[*] Already reported. No response
< > 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
[*] Already reported. No response
< > 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 type 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
[*] Is not handled. TControl will never receive it
< > 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 how 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 custom MapWindowPoints is returning correct values
[*] AFAIK yes
< > See if Application.ProcessMessages in InterruptValidation will work (WM_QUIT handling??)
<*> See if windows.GetUpdateRect is equal to PaintStruct in WM Paint
[*] Yes and no. The values of GetUpdateRect and rcPaint is equal in most times. So is safe to use it
But GetUpdateRect will always return an empty Rect when called inside LM_PAINT because there's a
prior BeginPaint call
< > 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
< > Document Differences between WMPaint
< > Document that ScrollWindow does not exists in gtk

BIN
components/virtualtreeview/resources/VT_CHECK_DARK.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.2 KiB

BIN
components/virtualtreeview/resources/VT_CHECK_LIGHT.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.2 KiB

BIN
components/virtualtreeview/resources/VT_FLAT.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.2 KiB

BIN
components/virtualtreeview/resources/VT_HEADERSPLIT.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 326 B

BIN
components/virtualtreeview/resources/VT_MOVEALL.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 326 B

BIN
components/virtualtreeview/resources/VT_MOVEE.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVEEW.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVEN.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVENE.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVENS.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVENW.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVES.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVESE.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVESW.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_MOVEW.cur
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

BIN
components/virtualtreeview/resources/VT_TICK_DARK.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.2 KiB

BIN
components/virtualtreeview/resources/VT_TICK_LIGHT.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.2 KiB

BIN
components/virtualtreeview/resources/VT_XPBUTTONMINUS.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 308 B

BIN
components/virtualtreeview/resources/VT_XPBUTTONPLUS.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 308 B

1
components/virtualtreeview/resources/createres.bat
View File

@ -1 +0,0 @@
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 VT_CHECK_LIGHT.bmp VT_CHECK_DARK.bmp VT_FLAT.bmp VT_TICK_DARK.bmp VT_TICK_LIGHT.bmp VT_UTILITIES.bmp VT_XP.bmp

1682
components/virtualtreeview/virtualtrees.lrs
View File

File diff suppressed because it is too large Load Diff

50
components/virtualtreeview/virtualtreeview_package.lpk
View File

@ -1,50 +0,0 @@
<?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
View File

@ -1,21 +0,0 @@
{ 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.

74
components/virtualtreeview/vtlogger.pas
View File

@ -1,74 +0,0 @@
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;
lcPaintDetails = 13;
lcCheck = 14;
lcEditLink = 15;
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.