pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Created branch 4.8.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1121 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2010-01-07 22:49:28 +00:00
parent 975c2eac17
commit 3c284d1f60
189 changed files with 123642 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

674
components/virtualtreeview-new/branches/4.8/VTAccessibility.pas Normal file
View File

@ -0,0 +1,674 @@
unit VTAccessibility;
// This unit implements iAccessible interfaces for the VirtualTree visual components
// and the currently focused node.
//
// Written by Marco Zehe. (c) 2007
interface
uses Windows, Classes, ActiveX, oleacc, VirtualTrees, VTAccessibilityFactory, Controls;
type
TVirtualTreeAccessibility = class(TInterfacedObject, IDispatch, IAccessible)
private
FVirtualTree: TVirtualStringTree;
public
{ IAccessibility }
function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
out pidTopic: Integer): HResult; stdcall;
function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer;
out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
{IDispatch}
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount: Integer; LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
function GetTypeInfo(Index: Integer; LocaleID: Integer;
out TypeInfo): HRESULT; stdcall;
function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
ArgErr: Pointer): HRESULT; stdcall;
constructor Create(VirtualTree: TVirtualStringTree);
end;
TVirtualTreeItemAccessibility = class(TVirtualTreeAccessibility, IAccessible)
public
{ IAccessibility }
function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
function accLocation(out pxLeft: Integer;
out pyTop: Integer; out pcxWidth: Integer;
out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
constructor Create(VirtualTree: TVirtualStringTree);
end;
TVTMultiColumnItemAccessibility = class(TVirtualTreeItemAccessibility, IAccessible)
private
function GetItemDescription(varChild: OleVariant; out pszDescription: WideString; IncludeMainColumn: boolean): HResult; stdcall;
public
{ IAccessibility }
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
end;
TVTDefaultAccessibleProvider = class(TInterfacedObject, IVTAccessibleProvider)
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
end;
TVTDefaultAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
end;
TVTMultiColumnAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleProvider)
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
end;
implementation
uses Variants, SysUtils, Types, Forms;
{ TVirtualTreeAccessibility }
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.accDoDefaultAction(varChild: OleVariant): HResult;
// a default action is not supported.
begin
Result := DISP_E_MEMBERNOTFOUND;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult;
// returns the iAccessible object at the given point, if applicable.
var
Pt: TPoint;
HitInfo: THitInfo;
begin
Result := S_FALSE;
if FVirtualTree <> nil then
begin
// VariantInit(pvarChild);
// TVarData(pvarChild).VType := VT_I4;
Pt := fVirtualTree.ScreenToClient(Point(xLeft, yTop));
if fVirtualTree.FocusedNode <> nil then
begin
fVirtualTree.GetHitTestInfoAt(xLeft, yTop, false, HitInfo);
if FVirtualTree.FocusedNode = HitInfo.HitNode then
begin
pvarChild := FVirtualTree.AccessibleItem;
Result := S_OK;
exit;
end;
end;
if PtInRect(FVirtualTree.BoundsRect, Pt) then
begin
pvarChild := CHILDID_SELF;
Result := S_OK;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.accLocation(out pxLeft: Integer;
out pyTop: Integer; out pcxWidth: Integer;
out pcyHeight: Integer; varChild: OleVariant): HResult;
// returns the location of the VirtualStringTree object.
var
P: TPoint;
begin
Result := S_FALSE;
if varChild = CHILDID_SELF then
begin
if FVirtualTree <> nil then
begin
P := FVirtualTree.ClientToScreen(FVirtualTree.ClientRect.TopLeft);
pxLeft := P.X;
pyTop := P.Y;
pcxWidth := FVirtualTree.Width;
pcyHeight := FVirtualTree.Height;
Result := S_OK;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.accNavigate(navDir: Integer; varStart: OleVariant;
out pvarEndUpAt: OleVariant): HResult;
// This is not supported.
begin
Result := DISP_E_MEMBERNOTFOUND;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accSelection(out pvarChildren: OleVariant): HResult;
// returns the selected child ID, if any.
begin
Result := s_false;
if FVirtualTree <> nil then
if fVirtualTree.FocusedNode <> nil then
begin
pvarChildren := 1;
result := s_OK;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
constructor TVirtualTreeAccessibility.Create(VirtualTree: TVirtualStringTree);
// assigns the parent and current fields, and lets the control's iAccessible object know its address.
begin
fVirtualTree := VirtualTree;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.GetIDsOfNames(const IID: TGUID;
Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
// Not supported.
begin
Result := E_NOTIMPL;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HRESULT;
// not supported.
begin
Result := E_NOTIMPL;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.GetTypeInfoCount(
out Count: Integer): HRESULT;
// not supported.
begin
Result := E_NOTIMPL;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult;
// returns the iAccessible child, whicfh represents the focused item.
begin
if varChild = CHILDID_SELF then
begin
ppdispChild := FVirtualTree.AccessibleItem;
Result := S_OK;
end
else
Result := E_INVALIDARG
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accChildCount(out pcountChildren: Integer): HResult;
// Returns the number 1 for the one child: The focused item.
begin
pcountChildren := 1;
Result := S_OK;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult;
// Not supported.
begin
Result := DISP_E_MEMBERNOTFOUND;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult;
// returns the hint of the control, if assigned.
begin
pszDescription := '';
Result := S_FALSE;
if varChild = CHILDID_SELF then
begin
if FVirtualTree <> nil then
pszDescription := GetLongHint(fVirtualTree.Hint);
end;
if Length(pszDescription) > 0 then
Result := S_OK;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accFocus(out pvarChild: OleVariant): HResult;
// returns the child ID of 1, if assigned.
begin
Result := s_false;
if fVirtualTree <> nil then
begin
if FVirtualTree.FocusedNode <> nil then
begin
pvarChild := fVirtualTree.AccessibleItem;
result := s_OK;
end
else begin
pvarChild := childid_self;
result := S_OK;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult;
// Not supported.
begin
Result := DISP_E_MEMBERNOTFOUND;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
out pidTopic: Integer): HResult;
// Returns the HelpContext ID, if present.
begin
pszHelpFile := '';
pidTopic := 0;
Result := S_OK;
if varChild = CHILDID_SELF then
if FVirtualTree <> nil then
begin
pszHelpFile := Application.HelpFile;
pidTopic := FVirtualTree.HelpContext;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult;
// Not supported.
begin
pszKeyboardShortcut := '';
Result := S_FALSE;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
// if set, returns the new published AccessibleName property.
// otherwise, returns the default text.
begin
pszName := '';
Result := S_FALSE;
if varChild = CHILDID_SELF then
begin
if FVirtualTree <> nil then
begin
if FVirtualTree.AccessibleName <> '' then
pszName := FVirtualTree.AccessibleName
else
PSZName := FVirtualTree.DefaultText;
result := S_OK;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accParent(out ppdispParent: IDispatch): HResult;
// Returns false, the tree itself does not have a parent.
begin
ppdispParent := nil;
Result := S_FALSE;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult;
// tells MSAA that it is a TreeView.
begin
Result := S_OK;
// VariantInit(pvarRole);
// TVarData(pvarRole).VType := VT_I4;
if varChild = CHILDID_SELF then
begin
if FVirtualTree <> nil then
pvarRole := ROLE_SYSTEM_OUTLINE
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult;
// since we're not supporting more than one item, this is not supported currently.
begin
Result := DISP_E_MEMBERNOTFOUND;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult;
// returns the state of the control.
const
IsEnabled: array[Boolean] of Integer = (STATE_SYSTEM_UNAVAILABLE, 0);
HasPopup: array[Boolean] of Integer = (0, STATE_SYSTEM_HASPOPUP);
IsVisible: array[Boolean] of Integer = (STATE_SYSTEM_INVISIBLE, 0);
begin
Result := S_OK;
// VariantInit(pvarState);
// TVarData(pvarState).VType := VT_I4;
if varChild = CHILDID_SELF then
begin
if FVirtualTree <> nil then
begin
pvarState := STATE_SYSTEM_FOCUSED or STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_HOTTRACKED;
pvarState := pvarState or IsVisible[FVirtualTree.Visible];
pvarState := pvarState or IsEnabled[FVirtualTree.Enabled];
end
else
Result := E_INVALIDARG;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult;
// the TreeView control itself does not have a value, returning false here.
begin
pszValue := '';
Result := S_FALSE;//DISP_E_MEMBERNOTFOUND;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HRESULT;
// not supported.
begin
Result := E_NOTIMPL;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
// not supported.
begin
Result := DISP_E_MEMBERNOTFOUND
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult;
// not supported.
begin
Result := DISP_E_MEMBERNOTFOUND
end;
{ TVirtualTreeItemAccessibility }
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.accLocation(out pxLeft, pyTop, pcxWidth,
pcyHeight: Integer; varChild: OleVariant): HResult;
// returns the location of the current accessible item.
var
P: TPoint;
DisplayRect: TRect;
begin
Result := S_FALSE;
if varChild = CHILDID_SELF then
begin
if FVirtualTree.FocusedNode <> nil then
begin
DisplayRect := FVirtualTree.GetDisplayRect(FVirtualTree.FocusedNode, -1, TRUE, FALSE);
P := FVirtualTree.ClientToScreen(DisplayRect.TopLeft);
pxLeft := P.X;
pyTop := P.Y;
pcxWidth := DisplayRect.Right - DisplayRect.Left;
pcyHeight := DisplayRect.Bottom - DisplayRect.Top;
Result := S_OK;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
constructor TVirtualTreeItemAccessibility.Create(VirtualTree: TVirtualStringTree);
// sets up the parent/child relationship.
begin
fVirtualTree := VirtualTree;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult;
// the item does not have children. Returning false.
begin
ppdispChild := nil;
Result := S_FALSE;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accChildCount(out pcountChildren: Integer): HResult;
// the item itself does not have children, returning 0.
begin
pcountChildren := 0;
Result := S_OK;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult;
// not supported for an item.
begin
Result := DISP_E_MEMBERNOTFOUND;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
// the name is the node's caption.
begin
pszName := '';
Result := S_FALSE;
if varChild = childid_self then
begin
if FVirtualTree <> nil then
if FVirtualTree.FocusedNode <> nil then
begin
pszName := FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn];
result := S_OK;
end
else begin
PSZName := FVirtualTree.DefaultText;
result := S_OK;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accParent(out ppdispParent: IDispatch): HResult;
// tells MSAA that the VritualStringTree is its parent.
begin
result := S_FALSE;
if FVirtualTree <> nil then
begin
ppdispParent := FVirtualTree.Accessible;
Result := S_OK;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult;
// tells MSAA that it is a TreeView item as opposed to the TreeView itself.
begin
Result := S_OK;
// VariantInit(pvarRole);
// TVarData(pvarRole).VType := VT_I4;
if varChild = childid_self then
begin
if FVirtualTree <> nil then
pvarRole := ROLE_SYSTEM_OUTLINEITEM
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult;
// Tells MSAA the state the item is in.
const
IsEnabled: array[Boolean] of Integer = (STATE_SYSTEM_UNAVAILABLE, 0);
HasPopup: array[Boolean] of Integer = (0, STATE_SYSTEM_HASPOPUP);
IsVisible: array[Boolean] of Integer = (STATE_SYSTEM_INVISIBLE, 0);
IsChecked: array[Boolean] of Integer = (0, STATE_SYSTEM_CHECKED);
IsExpanded: array[Boolean] of Integer = (0, STATE_SYSTEM_EXPANDED);
IsCollapsed: array[Boolean] of Integer = (0, STATE_SYSTEM_COLLAPSED);
begin
Result := S_OK;
// VariantInit(pvarState);
// TVarData(pvarState).VType := VT_I4;
if varChild = childid_self then
begin
if FVirtualTree <> nil then
begin
pvarState := STATE_SYSTEM_FOCUSED or STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_HOTTRACKED;
pvarState := pvarState or IsVisible[FVirtualTree.Visible];
pvarState := pvarState or IsEnabled[FVirtualTree.Enabled];
if fVirtualTree.FocusedNode <> nil then
begin
pvarState := pvarState or IsChecked[csCheckedNormal = FVirtualTree.FocusedNode.CheckState];
pvarState := pvarState or IsExpanded[VSExpanded in FVirtualTree.FocusedNode.States];
if not (vsExpanded in FVirtualTree.FocusedNode.States) then
pvarState:= PvarState or IsCollapsed[vsHasChildren in FVirtualTree.FocusedNode.States];
end;
end
else
Result := E_INVALIDARG;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeItemAccessibility.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult;
// for a TreeView item, the value is the nesting level number, 0-based.
begin
pszValue := '';
Result := S_FALSE;//DISP_E_MEMBERNOTFOUND;
if varChild = childid_self then
if FVirtualTree <> nil then
if FVirtualTree.FocusedNode <> nil then
begin
PSZValue := IntToStr(FVirtualTree.GetNodeLevel(FVirtualTree.FocusedNode));
result := S_OK;
end;
end;
{ TVTMultiColumnItemAccessibility }
function TVTMultiColumnItemAccessibility.GetItemDescription(
varChild: OleVariant; out pszDescription: WideString;
IncludeMainColumn: boolean): HResult;
var
I: Integer;
sTemp: WideString;
begin
pszDescription := '';
Result := S_FALSE;
if varChild = childid_self then
begin
if FVirtualTree <> nil then
if FVirtualTree.FocusedNode <> nil then
begin
if IncludeMainColumn then
pszDescription := FVirtualTree.Text[FVirtualTree.FocusedNode, FVirtualTree.Header.MainColumn]
+'; ';
for I := 0 to FVirtualTree.Header.Columns.Count - 1 do
if FVirtualTree.Header.MainColumn <> I then
begin
sTemp := FVirtualTree.Text[FVirtualTree.FocusedNode, I];
if sTemp <> '' then
pszDescription := pszDescription
+FVirtualTree.Header.Columns[I].Text
+': '
+sTemp
+'; ';
end;
if pszDescription <> '' then
if pszDescription[Length(pszDescription)-1] = ';' then
Delete(pszDescription, length(pszDescription)-1, 2);
result := S_OK;
end
else begin
PSZDescription := FVirtualTree.DefaultText;
result := S_OK;
end;
end;
end;
function TVTMultiColumnItemAccessibility.Get_accDescription(
varChild: OleVariant; out pszDescription: WideString): HResult;
begin
result := GetItemDescription(varChild, pszDescription, false)
end;
function TVTMultiColumnItemAccessibility.Get_accName(varChild: OleVariant;
out pszName: WideString): HResult;
begin
result := GetItemDescription(varChild, pszName, true)
end;
{ TVTDefaultAccessibleProvider }
function TVTDefaultAccessibleProvider.CreateIAccessible(
ATree: TBaseVirtualTree): IAccessible;
begin
result := TVirtualTreeAccessibility.Create(TVirtualStringTree(ATree));
end;
{ TVTDefaultAccessibleItemProvider }
function TVTDefaultAccessibleItemProvider.CreateIAccessible(
ATree: TBaseVirtualTree): IAccessible;
begin
result := TVirtualTreeItemAccessibility.Create(TVirtualStringTree(ATree));
end;
{ TVTMultiColumnAccessibleItemProvider }
function TVTMultiColumnAccessibleItemProvider.CreateIAccessible(
ATree: TBaseVirtualTree): IAccessible;
begin
result := nil;
if TVirtualStringTree(ATree).Header.UseColumns then
result := TVTMultiColumnItemAccessibility.Create(TVirtualStringTree(ATree));
end;
var
IDefaultAccessibleProvider: TVTDefaultAccessibleProvider;
IDefaultAccessibleItemProvider: TVTDefaultAccessibleItemProvider;
IMultiColumnAccessibleProvider: TVTMultiColumnAccessibleItemProvider;
initialization
if VTAccessibleFactory = nil then
VTAccessibleFactory := TVTAccessibilityFactory.Create;
if IDefaultAccessibleProvider = nil then
begin
IDefaultAccessibleProvider := TVTDefaultAccessibleProvider.Create;
VTAccessibleFactory.RegisterAccessibleProvider(IDefaultAccessibleProvider);
end;
if IDefaultAccessibleItemProvider = nil then
begin
IDefaultAccessibleItemProvider := TVTDefaultAccessibleItemProvider.Create;
VTAccessibleFactory.RegisterAccessibleProvider(IDefaultAccessibleItemProvider);
end;
if IMultiColumnAccessibleProvider = nil then
begin
IMultiColumnAccessibleProvider := TVTMultiColumnAccessibleItemProvider.Create;
VTAccessibleFactory.RegisterAccessibleProvider(IMultiColumnAccessibleProvider);
end;
finalization
if VTAccessibleFactory <> nil then
begin
VTAccessibleFactory.UnRegisterAccessibleProvider(IMultiColumnAccessibleProvider);
IMultiColumnAccessibleProvider := nil;
VTAccessibleFactory.UnRegisterAccessibleProvider(IDefaultAccessibleItemProvider);
IDefaultAccessibleItemProvider := nil;
VTAccessibleFactory.UnRegisterAccessibleProvider(IDefaultAccessibleProvider);
IDefaultAccessibleProvider := nil;
end;
end.

123
components/virtualtreeview-new/branches/4.8/VTAccessibilityFactory.pas Normal file
View File

@ -0,0 +1,123 @@
unit VTAccessibilityFactory;
// class to create IAccessibles for the tree passed into it.
// If not already assigned, creates IAccessibles for the tree itself
// and the focused item
// the tree accessible is returned when the tree receives an WM_GETOBJECT message
// the AccessibleItem is returned when the Accessible is being asked for the first child
// To create your own IAccessibles, use the VTStandardAccessible unit as a reference,
// and assign your Accessibles to the variables in tthe unit's initialization.
// You only need to add the unit to your project, and voil�, you have an accessible string tree!
//
// Written by Marco Zehe. (c) 2007
interface
uses
Classes, oleacc, VirtualTrees;
type
IVTAccessibleProvider = interface
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
end;
TVTAccessibilityFactory = class(TObject)
private
FAccessibleProviders: TInterfaceList;
public
constructor Create;
destructor Destroy; override;
function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible;
procedure RegisterAccessibleProvider(AProvider: IVTAccessibleProvider);
procedure UnRegisterAccessibleProvider(AProvider: IVTAccessibleProvider);
end;
var
VTAccessibleFactory: TVTAccessibilityFactory;
implementation
{ TVTAccessibilityFactory }
constructor TVTAccessibilityFactory.Create;
begin
inherited;
FAccessibleProviders := TInterfaceList.Create;
FAccessibleProviders.Clear;
end;
function TVTAccessibilityFactory.CreateIAccessible(
ATree: TBaseVirtualTree): IAccessible;
var
I: Integer;
TmpIAccessible: IAccessible;
// returns an IAccessible.
// 1. If the Accessible property of the passed-in tree is nil,
// the first registered element will be returned.
// Usually, this is the IAccessible that provides information about the tree itself.
// If it is not nil, we'll check whether the AccessibleItem is nil.
// If it is, we'll look in the registered IAccessibles for the appropriate one.
// Each IAccessibleProvider will check the tree for properties to determine whether it is responsible.
// We'll work top to bottom, from the most complicated to the most simple.
// The index for these should all be greater than 0, e g the IAccessible for the tree itself should always be registered first, then any IAccessible items.
begin
result := nil;
if ATree <> nil then
begin
if ATree.Accessible = nil then
begin
if FAccessibleProviders.Count > 0 then
begin
result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree);
exit;
end;
end;
if ATree.AccessibleItem = nil then
begin
if FAccessibleProviders.Count > 0 then
begin
for I := FAccessibleProviders.Count - 1 downto 1 do
begin
TmpIAccessible := IVTAccessibleProvider(FAccessibleProviders.Items[I]).CreateIAccessible(ATree);
if TmpIAccessible <> nil then
begin
result := TmpIAccessible;
break;
end;
end;
if TmpIAccessible = nil then
begin
result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree);
end;
end;
end
else begin
result := ATree.AccessibleItem;
end;
end;
end;
destructor TVTAccessibilityFactory.Destroy;
begin
FAccessibleProviders.Free;
FAccessibleProviders := nil;
inherited;
end;
procedure TVTAccessibilityFactory.RegisterAccessibleProvider(
AProvider: IVTAccessibleProvider);
// Ads a provider if it is not already registered
begin
if FAccessibleProviders.IndexOf(AProvider) < 0 then
FAccessibleProviders.Add(AProvider)
end;
procedure TVTAccessibilityFactory.UnRegisterAccessibleProvider(
AProvider: IVTAccessibleProvider);
// Unregisters/removes an IAccessible provider if it is present
begin
if FAccessibleProviders.IndexOf(AProvider) >= 0 then
FAccessibleProviders.Remove(AProvider);
end;
end.

38
components/virtualtreeview-new/branches/4.8/VTConfig.inc Normal file
View File

@ -0,0 +1,38 @@
// 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}
//Lazarus port options
{$define EnableOLE}
{.$define EnableNativeTVM}
{.$define EnablePrint}
{.$define EnableNCFunctions}
{$define EnableAdvancedGraphics}
{$define EnableAlphaBlend}
{.$define EnableAccessible}
{$define ThemeSupport}
{.$define DEBUG_VTV}
//under linux the performance is poor with threading enabled
{$ifdef Windows}
{$define EnableThreadSupport}
{$endif}

32
components/virtualtreeview-new/branches/4.8/VTGraphics.pas Executable file
View File

@ -0,0 +1,32 @@
unit VTGraphics;
{$mode delphi}
interface
uses
DelphiCompat, Types, LCLIntf, LCLType;
type
// Describes the mode how to blend pixels.
TBlendMode = (
bmConstantAlpha, // apply given constant alpha
bmPerPixelAlpha, // use alpha value of the source pixel
bmMasterAlpha, // use alpha value of source pixel and multiply it with the constant alpha value
bmConstantAlphaAndColor // blend the destination color with the given constant color und the constant alpha value
);
procedure AlphaBlend(Source, Destination: HDC; const R: TRect; const Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer);
function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer;
function GetBitmapBitsFromBitmap(Bitmap: HBITMAP): Pointer;
implementation
{$i vtgraphicsi.inc}
end.

250
components/virtualtreeview-new/branches/4.8/VTHeaderPopup.pas Normal file
View File

@ -0,0 +1,250 @@
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.
//----------------------------------------------------------------------------------------------------------------------
{$mode delphi}
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.

32881
components/virtualtreeview-new/branches/4.8/VirtualTrees.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1
components/virtualtreeview-new/branches/4.8/demos/advanced/Advanced.exe.Manifest Normal file
View File

@ -0,0 +1 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity processorArchitecture="*" version="5.1.0.0" type="win32" name="Microsoft.Windows.Shell.shell32"/> <description>Windows Shell</description> <dependency> <dependentAssembly> <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*" /> </dependentAssembly> </dependency> </assembly>

159
components/virtualtreeview-new/branches/4.8/demos/advanced/Advanced.lpi Normal file
View File

@ -0,0 +1,159 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<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="LCL"/>
</Item1>
<Item2>
<PackageName Value="Printer4Lazarus"/>
</Item2>
<Item3>
<PackageName Value="virtualtreeview_package"/>
</Item3>
</RequiredPackages>
<Units Count="15">
<Unit0>
<Filename Value="Advanced.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="WindowsXPStyleDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="WindowsXPForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="WindowsXPStyleDemo"/>
</Unit1>
<Unit2>
<Filename Value="AlignDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="AlignForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="AlignDemo"/>
</Unit2>
<Unit3>
<Filename Value="DrawTreeDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="DrawTreeForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="DrawTreeDemo"/>
</Unit3>
<Unit4>
<Filename Value="Editors.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Editors"/>
</Unit4>
<Unit5>
<Filename Value="GeneralAbilitiesDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="GeneralForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="GeneralAbilitiesDemo"/>
</Unit5>
<Unit6>
<Filename Value="GridDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="GridForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="GridDemo"/>
</Unit6>
<Unit7>
<Filename Value="HeaderCustomDrawDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="HeaderOwnerDrawForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="HeaderCustomDrawDemo"/>
</Unit7>
<Unit8>
<Filename Value="Main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit8>
<Unit9>
<Filename Value="MultilineDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="NodeForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="MultilineDemo"/>
</Unit9>
<Unit10>
<Filename Value="PropertiesDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="PropertiesForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="PropertiesDemo"/>
</Unit10>
<Unit11>
<Filename Value="SpeedDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="SpeedForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="SpeedDemo"/>
</Unit11>
<Unit12>
<Filename Value="States.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="StateForm"/>
<HasResources Value="True"/>
<UnitName Value="States"/>
</Unit12>
<Unit13>
<Filename Value="VisibilityDemo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="VisibilityForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="VisibilityDemo"/>
</Unit13>
<Unit14>
<Filename Value="shlobjext.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="shlobjext"/>
</Unit14>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

30
components/virtualtreeview-new/branches/4.8/demos/advanced/Advanced.lpr Normal file
View File

@ -0,0 +1,30 @@
program Advanced;
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms,
//SpeedDemo in 'SpeedDemo.pas' {SpeedForm},
//DrawTreeDemo in 'DrawTreeDemo.pas' {DrawTreeForm},
//GeneralAbilitiesDemo in 'GeneralAbilitiesDemo.pas' {frmGeneralAbilities},
//PropertiesDemo in 'PropertiesDemo.pas' {PropertiesForm},
//GridDemo in 'GridDemo.pas' {GridForm},
//Editors in 'Editors.pas',
//VisibilityDemo in 'VisibilityDemo.pas' {VisibilityForm},
//AlignDemo in 'AlignDemo.pas' {AlignForm},
Main in 'Main.pas' {MainForm},
//WindowsXPStyleDemo in 'WindowsXPStyleDemo.pas' {WindowsXPForm},
//MultilineDemo in 'MultilineDemo.pas' {NodeForm},
//HeaderCustomDrawDemo in 'HeaderCustomDrawDemo.pas' {HeaderOwnerDrawForm},
States in 'States.pas' {StateForm}, Printer4Lazarus;
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TStateForm, StateForm);
Application.Run;
end.

8772
components/virtualtreeview-new/branches/4.8/demos/advanced/AlignDemo.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

611
components/virtualtreeview-new/branches/4.8/demos/advanced/AlignDemo.pas Normal file
View File

@ -0,0 +1,611 @@
unit AlignDemo;
{$mode delphi}
// Virtual Treeview sample form demonstrating following features:
// - Header with images and different glyph and column alignment.
// - Header popup with images.
// - Multilingual treeview with english, greek, hebrew and arabic texts.
// - Interaction between column alignment and column directionality (bidi).
// Written by Mike Lischke.
interface
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ComCtrls, ExtCtrls, Menus, LResources;
type
TAlignForm = class(TForm)
AlignTree: TVirtualStringTree;
Label8: TLabel;
TreeImages: TImageList;
HeaderImages: TImageList;
IconPopup: TPopupMenu;
Label1: TLabel;
AlignCombo0: TComboBox;
Label2: TLabel;
Label3: TLabel;
AlignCombo1: TComboBox;
Label4: TLabel;
AlignCombo2: TComboBox;
BidiGroup0: TRadioGroup;
BidiGroup1: TRadioGroup;
BidiGroup2: TRadioGroup;
GroupBox1: TGroupBox;
ShowGlyphsOptionBox: TCheckBox;
HotTrackOptionBox: TCheckBox;
ShowTextOptionBox: TCheckBox;
VisibleOptionBox: TCheckBox;
EnabledOptionBox: TCheckBox;
Label5: TLabel;
LayoutCombo: TComboBox;
procedure AlignTreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var Index: Integer);
procedure AlignTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure AlignTreePaintText(Sender: TBaseVirtualTree; const Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
procedure AlignTreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
procedure AlignTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure AlignTreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure IconPopupPopup(Sender: TObject);
procedure AlignComboChange(Sender: TObject);
procedure BidiGroupClick(Sender: TObject);
procedure AlignTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure OptionBoxClick(Sender: TObject);
procedure LayoutComboChange(Sender: TObject);
procedure AlignTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
procedure AlignTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
private
FArabicFont,
FHebrewFont: TFont;
procedure ChangeHeaderText;
procedure MeasureIconItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
procedure MenuItemClick(Sender: TObject);
end;
var
AlignForm: TAlignForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
Main, States;
//----------------------------------------------------------------------------------------------------------------------
const
DefaultHintColumn0 = 'Text is initially centered and has a left-to-right directionality.';
DefaultHintColumn1 = 'Text is initially left aligned and has a left-to-right directionality.';
DefaultHintColumn2 = 'Text is initially left aligned and has a right-to-left directionality.';
CommonHeaderHint = 'Right click to pick a column glyph. Left click to switch sort glyph (no sorting is performed).';
type
PAlignData = ^TAlignData;
TAlignData = record
MainColumnText,
GreekText,
RTLText: String;
ImageIndex: Integer;
end;
// These arrays store some text which is originally displayed right-to-left, so it supports the demonstration of
// alignment even more than normal text. This text will be filled at runtime from a resource file.
// Additionally, some greek text for another column is stored here too just because I like how it looks (the text,
// not the storage ;-)).
var
GreekStrings: array[0..8] of String;
ArabicStrings: array[0..3] of String;
HebrewStrings: array[0..2] of String;
//----------------------------------------------------------------------------------------------------------------------
procedure LoadStrings;
// Helper routine to load Unicode strings from the resource. Putting these strings directly into the
// source code does not work, since Delphi does not support Unicode source code.
begin
// Take the first arabic string as identification whether we have already loaded the strings or not.
if Length(ArabicStrings[0]) = 0 then
begin
LoadUnicodeStrings('Greek', GreekStrings);
LoadUnicodeStrings('Arabic', ArabicStrings);
LoadUnicodeStrings('Hebrew', HebrewStrings);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
// Node data size can also be set at design time (if you know the size of the record) or in FormCreate.
// We do it here just because to show this third way too.
begin
NodeDataSize := SizeOf(TAlignData);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreePaintText(Sender: TBaseVirtualTree; const Canvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
begin
// In order to display arabic and hebrew texts with a nice font we have assign one explicitely. Otherwise the
// system picks one and this often leads to non-ideal results.
case Column of
1:
// Make the second column lighter.
Canvas.Font.Color := clSilver;
2:
begin
if not Odd(Node.Parent.Index) then
Canvas.Font := FArabicFont
else
Canvas.Font := FHebrewFont;
end;
end;
// Reset the text color for selected and drop target nodes.
if ((Node = Sender.DropTargetNode) or (vsSelected in Node.States)) and (Column = Sender.FocusedColumn) then
Canvas.Font.Color := clHighlightText;
if Node.Parent = Sender.RootNode then
Canvas.Font.Style := [fsBold];
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
var
Data: PAlignData;
begin
Data := Sender.GetNodeData(Node);
case Column of
0: // left alignd column
CellText := Data.MainColumnText;
1: // centered column
CellText := Data.GreekText;
2: // right aligned column
CellText := Data.RTLText;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer);
var
Data: PAlignData;
begin
if Kind in [ikNormal, ikSelected] then
begin
Data := Sender.GetNodeData(Node);
Index := Data.ImageIndex;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
Data: PAlignData;
begin
// intialize caption strings
LoadStrings;
Data := Sender.GetNodeData(Node);
Data.ImageIndex := 0;
if ParentNode = nil then
begin
with Data^ do
begin
if not Odd(Node.Index) then
MainColumnText := 'Arabic texts'
else
MainColumnText := 'Hebrew texts';
GreekText := GreekStrings[(Node.Index and 1) * 5];
RTLText := '';
end;
InitialStates := InitialStates + [ivsHasChildren, ivsExpanded];
end
else
begin
if not Odd(ParentNode.Index) then
begin
with Data^ do
begin
MainColumnText := Format('Arabic text %d', [Node.Index]);
GreekText := GreekStrings[Node.Index + 1];
RTLText := ArabicStrings[Node.Index];
end;
end
else
begin
with Data^ do
begin
MainColumnText := Format('Hebrew text %d', [Node.Index]);
GreekText := GreekStrings[6 + Node.Index];
RTLText := HebrewStrings[Node.Index];
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
begin
if not Odd(Node.Index) then
ChildCount := 4 // arabic text
else
ChildCount := 3; // hebrew text
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.FormCreate(Sender: TObject);
var
I: Integer;
NewItem: TMenuItem;
begin
// To display the various texts in a nice manner we use some specialized fonts of the system.
// We could directly assign the font names used here in the OnPaintText event, but since this
// would then be the only reference for the font it would cause the font to be recreated every
// time it is used (a font is reference counted in Graphics.pas). In order to avoid this overhead
// it is better to create the fonts once and for all.
// Note: if the fonts used here are not installed on the target system then the font mapper of Windows
// will pick similar fonts which are capable of rendering the required glyphs (however Arial and Times New Roman
// should be available on any Windows system).
FArabicFont := TFont.Create;
with FArabicFont do
begin
if Screen.Fonts.IndexOf('Traditional Arabic') > -1 then
begin
Name := 'Traditional Arabic';
Size := 12;
end
else
begin
Name := 'Arial';
Size := 14;
end;
Color := $FF6B43;
if Handle = 0 then
Beep;
end;
FHebrewFont := TFont.Create;
with FHebrewFont do
begin
Name := 'Times New Roman';
Size := 14;
Color := $436BFF;
end;
// To demonstrate header clicks together with the header menu a glyph picker menu is provided.
with IconPopup do
begin
for I := 0 to HeaderImages.Count - 1 do
begin
NewItem := TMenuItem.Create(Self);
NewItem.Caption := '';
NewItem.ImageIndex := I;
NewItem.RadioItem := True;
NewItem.OnClick := MenuItemClick;
//todo
//if (I mod 10) = 0 then
// NewItem.Break := mbBreak;
//NewItem.OnMeasureItem := MeasureIconItem;
Items.Add(NewItem);
end;
end;
// Add some additional info to the column hints. This can only be done in code as the object inspector does not
// allow to enter multiline strings (it does not allow to edit wide strings correctly at all).
with AlignTree.Header do
begin
Columns[0].Hint := DefaultHintColumn0 + LineEnding + CommonHeaderHint;
Columns[1].Hint := DefaultHintColumn1 + LineEnding + CommonHeaderHint;
Columns[2].Hint := DefaultHintColumn2 + LineEnding + CommonHeaderHint;
end;
// Set up the initial values of the alignment and bidi-mode pickers as well as layout and options.
with AlignTree.Header do
begin
// Alignment and bidi
AlignCombo0.ItemIndex := Ord(Columns[0].Alignment);
BidiGroup0.ItemIndex := Ord(Columns[0].BidiMode <> bdLeftToRight);
AlignCombo1.ItemIndex := Ord(Columns[1].Alignment);
BidiGroup1.ItemIndex := Ord(Columns[1].BidiMode <> bdLeftToRight);
AlignCombo2.ItemIndex := Ord(Columns[2].Alignment);
BidiGroup2.ItemIndex := Ord(Columns[2].BidiMode <> bdLeftToRight);
// Button layout
LayoutCombo.ItemIndex := Ord(Columns[0].Layout);
if not (hoShowImages in Options) then
Height := 24
else
if Columns[0].Layout in [blGlyphTop, blGlyphBottom] then
Height := 64
else
Height := 40;
// Options
ShowGlyphsOptionBox.Checked := hoShowImages in Options;
HotTrackOptionBox.Checked := hoHotTrack in Options;
ShowTextOptionBox.Checked := True;
ChangeHeaderText;
VisibleOptionBox.Checked := hoVisible in Options;
EnabledOptionBox.Checked := coEnabled in Columns[0].Options;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.FormDestroy(Sender: TObject);
begin
FArabicFont.Free;
FHebrewFont.Free;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.ChangeHeaderText;
// Sets or clears the text of all columns depending on the state of SetTextOptionBox.
begin
with AlignTree.Header do
if ShowTextOptionBox.Checked then
begin
Columns[0].Text := 'English text column';
Columns[1].Text := 'Greek text column';
Columns[2].Text := 'Hebrew/arabic text column';
end
else
begin
Columns[0].Text := '';
Columns[1].Text := '';
Columns[2].Text := '';
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.MeasureIconItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
// Used to tell the popup menu how large it is. I don't want menu item captions so the menu item size is
// made as small as possible here.
begin
// The icons are 32 bits wide but some extra space will be added implicitely.
Width := 24;
Height := 36;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.MenuItemClick(Sender: TObject);
// During the the right click on the header the clicked column is recorded in Tree.Header.Columns.ClickIndex.
// We can use this information to determine to which column the new image index must be assigned.
var
Index: Integer;
begin
with AlignTree.Header do
begin
Index := Columns.ClickIndex;
if Index > NoColumn then
begin
(Sender as TMenuItem).Checked := True;
Columns[Index].ImageIndex := (Sender as TMenuItem).ImageIndex;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.IconPopupPopup(Sender: TObject);
// Mark the selected image before presenting the popup to the user.
var
Index: Integer;
begin
with AlignTree.Header do
begin
Index := Columns.ClickIndex;
if Index > NoColumn then
(Sender as TPopupMenu).Items[Columns[Index].ImageIndex].Checked := True;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignComboChange(Sender: TObject);
begin
with Sender as TComboBox do
case Tag of
0:
AlignTree.Header.Columns[0].Alignment := TAlignment(AlignCombo0.ItemIndex);
1:
AlignTree.Header.Columns[1].Alignment := TAlignment(AlignCombo1.ItemIndex);
2:
AlignTree.Header.Columns[2].Alignment := TAlignment(AlignCombo2.ItemIndex);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.BidiGroupClick(Sender: TObject);
begin
with Sender as TRadioGroup do
case Tag of
0:
AlignTree.Header.Columns[0].BidiMode := TBidiMode(BidiGroup0.ItemIndex);
1:
AlignTree.Header.Columns[1].BidiMode := TBidiMode(BidiGroup1.ItemIndex);
2:
AlignTree.Header.Columns[2].BidiMode := TBidiMode(BidiGroup2.ItemIndex);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
// This method sets sort column and direction on a header click.
// Note: this is only to show the header layout. There gets nothing really sorted.
begin
if Button = mbLeft then
begin
with Sender do
begin
if SortColumn <> Column then
begin
SortColumn := Column;
SortDirection := sdAscending;
end
else
case SortDirection of
sdAscending:
SortDirection := sdDescending;
sdDescending:
SortColumn := NoColumn;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.OptionBoxClick(Sender: TObject);
var
I: Integer;
begin
with Sender as TCheckBox, AlignTree.Header do
case Tag of
0:
if Checked then
begin
Options := Options + [hoShowImages];
if Columns[0].Layout in [blGlyphTop, blGlyphBottom] then
Height := 64
else
Height := 40;
end
else
begin
Options := Options - [hoShowImages];
Height := 24;
end;
1:
if Checked then
Options := Options + [hoHotTrack]
else
Options := Options - [hoHotTrack];
2:
ChangeHeaderText;
3:
if Checked then
Options := Options + [hoVisible]
else
Options := Options - [hoVisible];
4:
for I := 0 to Columns.Count - 1 do
if Checked then
Columns[I].Options := Columns[I].Options + [coEnabled]
else
Columns[I].Options := Columns[I].Options - [coEnabled];
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.LayoutComboChange(Sender: TObject);
var
I: Integer;
begin
with Sender as TComboBox, AlignTree.Header do
begin
for I := 0 to Columns.Count - 1 do
Columns[I].Layout := TVTHeaderColumnLayout(ItemIndex);
if not (hoShowImages in Options) then
Height := 24
else
if Columns[0].Layout in [blGlyphTop, blGlyphBottom] then
Height := 64
else
Height := 40;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
const
FocusedText = LineEnding + 'Text of focused node is: ';
var
Data: PAlignData;
begin
if Assigned(Node) then
begin
Data := Sender.GetNodeData(Node);
with AlignTree.Header do
begin
Columns[0].Hint := DefaultHintColumn0 + LineEnding + CommonHeaderHint + FocusedText + Data.MainColumnText;
Columns[1].Hint := DefaultHintColumn1 + LineEnding + CommonHeaderHint + FocusedText + Data.GreekText;
Columns[2].Hint := DefaultHintColumn2 + LineEnding + CommonHeaderHint + FocusedText + Data.RTLText;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAlignForm.AlignTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$I AlignDemo.lrs}
end.

169
components/virtualtreeview-new/branches/4.8/demos/advanced/DrawTreeDemo.lfm Normal file
View File

@ -0,0 +1,169 @@
object DrawTreeForm: TDrawTreeForm
Left = 333
Height = 453
Top = 339
Width = 710
ActiveControl = VDT1
Caption = 'DrawTreeForm'
ClientHeight = 453
ClientWidth = 710
Font.Height = -13
Font.Name = 'Trebuchet MS'
OnCreate = FormCreate
LCLVersion = '0.9.29'
object Label7: TLabel
Left = 0
Height = 61
Top = 0
Width = 710
Align = alTop
AutoSize = False
Caption = 'A sample for a draw tree, which shows images of all known types as thumbnails. By default this tree uses the image loader library GraphicEx to support many common image formats like png, gif etc. (see www.delphi-gems.com for more infos and download).'
ParentColor = False
WordWrap = True
end
object Label1: TLabel
Left = 4
Height = 19
Top = 423
Width = 248
Anchors = [akLeft, akBottom]
Caption = 'Adjust vertical image alignment of nodes:'
ParentColor = False
end
object Label3: TLabel
AnchorSideLeft.Control = TrackBar1
AnchorSideLeft.Side = asrBottom
AnchorSideBottom.Control = TrackBar1
AnchorSideBottom.Side = asrCenter
Left = 424
Height = 19
Top = 422
Width = 23
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 8
Caption = '50%'
ParentColor = False
end
object VDT1: TVirtualDrawTree
Left = 10
Height = 330
Top = 81
Width = 684
Anchors = [akTop, akLeft, akRight, akBottom]
AutoExpandDelay = 200
AutoScrollDelay = 200
ClipboardFormats.Strings = (
'Virtual Tree Data'
)
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
Colors.TreeLineColor = clBtnFace
DefaultNodeHeight = 32
Header.AutoSizeIndex = -1
Header.Background = clBtnHighlight
Header.Columns = <
item
Options = [coAllowClick, coEnabled, coParentColor, coResizable, coShowDropMark, coVisible]
Position = 0
Text = 'Image file name'
Width = 217
end
item
Position = 1
Text = 'Thumbnail'
Width = 200
end
item
Position = 2
Text = 'Properties'
Width = 160
end>
Header.DefaultHeight = 17
Header.Height = 22
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoRestrictDrag, hoShowSortGlyphs, hoVisible]
Header.ParentFont = True
Header.Style = hsPlates
HintMode = hmHint
Images = SystemImages
IncrementalSearch = isAll
Indent = 20
LineMode = lmBands
ParentShowHint = False
RootNodeCount = 10
ScrollBarOptions.VerticalIncrement = 32
ShowHint = True
TabOrder = 0
TreeOptions.AnimationOptions = [toAnimatedToggle]
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.PaintOptions = [toShowBackground, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowRoot, toShowTreeLines, toShowVertGridLines, toThemeAware]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnCompareNodes = VDT1CompareNodes
OnDrawHint = VDT1DrawHint
OnDrawNode = VDT1DrawNode
OnFreeNode = VDT1FreeNode
OnGetHintSize = VDT1GetHintSize
OnGetImageIndex = VDT1GetImageIndex
OnGetNodeWidth = VDT1GetNodeWidth
OnHeaderClick = VDT1HeaderClick
OnInitChildren = VDT1InitChildren
OnInitNode = VDT1InitNode
OnStateChange = VDT1StateChange
end
object TrackBar1: TTrackBar
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideBottom.Control = Label1
AnchorSideBottom.Side = asrCenter
Left = 259
Height = 38
Top = 413
Width = 157
Max = 100
OnChange = TrackBar1Change
Position = 50
TickStyle = tsNone
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 7
TabOrder = 1
end
object SystemImages: TImageList
left = 450
top = 404
Bitmap = {
4C69010000001000000010000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000003399CCFF3298CBFF3096
C9FF2E94C7FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000003399CCFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF298FC2FF00000000000000000000000000000000000000000000
00000000000000000000000000003399CCFFFFFFFFFF99FFFFFF99FFFFFF99FF
FFFF99FFFFFFFFFFFFFF248ABDFF2187BAFF1E84B7FF1C82B5FF1A80B3FF177D
B0FF0000000000000000000000003298CBFF91F7FFFF8EF4FFFF8EF4FFFF8EF4
FFFF8EF4FFFF8EF4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF157B
AEFF0000000000000000000000003096C9FF85EBFFFF80E6FFFF2C92C5FF2C92
C5FF2C92C5FF2C92C5FF2C92C5FF2C92C5FF278DC0FF2389BCFF1F85B8FF1B81
B4FF1A80B3FF1A80B3FF000000002E94C7FF7AE0FFFF2C92C5FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80E6
FFFFFFFFFFFF0A70A3FF000000002C92C5FF6ED4FFFF3399CCFF99FFFFFF99FF
FFFF99FFFFFF99FFFFFF99FFFFFF99FFFFFF99FFFFFF99FFFFFF99FFFFFF5FC5
F8FF99FFFFFF076DA0FF030303FF298FC2FF66CCFFFF3298CBFF99FFFFFF91F7
FFFF91F7FFFF91F7FFFF91F7FFFF91F7FFFF91F7FFFF91F7FFFF91F7FFFF56BC
EFFF99FFFFFF056B9EFF030303FF278DC0FF66CCFFFF2C92C5FF99FFFFFF85EB
FFFF85EBFFFF85EBFFFF85EBFFFF85EBFFFF85EBFFFF85EBFFFF85EBFFFF4DB3
E6FF99FFFFFF03699CFF030303FF248ABDFF66CCFFFF268CBFFF99FFFFFF7AE0
FFFF7AE0FFFF7AE0FFFF7AE0FFFF7AE0FFFF7AE0FFFF7AE0FFFF7AE0FFFF43A9
DCFF99FFFFFF01679AFF030303FF2187BAFF66CCFFFF1F85B8FF99FFFFFF6ED4
FFFF6ED4FFFF6ED4FFFF6ED4FFFF6ED4FFFF6ED4FFFF6ED4FFFF6ED4FFFF3AA0
D3FF99FFFFFF006699FF030303FF000000001C82B5FF1A80B3FF177DB0FF157B
AEFF1278ABFF0F75A8FF0C72A5FF0A70A3FF076DA0FF056B9EFF03699CFF0167
9AFF006699FF020202FF00000000000000000000000000000000030303FF0303
03FF030303FF030303FF030303FF030303FF030303FF030303FF030303FF0303
03FF030303FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
end
end

752
components/virtualtreeview-new/branches/4.8/demos/advanced/DrawTreeDemo.pas Normal file
View File

@ -0,0 +1,752 @@
unit DrawTreeDemo;
{$MODE Delphi}
// Virtual Treeview sample form demonstrating following features:
// - General use of TVirtualDrawTree.
// - Use of vertical node image alignment.
// - Effective use of node initialization on demand to load images.
// Written by Mike Lischke.
//
// Note: define the symbol "GraphicEx" if you have my GraphicEx library
// available (see http://www.delphi-gems.com) which allows to load
// more image formats into the application.
// Otherwise disable the conditional symbol to compile this demo.
interface
uses
{$ifdef Windows}
Windows,
{$endif}
LCLIntf, delphicompat, LCLType, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VirtualTrees, StdCtrls, ComCtrls, shlobjext, LResources;
type
TDrawTreeForm = class(TForm)
VDT1: TVirtualDrawTree;
Label7: TLabel;
SystemImages: TImageList;
Label1: TLabel;
TrackBar1: TTrackBar;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure VDT1CompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
var Result: Integer);
procedure VDT1DrawHint(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex);
procedure VDT1DrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
procedure VDT1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure VDT1GetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
procedure VDT1GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var Index: Integer);
procedure VDT1GetNodeWidth(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
var NodeWidth: Integer);
procedure VDT1HeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure VDT1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure VDT1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure TrackBar1Change(Sender: TObject);
procedure VDT1StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
private
FThumbSize: Integer;
FExtensionsInitialized: Boolean;
FExtensionList: TStringList;
FDriveStrings: string;
function CanDisplay(const Name: String): Boolean;
function GetDriveString(Index: Integer): string;
function ReadAttributes(const Name: String): Cardinal;
procedure RescaleImage(Source, Target: TBitmap);
end;
var
DrawTreeForm: TDrawTreeForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
States;
//----------------------------------------------------------------------------------------------------------------------
type
// This data record contains all necessary information about a particular file system object.
// This can either be a folder (virtual or real) or an image file.
PShellObjectData = ^TShellObjectData;
TShellObjectData = record
FullPath,
Display: String;
Attributes: Cardinal;
OpenIndex,
CloseIndex: Integer; // image indices into the system image list
Image: TBitmap;
Properties: String; // some image properties, preformatted
end;
//----------------------------------------------------------------------------------------------------------------------
function HasChildren(const Folder: string): Boolean;
// Determines whether folder contains other file objects.
var
SR: TSearchRec;
begin
Result := FindFirst(IncludeTrailingPathDelimiter(Folder) + {$ifdef Windows}'*.*'{$else}'*'{$endif},
faAnyFile, SR) = 0;
if Result then
FindClose(SR);
end;
//----------------------------------------------------------------------------------------------------------------------
function GetIconIndex(Name: string; Flags: Cardinal): Integer;
// Returns the index of the system icon for the given file object.
{
var
SFI: TSHFileInfo;
}
begin
Result := -1;
//todo
{
if SHGetFileInfo(PChar(Name), 0, SFI, SizeOf(TSHFileInfo), Flags) = 0 then
Result := -1
else
Result := SFI.iIcon;
}
end;
//----------------------------------------------------------------------------------------------------------------------
procedure GetOpenAndClosedIcons(Name: string; var Open, Closed: Integer);
begin
//todo
Closed := 0;
Open := 0;
{
Closed := GetIconIndex(Name, SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Open := GetIconIndex(Name, SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
}
end;
//----------------- TDrawTreeForm --------------------------------------------------------------------------------------
procedure GetLogicalDrivesInfo(var DriveStrings: String; var DriveCount: Integer);
var
I,
BufferSize,
DriveMap,
Mask: Cardinal;
begin
{$ifdef Windows}
DriveCount := 0;
DriveMap := GetLogicalDrives;
Mask := 1;
for I := 0 to 25 do
begin
if (DriveMap and Mask) <> 0 then
Inc(DriveCount);
Mask := Mask shl 1;
end;
BufferSize := GetLogicalDriveStrings(0, nil);
SetLength(DriveStrings, BufferSize);
GetLogicalDriveStrings(BufferSize, PChar(DriveStrings));
{$else}
DriveCount := 1;
DriveStrings := '/';
{$endif}
end;
procedure TDrawTreeForm.FormCreate(Sender: TObject);
var
//SFI: TSHFileInfo;
I,
Count: Integer;
begin
VDT1.NodeDataSize := SizeOf(TShellObjectData);
GetLogicalDrivesInfo(FDriveStrings,Count);
VDT1.RootNodeCount := Count;
//todo
{
SystemImages.Handle := SHGetFileInfo('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
SystemImages.ShareImages := True;
}
FThumbSize := 200;
end;
//----------------------------------------------------------------------------------------------------------------------
function TDrawTreeForm.CanDisplay(const Name: string): Boolean;
// Determines whether the given file is one we can display in the image tree.
var
Ext: string;
I: Integer;
begin
if not FExtensionsInitialized then
begin
FExtensionsInitialized := True;
FExtensionList := TStringList.Create;
{$ifdef GraphicEx}
FileFormatList.GetExtensionList(FExtensionList);
for I := 0 to FExtensionList.Count - 1 do
FExtensionList[I] := '.' + FExtensionList[I];
{$else}
// GraphicEx is not used so add some default extensions
with FExtensionList do
begin
Add('.bmp');
Add('.ico');
Add('.jpg');
Add('.jpeg');
//Add('.wmf');
//Add('.emf');
end;
{$endif}
FExtensionList.Sort;
end;
Ext := ExtractFileExt(Name);
Result := FExtensionList.Find(Ext, I);
end;
//----------------------------------------------------------------------------------------------------------------------
function TDrawTreeForm.GetDriveString(Index: Integer): string;
// Helper method to extract a sub string (given by Index) from FDriveStrings.
var
Head, Tail: PChar;
begin
Head := PChar(FDriveStrings);
Result := '';
repeat
Tail := Head;
while Tail^ <> #0 do
Inc(Tail);
if Index = 0 then
begin
SetString(Result, Head, Tail - Head);
Break;
end;
Dec(Index);
Head := Tail + 1;
until Head^ = #0;
end;
//----------------------------------------------------------------------------------------------------------------------
function TDrawTreeForm.ReadAttributes(const Name: String): Cardinal;
// Determines the attributes of the given shell object (file, folder).
const
SFGAO_CONTENTSMASK = $F0000000; // This value is wrongly defined in ShlObj.
//var
//Desktop: IShellFolder;
{
Eaten: Cardinal;
PIDL: PItemIDList;
Malloc: IMalloc;
}
begin
Result := 0;
//todo
{
// Get the root folder of the shell name space.
SHGetDesktopFolder(Desktop);
// While parsing the name also the shell object's attributes are determined.
// These is what we are really interested in.
Result := SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK or SFGAO_COMPRESSED;
Desktop.ParseDisplayName(0, nil, PWideChar(Name), Eaten, PIDL, Result);
// Don't forget to free the returned PIDL. The shell folder is released automatically.
SHGetMalloc(Malloc);
Malloc.Free(PIDL);
}
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.RescaleImage(Source, Target: TBitmap);
// if source is in at least one dimension larger than the thumb size then
// rescale source but keep aspect ratio
var
NewWidth,
NewHeight: Integer;
begin
if (Source.Width > FThumbSize) or (Source.Height > FThumbSize) then
begin
if Source.Width > Source.Height then
begin
NewWidth := FThumbSize;
NewHeight := Round(FThumbSize * Source.Height / Source.Width);
end
else
begin
NewHeight := FThumbSize;
NewWidth := Round(FThumbSize * Source.Width / Source.Height);
end;
Target.Width := NewWidth;
Target.Height := NewHeight;
SetStretchBltMode(Target.Canvas.Handle, HALFTONE);
StretchBlt(Target.Canvas.Handle, 0, 0, NewWidth, NewHeight,
Source.Canvas.Handle, 0, 0, Source.Width, Source.Height, SRCCOPY);
end
else
Target.Assign(Source);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
Data: PShellObjectData;
Picture: TPicture;
begin
Data := Sender.GetNodeData(Node);
if ParentNode = nil then
begin
// top level node, initialize first enumeration
Data.FullPath := GetDriveString(Node.Index);
Data.Display := Data.FullPath;
GetOpenAndClosedIcons(Data.FullPath, Data.OpenIndex, Data.CloseIndex);
end
else
begin
Picture := TPicture.Create;
Data.Display := ExtractFileName(ExcludeTrailingPathDelimiter(Data.FullPath));
if (Data.Attributes and SFGAO_FOLDER) = 0 then
try
try
Data.Image := TBitmap.Create;
Picture.LoadFromFile(Data.FullPath);
if not (Picture.Graphic is TBitmap) then
begin
// Some extra steps needed to keep non TBitmap descentants alive when
// scaling. This is needed because when accessing Picture.Bitmap all
// non-TBitmap content will simply be erased (definitly the wrong
// action, but we can't do anything to prevent this). Hence we
// must explicitly draw the graphic to a bitmap.
with Data.Image do
begin
Width := Picture.Width;
Height := Picture.Height;
Canvas.Draw(0, 0, Picture.Graphic);
end;
Picture.Bitmap.Assign(Data.Image);
end;
RescaleImage(Picture.Bitmap, Data.Image);
// Collect some additional image properties.
Data.Properties := Data.Properties + Format('%d x %d pixels', [Picture.Width, Picture.Height]);
case Picture.Bitmap.PixelFormat of
pf1bit:
Data.Properties := Data.Properties + ', 2 colors';
pf4bit:
Data.Properties := Data.Properties + ', 16 colors';
pf8bit:
Data.Properties := Data.Properties + ', 256 colors';
pf15bit:
Data.Properties := Data.Properties + ', 32K colors';
pf16bit:
Data.Properties := Data.Properties + ', 64K colors';
pf24bit:
Data.Properties := Data.Properties + ', 16M colors';
pf32bit:
Data.Properties := Data.Properties + ', 16M+ colors';
end;
if Cardinal(Data.Image.Height) + 4 > TVirtualDrawTree(Sender).DefaultNodeHeight then
Sender.NodeHeight[Node] := Data.Image.Height + 4;
except
Data.Image.Free;
Data.Image := nil;
end;
finally
Picture.Free;
end;
end;
//todo
//Data.Attributes := ReadAttributes(Data.FullPath);
//if ((Data.Attributes and SFGAO_HASSUBFOLDER) <> 0) or
// (((Data.Attributes and SFGAO_FOLDER) <> 0) and HasChildren(Data.FullPath)) then
if HasChildren(Data.FullPath) then
Include(InitialStates, ivsHasChildren);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: PShellObjectData;
begin
Data := Sender.GetNodeData(Node);
Data.Image.Free;
Finalize(Data^); // Clear string data.
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1DrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
// This is the main paint routine for a node in a draw tree. There is nothing special here. Demonstrating the
// specific features of a draw tree (compared to the string tree) is a bit difficult, since the only difference is
// that the draw tree does not handle node content (captions in the case of the string tree).
var
Data: PShellObjectData;
X: Integer;
S: String;
R: TRect;
begin
with Sender as TVirtualDrawTree, PaintInfo do
begin
Data := Sender.GetNodeData(Node);
if (Column = FocusedColumn) and (Node = FocusedNode) then
Canvas.Font.Color := clHighlightText
else
if (Data.Attributes and SFGAO_COMPRESSED) <> 0 then
Canvas.Font.Color := clBlue
else
Canvas.Font.Color := clWindowText;
SetBKMode(Canvas.Handle, TRANSPARENT);
R := ContentRect;
InflateRect(R, -TextMargin, 0);
Dec(R.Right);
Dec(R.Bottom);
S := '';
case Column of
0, 2:
begin
if Column = 2 then
begin
if Assigned(Data.Image) then
S:= Data.Properties;
end
else
S := Data.Display;
if Length(S) > 0 then
begin
with R do
begin
if (NodeWidth - 2 * Margin) > (Right - Left) then
S := ShortenString(Canvas.Handle, S, Right - Left);
end;
DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_TOP or DT_LEFT or DT_VCENTER or DT_SINGLELINE);
end;
end;
1:
begin
if Assigned(Data.Image) then
begin
X := ContentRect.Left + (VDT1.Header.Columns[1].Width - Data.Image.Width - Margin) div 2;
BitBlt(Canvas.Handle, X, ContentRect.Top + 2, Data.Image.Width, Data.Image.Height, Data.Image.Canvas.Handle,
0, 0, SRCCOPY);
end;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1GetNodeWidth(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
var NodeWidth: Integer);
// Since the draw tree does not know what is in a cell, we have to return the width of the content (not the entire
// cell width, this could be determined by the column width).
var
Data: PShellObjectData;
AMargin: Integer;
begin
with Sender as TVirtualDrawTree do
AMargin := TextMargin;
begin
Data := Sender.GetNodeData(Node);
case Column of
0:
begin
if Node.Parent = Sender.RootNode then
NodeWidth := Canvas.TextWidth(Data.FullPath) + 2 * AMargin
else
NodeWidth := Canvas.TextWidth(ExtractFileName(Data.FullPath)) + 2 * AMargin;
end;
1:
begin
if Assigned(Data.Image) then
NodeWidth := Data.Image.Width;
end;
2:
NodeWidth := Canvas.TextWidth(Data.Properties) + 2 * AMargin;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
// Called just before a node with children (only folder nodes can have children) is expanded.
var
Data,
ChildData: PShellObjectData;
SR: TSearchRec;
ChildNode: PVirtualNode;
NewName: String;
begin
Data := Sender.GetNodeData(Node);
if FindFirst(IncludeTrailingPathDelimiter(Data.FullPath) + {$ifdef Windows}'*.*'{$else}'*'{$endif},
faAnyFile, SR) = 0 then
begin
Screen.Cursor := crHourGlass;
try
repeat
if (SR.Name <> '.') and (SR.Name <> '..') then
begin
NewName := IncludeTrailingPathDelimiter(Data.FullPath) + SR.Name;
if (SR.Attr and faDirectory <> 0) or CanDisplay(NewName) then
begin
ChildNode := Sender.AddChild(Node);
ChildData := Sender.GetNodeData(ChildNode);
ChildData.FullPath := NewName;
ChildData.Attributes := 0; //ReadAttributes(NewName);
//if (ChildData.Attributes and SFGAO_FOLDER) = 0 then
if (SR.Attr and faDirectory = 0) then
ChildData.Properties := Format('%n KB, ', [SR.Size / 1024])
else
ChildData.Attributes := SFGAO_FOLDER;
GetOpenAndClosedIcons(ChildData.FullPath, ChildData.OpenIndex, ChildData.CloseIndex);
Sender.ValidateNode(Node, False);
end;
end;
until FindNext(SR) <> 0;
ChildCount := Sender.ChildCount[Node];
// finally sort node
if ChildCount > 0 then
Sender.Sort(Node, 0, TVirtualStringTree(Sender).Header.SortDirection, False);
finally
FindClose(SR);
Screen.Cursor := crDefault;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer);
// Returns the proper node image which has been determine on initialization time. Also overlay images are
// used properly for shared folders.
var
Data: PShellObjectData;
begin
if Column = 0 then
begin
Data := Sender.GetNodeData(Node);
case Kind of
ikNormal,
ikSelected:
begin
if Sender.Expanded[Node] then
Index := Data.OpenIndex
else
Index := Data.CloseIndex;
end;
ikOverlay:
if (Data.Attributes and SFGAO_SHARE) <> 0 then
Index := 0
else
if (Data.Attributes and SFGAO_LINK) <> 0 then
Index := 1;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1GetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
// Draw trees must manage parts of the hints themselves. Here we return the size of the hint window we want to show
// or an empty rectangle in the case we don't want a hint at all.
var
Data: PShellObjectData;
begin
Data := Sender.GetNodeData(Node);
if Assigned(Data) and Assigned(Data.Image) and (Column = 1) then
R := Rect(0, 0, 2 * Data.Image.Width, 2 * Data.Image.Height)
else
R := Rect(0, 0, 0, 0);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1DrawHint(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; R: TRect;
Column: TColumnIndex);
// Here we actually paint the hint. It is the image in a larger size.
var
Data: PShellObjectData;
begin
Data := Sender.GetNodeData(Node);
if Assigned(Data) and Assigned(Data.Image) and (Column = 1) then
begin
SetStretchBltMode(Canvas.Handle, HALFTONE);
StretchBlt(Canvas.Handle, 0, 0, 2 * Data.Image.Width, 2 * Data.Image.Height, Data.Image.Canvas.Handle, 0, 0,
Data.Image.Width, Data.Image.Height, SRCCOPY);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1CompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
var Result: Integer);
// The node comparison routine is the heart of the tree sort. Here we have to tell the caller which node we consider
// being "larger" or "smaller".
var
Data1,
Data2: PShellObjectData;
begin
Data1 := Sender.GetNodeData(Node1);
Data2 := Sender.GetNodeData(Node2);
// Folder are always before files. Check if *both* are folders or *both* are non-folders, but not different.
if ((Data1.Attributes xor Data2.Attributes) and SFGAO_FOLDER) <> 0 then
begin
// One of both is a folder the other is a file.
if (Data1.Attributes and SFGAO_FOLDER) <> 0 then
Result := -1
else
Result := 1;
end
else
// Both are of same type (folder or file). Just compare captions.
// Note that we use ANSI comparison, while the strings are Unicode. Since this will implicitely convert the captions
// to ANSI for comparation it might happen that the sort order is wrong for names which contain text in a language
// other than the current OS language. A full blown Unicode comparison is beyond the scope of this demo.
Result := CompareText(Data1.FullPath, Data2.FullPath);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1HeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
// Click handler to switch the column on which will be sorted. Since we cannot sort image data sorting is actually
// limited to the main column.
begin
if Button = mbLeft then
begin
with Sender do
begin
if Column <> MainColumn then
SortColumn := NoColumn
else
begin
if SortColumn = NoColumn then
begin
SortColumn := Column;
SortDirection := sdAscending;
end
else
if SortDirection = sdAscending then
SortDirection := sdDescending
else
SortDirection := sdAscending;
Treeview.SortTree(SortColumn, SortDirection, False);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.TrackBar1Change(Sender: TObject);
// This part has nothing to do with the tree content and is only to show the effect of vertical image alignment for nodes
// (since this does not justify an own demo).
// Btw: look how fast this stuff is. Even with several thousands of nodes you still can adjust the position interactively.
var
Run: PVirtualNode;
begin
Label3.Caption := Format('%d%%', [Trackbar1.Position]);
with VDT1, Trackbar1 do
begin
BeginUpdate;
try
Run := GetFirst;
while Assigned(Run) do
begin
VerticalAlignment[Run] := Position;
Run := GetNextVisible(Run);
end;
finally
EndUpdate;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TDrawTreeForm.VDT1StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$I DrawTreeDemo.lrs}
end.

603
components/virtualtreeview-new/branches/4.8/demos/advanced/Editors.pas Normal file
View File

@ -0,0 +1,603 @@
unit Editors;
{$MODE Delphi}
// Utility unit for the advanced Virtual Treeview demo application which contains the implementation of edit link
// interfaces used in other samples of the demo.
interface
uses
LCLIntf, delphicompat, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ExtDlgs, Buttons, ExtCtrls, ComCtrls,
MaskEdit, LCLType, EditBtn;
type
// Describes the type of value a property tree node stores in its data property.
TValueType = (
vtNone,
vtString,
vtPickString,
vtNumber,
vtPickNumber,
vtMemo,
vtDate
);
//----------------------------------------------------------------------------------------------------------------------
type
// Node data record for the the document properties treeview.
PPropertyData = ^TPropertyData;
TPropertyData = record
ValueType: TValueType;
Value: String; // This value can actually be a date or a number too.
Changed: Boolean;
end;
// Our own edit link to implement several different node editors.
TPropertyEditLink = class(TInterfacedObject, IVTEditLink)
private
FEdit: TWinControl; // One of the property editor classes.
FTree: TVirtualStringTree; // A back reference to the tree calling.
FNode: PVirtualNode; // The node being edited.
FColumn: Integer; // The column of the node being edited.
protected
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
public
destructor Destroy; override;
function BeginEdit: Boolean; stdcall;
function CancelEdit: Boolean; stdcall;
function EndEdit: Boolean; stdcall;
function GetBounds: TRect; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
procedure ProcessMessage(var Message: TMessage); stdcall;
procedure SetBounds(R: TRect); stdcall;
end;
//----------------------------------------------------------------------------------------------------------------------
type
TPropertyTextKind = (
ptkText,
ptkHint
);
// The following constants provide the property tree with default data.
const
// Types of editors to use for a certain node in VST3.
ValueTypes: array[0..1, 0..12] of TValueType = (
(
vtString, // Title
vtString, // Theme
vtPickString, // Category
vtMemo, // Keywords
vtNone, // Template
vtNone, // Page count
vtNone, // Word count
vtNone, // Character count
vtNone, // Lines
vtNone, // Paragraphs
vtNone, // Scaled
vtNone, // Links to update
vtMemo), // Comments
(
vtString, // Author
vtNone, // Most recently saved by
vtNumber, // Revision number
vtPickString, // Primary application
vtString, // Company name
vtNone, // Creation date
vtDate, // Most recently saved at
vtNone, // Last print
vtNone,
vtNone,
vtNone,
vtNone,
vtNone)
);
// types of editors to use for a certain node in VST3
DefaultValue: array[0..1, 0..12] of String = (
(
'Virtual Treeview', // Title
'native Delphi controls', // Theme
'Virtual Controls', // Category
'virtual, treeview, VCL', // Keywords
'no template used', // Template
'> 900', // Page count
'?', // Word count
'~ 1.000.000', // Character count
'~ 28.000', // Lines
'', // Paragraphs
'False', // Scaled
'www.delphi-gems.com', // Links to update
'Virtual Treeview is much more than a simple treeview.'), // Comments
(
'Dipl. Ing. Mike Lischke', // Author
'Mike Lischke', // Most recently saved by
'3.0', // Revision number
'Delphi', // Primary application
'', // Company name
'July 1999', // Creation date
'January 2002', // Most recently saved at
'', // Last print
'',
'',
'',
'',
'')
);
// Fixed strings for property tree (VST3).
PropertyTexts: array[0..1, 0..12, TPropertyTextKind] of string = (
(// first (upper) subtree
('Title', 'Title of the file or document'),
('Theme', 'Theme of the file or document'),
('Category', 'Category of theme'),
('Keywords', 'List of keywords which describe the content of the file'),
('Template', 'Name of the template which was used to create the document'),
('Page count', 'Number of pages in the document'),
('Word count', 'Number of words in the document'),
('Character count', 'Number of characters in the document'),
('Lines', 'Number of lines in the document'),
('Paragraphs', 'Number of paragraphs in the document'),
('Scaled', 'Scaling of the document for output'),
('Links to update', 'Links which must be updated'),
('Comments', 'Description or comments for the file')
),
(// second (lower) subtree
('Author', 'name of the author of the file or document'),
('Most recently saved by', 'Name of the person who has saved the document last'),
('Revision number', 'Revision number of the file or document'),
('Primary application', 'Name of the application which is primarily used to create this kind of file'),
('Company name', 'Name of the company or institution'),
('Creation date', 'Date when the file or document was created'),
('Most recently saved at', 'Date when the file or document was saved the last time'),
('Last print', 'Date when the file or document was printed the last time'),
('', ''), // the remaining 5 entries are not used
('', ''),
('', ''),
('', ''),
('', '')
)
);
//----------------------------------------------------------------------------------------------------------------------
type
PGridData = ^TGridData;
TGridData = record
ValueType: array[0..3] of TValueType; // one for each column
Value: array[0..3] of Variant;
Changed: Boolean;
end;
// Our own edit link to implement several different node editors.
{ TGridEditLink }
TGridEditLink = class(TPropertyEditLink, IVTEditLink)
public
function EndEdit: Boolean; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
end;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
PropertiesDemo, GridDemo;
//----------------- TPropertyEditLink ----------------------------------------------------------------------------------
// This implementation is used in VST3 to make a connection beween the tree
// and the actual edit window which might be a simple edit, a combobox
// or a memo etc.
destructor TPropertyEditLink.Destroy;
begin
FEdit.Free;
inherited;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertyEditLink.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
CanAdvance: Boolean;
begin
CanAdvance := true;
case Key of
VK_ESCAPE:
if CanAdvance then
begin
FTree.CancelEditNode;
Key := 0;
end;
VK_RETURN:
if CanAdvance then
begin
FTree.EndEditNode;
Key := 0;
end;
VK_UP,
VK_DOWN:
begin
// Consider special cases before finishing edit mode.
CanAdvance := Shift = [];
if FEdit is TComboBox then
CanAdvance := CanAdvance and not TComboBox(FEdit).DroppedDown;
//todo: there's no way to know if date is being edited in LCL
//if FEdit is TDateEdit then
// CanAdvance := CanAdvance and not TDateEdit(FEdit).DroppedDown;
if CanAdvance then
begin
// Forward the keypress to the tree. It will asynchronously change the focused node.
PostMessage(FTree.Handle, WM_KEYDOWN, Key, 0);
Key := 0;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.BeginEdit: Boolean;
begin
Result := True;
FEdit.Show;
FEdit.SetFocus;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.CancelEdit: Boolean;
begin
Result := True;
FEdit.Hide;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.EndEdit: Boolean;
var
Data: PPropertyData;
Buffer: array[0..1024] of Char;
S: String;
begin
Result := True;
Data := FTree.GetNodeData(FNode);
if FEdit is TComboBox then
S := TComboBox(FEdit).Text
else
begin
if FEdit is TCustomEdit then
S := TCustomEdit(FEdit).Text
else
raise Exception.Create('Unknow edit control');
end;
if S <> Data.Value then
begin
Data.Value := S;
Data.Changed := True;
FTree.InvalidateNode(FNode);
end;
FEdit.Hide;
FTree.SetFocus;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.GetBounds: TRect;
begin
Result := FEdit.BoundsRect;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
Data: PPropertyData;
begin
Result := True;
FTree := Tree as TVirtualStringTree;
FNode := Node;
FColumn := Column;
// determine what edit type actually is needed
FEdit.Free;
FEdit := nil;
Data := FTree.GetNodeData(Node);
case Data.ValueType of
vtString:
begin
FEdit := TEdit.Create(nil);
with FEdit as TEdit do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtPickString:
begin
FEdit := TComboBox.Create(nil);
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
Items.Add(Text);
Items.Add('Standard');
Items.Add('Additional');
Items.Add('Win32');
OnKeyDown := EditKeyDown;
end;
end;
vtNumber:
begin
FEdit := TMaskEdit.Create(nil);
with FEdit as TMaskEdit do
begin
Visible := False;
Parent := Tree;
EditMask := '9999';
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtPickNumber:
begin
FEdit := TComboBox.Create(nil);
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtMemo:
begin
FEdit := TComboBox.Create(nil);
// In reality this should be a drop down memo but this requires
// a special control.
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
Items.Add(Data.Value);
OnKeyDown := EditKeyDown;
end;
end;
vtDate:
begin
FEdit := TDateEdit.Create(nil);
with FEdit as TDateEdit do
begin
Visible := False;
Parent := Tree;
Date := StrToDate(Data.Value);
OnKeyDown := EditKeyDown;
end;
end;
else
Result := False;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertyEditLink.ProcessMessage(var Message: TMessage);
begin
FEdit.WindowProc(Message);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertyEditLink.SetBounds(R: TRect);
var
Dummy: Integer;
begin
// Since we don't want to activate grid extensions in the tree (this would influence how the selection is drawn)
// we have to set the edit's width explicitly to the width of the column.
FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
if FEdit is TDateEdit then
R.Right := R.Right - TDateEdit(FEdit).ButtonWidth;
FEdit.BoundsRect := R;
end;
//---------------- TGridEditLink ---------------------------------------------------------------------------------------
function TGridEditLink.EndEdit: Boolean;
var
Data: PGridData;
Buffer: array[0..1024] of Char;
//S: WideString;
S: String;
I: Integer;
begin
Result := True;
Data := FTree.GetNodeData(FNode);
if FEdit is TComboBox then
begin
S := TComboBox(FEdit).Text;
if S <> Data.Value[FColumn - 1] then
begin
Data.Value[FColumn - 1] := S;
Data.Changed := True;
end;
end
else
if FEdit is TMaskEdit then
begin
I := StrToInt(Trim(TMaskEdit(FEdit).EditText));
if I <> Data.Value[FColumn - 1] then
begin
Data.Value[FColumn - 1] := I;
Data.Changed := True;
end;
end
else
if FEdit is TCustomEdit then
begin
S := TCustomEdit(FEdit).Text;
if S <> Data.Value[FColumn - 1] then
begin
Data.Value[FColumn - 1] := S;
Data.Changed := True;
end;
end
else
raise Exception.Create('Unknow Edit Control');
if Data.Changed then
FTree.InvalidateNode(FNode);
FEdit.Hide;
end;
//----------------------------------------------------------------------------------------------------------------------
function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
Data: PGridData;
TempText: String;
begin
Result := True;
FTree := Tree as TVirtualStringTree;
FNode := Node;
FColumn := Column;
// Determine what edit type actually is needed.
FEdit.Free;
FEdit := nil;
Data := FTree.GetNodeData(Node);
case Data.ValueType[FColumn - 1] of
vtString:
begin
FEdit := TEdit.Create(nil);
with FEdit as TEdit do
begin
Visible := False;
Parent := Tree;
TempText:= Data.Value[FColumn - 1];
Text := TempText;
OnKeyDown := EditKeyDown;
end;
end;
vtPickString:
begin
FEdit := TComboBox.Create(nil);
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
TempText:= Data.Value[FColumn - 1];
Text := TempText;
// Here you would usually do a lookup somewhere to get
// values for the combobox. We only add some dummy values.
case FColumn of
2:
begin
Items.Add('John');
Items.Add('Mike');
Items.Add('Barney');
Items.Add('Tim');
end;
3:
begin
Items.Add('Doe');
Items.Add('Lischke');
Items.Add('Miller');
Items.Add('Smith');
end;
end;
OnKeyDown := EditKeyDown;
end;
end;
vtNumber:
begin
FEdit := TMaskEdit.Create(nil);
with FEdit as TMaskEdit do
begin
Visible := False;
Parent := Tree;
EditMask := '9999;0; ';
TempText:= Data.Value[FColumn - 1];
Text := TempText;
OnKeyDown := EditKeyDown;
end;
end;
vtPickNumber:
begin
FEdit := TComboBox.Create(nil);
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
TempText:= Data.Value[FColumn - 1];
Text := TempText;
OnKeyDown := EditKeyDown;
end;
end;
vtMemo:
begin
FEdit := TComboBox.Create(nil);
// In reality this should be a drop down memo but this requires
// a special control.
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
TempText:= Data.Value[FColumn - 1];
Text := TempText;
Items.Add(Data.Value[FColumn - 1]);
OnKeyDown := EditKeyDown;
end;
end;
vtDate:
begin
FEdit := TDateEdit.Create(nil);
with FEdit as TDateEdit do
begin
Visible := False;
Parent := Tree;
Date := StrToDate(Data.Value[FColumn - 1]);
OnKeyDown := EditKeyDown;
end;
end;
else
Result := False;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
end.

6757
components/virtualtreeview-new/branches/4.8/demos/advanced/GeneralAbilitiesDemo.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

571
components/virtualtreeview-new/branches/4.8/demos/advanced/GeneralAbilitiesDemo.pas Normal file
View File

@ -0,0 +1,571 @@
unit GeneralAbilitiesDemo;
{$MODE Delphi}
// Virtual Treeview sample form demonstrating following features:
// - General use and feel of TVirtualStringTree.
// - Themed/non-themed painting.
// - Node button styles.
// - Selection rectangle styles.
// - Multiple columns, header, customize column backgrounds, header popup.
// - Unicode strings.
// - OLE drag'n drop image.
// - Switchable main column.
// - Right click select and drag.
// - Node specific popup menu.
// - Save tree content as text file.
// Written by Mike Lischke.
interface
uses
LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, VTHeaderPopup, VirtualTrees, ComCtrls, ExtCtrls, Menus,
ActnList, LResources, ImgList;
type
TGeneralForm = class(TForm)
VST2: TVirtualStringTree;
CheckMarkCombo: TComboBox;
Label18: TLabel;
MainColumnUpDown: TUpDown;
Label19: TLabel;
BitBtn1: TBitBtn;
Label8: TLabel;
TreeImages: TImageList;
FontDialog1: TFontDialog;
PopupMenu1: TPopupMenu;
Onemenuitem1: TMenuItem;
forrightclickselection1: TMenuItem;
withpopupmenu1: TMenuItem;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
VTHPopup: TVTHeaderPopupMenu;
ThemeRadioGroup: TRadioGroup;
SaveButton: TBitBtn;
SaveDialog: TSaveDialog;
ImageList1: TImageList;
procedure BitBtn1Click(Sender: TObject);
procedure VST2InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure VST2InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure VST2NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: String);
procedure VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VST2PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
procedure VST2GetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
procedure CheckMarkComboChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MainColumnUpDownChanging(Sender: TObject; var AllowChange: Boolean);
procedure VST2GetPopupMenu(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
var AskParent: Boolean; var PopupMenu: TPopupMenu);
procedure VST2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure RadioGroup1Click(Sender: TObject);
procedure VST2FocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn,
NewColumn: TColumnIndex; var Allowed: Boolean);
procedure RadioGroup2Click(Sender: TObject);
procedure ThemeRadioGroupClick(Sender: TObject);
procedure SaveButtonClick(Sender: TObject);
procedure VST2StateChange(Sender: TBaseVirtualTree; Enter,
Leave: TVirtualTreeStates);
procedure VST2DragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
procedure VST2GetImageIndexEx(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer;
var ImageList: TCustomImageList);
end;
var
GeneralForm: TGeneralForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
States;
//----------------------------------------------------------------------------------------------------------------------
const
LevelCount = 5;
type
PNodeData2 = ^TNodeData2;
TNodeData2 = record
Caption,
StaticText,
ForeignText: String;
ImageIndex,
Level: Integer;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.FormCreate(Sender: TObject);
var
I: Integer;
begin
// Determine if we are running on Windows XP.
{$ifdef LCLWin32}
ThemeRadioGroup.Enabled := (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
{$else}
ThemeRadioGroup.Enabled := False;
{$endif}
if ThemeRadioGroup.Enabled then
ThemeRadioGroup.ItemIndex := 0;
CheckMarkCombo.ItemIndex := 3;
// Add a second line of hint text for column headers (not possible in the object inspector).
with VST2.Header do
for I := 0 to Columns.Count - 1 do
Columns[I].Hint := Columns[I].Hint + #10 + '(Can show further information in hints too.)';
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2GetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
// Returns the size of a node record. Since this size is fixed already at
// creation time it would make sense to avoid this event and assign the value
// in OnCreate of the form (see there for the other trees). But this is a
// demo program, so I want to show this way too. Note the -1 value in
// VST2.NodeDataSize which primarily causes this event to be fired.
begin
NodeDataSize := SizeOf(TNodeData2);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
var
Data: PNodeData2;
begin
Data := Sender.GetNodeData(Node);
case Column of
0: // main column
case TextType of
ttNormal:
if Data.Level = 0 then
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
ttStatic:
begin
if Node = Sender.HotNode then
TargetCanvas.Font.Color := clRed
else
TargetCanvas.Font.Color := clBlue;
TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
end;
end;
1: // image column (there is no text)
;
2: // language column (no customization)
;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
// Returns the text as it is stored in the nodes data record.
var
Data: PNodeData2;
begin
Data := Sender.GetNodeData(Node);
CellText := '';
case Column of
0: // main column (has two different captions)
case TextType of
ttNormal:
CellText := Data.Caption;
ttStatic:
CellText := Data.StaticText;
end;
1: // no text in the image column
;
2:
if TextType = ttNormal then
CellText := Data.ForeignText;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
const
LevelToCheckType: array[0..5] of TCheckType = (
ctButton, ctRadioButton, ctTriStateCheckBox, ctTriStateCheckBox, ctCheckBox, ctNone
);
var
Data: PNodeData2;
WideStr: WideString;
begin
Data := Sender.GetNodeData(Node);
with Data^ do
begin
Level := Sender.GetNodeLevel(Node);
if Level < LevelCount then
begin
Include(InitialStates, ivsHasChildren);
if Level = 0 then
Include(InitialStates, ivsExpanded);
end;
Caption := Format('Level %d, Index %d', [Level, Node.Index]);
if Level in [0, 3] then
StaticText := '(static text)';
ForeignText := '';
case Data.Level of
1:
begin
WideStr := WideChar($2200);
WideStr := WideStr + WideChar($2202) + WideChar($221C) + WideChar($221E) + WideChar($2230) +
WideChar($2233) + WideChar($2257) + WideChar($225D) + WideChar($22B6) + WideChar($22BF);
ForeignText := UTF8Encode(WideStr);
end;
2:
begin
WideStr := WideChar($32E5);
WideStr := WideStr + WideChar($32E6) + WideChar($32E7) + WideChar($32E8) + WideChar($32E9);
ForeignText := UTF8Encode(WideStr);
end;
3:
begin
WideStr := WideChar($03B1);
WideStr := WideStr + WideChar($03B2) + WideChar($03B3) + WideChar($03B4) + WideChar($03B5) +
WideChar($03B6) + WideChar($03B7) + WideChar($03B8) + WideChar($03B9);
ForeignText := UTF8Encode(WideStr);
end;
4:
begin
WideStr := WideChar($20AC);
WideStr := 'nichts ist unm�glich ' + WideStr;
ForeignText := UTF8Encode(WideStr);
end;
5:
begin
ForeignText := 'Deepest level';
end;
end;
Node.CheckType := LevelToCheckType[Data.Level];
Sender.CheckState[Node] := csCheckedNormal;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2GetImageIndexEx(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer; var ImageList: TCustomImageList);
var
Data: PNodeData2;
begin
// For this demo only the normal image is shown, you can easily
// change this for the state and overlay images.
case Kind of
ikNormal, ikSelected:
begin
Data := Sender.GetNodeData(Node);
Ghosted := Node.Index = 1;
case Column of
-1, // general case
0: // main column
ImageIndex := Data.Level + 7;
1: // image only column
if Sender.FocusedNode = Node then
ImageIndex := 6;
end;
end;
ikOverlay:
begin
// Enable this code to show an arbitrary overlay for each image.
// Note the high overlay index. Standard overlays only go up to 15.
// Virtual Treeview allows for any number.
// ImageList := ImageList1;
// ImageIndex := 58;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
// The tree is set to 5 levels a 5 children (~4000 nodes).
var
Data: PNodeData2;
begin
Data := Sender.GetNodeData(Node);
if Data.Level < LevelCount then
ChildCount := 5;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
Text: String);
// The caption of a node has been changed, keep this in the node record.
var
Data: PNodeData2;
begin
Data := Sender.GetNodeData(Node);
Data.Caption := Text;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.BitBtn1Click(Sender: TObject);
begin
with FontDialog1 do
begin
Font := VST2.Font;
if Execute then
VST2.Font := Font;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.CheckMarkComboChange(Sender: TObject);
begin
VST2.CheckImageKind := TCheckImageKind(CheckMarkCombo.ItemIndex);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.MainColumnUpDownChanging(Sender: TObject; var AllowChange: Boolean);
begin
VST2.Header.MainColumn := MainColumnUpDown.Position;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2GetPopupMenu(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
const P: TPoint; var AskParent: Boolean; var PopupMenu: TPopupMenu);
begin
case Column of
0:
PopupMenu := PopupMenu1
else
PopupMenu := nil;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if ssCtrl in Shift then
case Key of
Ord('C'):
VST2.CopyToClipboard;
Ord('X'):
VST2.CutToClipboard;
end
else
case Key of
VK_DELETE:
if Assigned(VST2.FocusedNode) then
VST2.DeleteNode(VST2.FocusedNode);
VK_INSERT:
if Assigned(VST2.FocusedNode) then
VST2.AddChild(VST2.FocusedNode);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.RadioGroup1Click(Sender: TObject);
begin
with Sender as TRadioGroup do
if ItemIndex = 0 then
begin
VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions + [toShowTreeLines];
VST2.ButtonStyle := bsRectangle;
end
else
begin
VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions - [toShowTreeLines];
VST2.ButtonStyle := bsTriangle;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2FocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn,
NewColumn: TColumnIndex; var Allowed: Boolean);
begin
Allowed := NewColumn in [0, 2];
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.RadioGroup2Click(Sender: TObject);
begin
with Sender as TRadioGroup do
if ItemIndex = 0 then
begin
VST2.DrawSelectionMode := smDottedRectangle;
end
else
begin
VST2.DrawSelectionMode := smBlendedRectangle;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.ThemeRadioGroupClick(Sender: TObject);
begin
with VST2.TreeOptions do
if ThemeRadioGroup.ItemIndex = 0 then
PaintOptions := PaintOptions + [toThemeAware]
else
PaintOptions := PaintOptions - [toThemeAware];
RadioGroup1.Enabled := ThemeRadioGroup.ItemIndex = 1;
RadioGroup2.Enabled := ThemeRadioGroup.ItemIndex = 1;
Label18.Enabled := ThemeRadioGroup.ItemIndex = 1;
CheckMarkCombo.Enabled := ThemeRadioGroup.ItemIndex = 1;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.SaveButtonClick(Sender: TObject);
const
HTMLHead = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">'#13#10 +
'<html>'#13#10 +
' <head>'#13#10 +
' <meta http-equiv="Content-Type" content="text/html; charset=utf-8">'#13#10 +
' <title>Virtual Treeview export</title>'#13#10 +
' </head>'#13#10 +
'<body>'#13#10;
var
S: string;
WS: WideString;
Data: Pointer;
DataSize: Cardinal;
TargetName: string;
begin
with SaveDialog do
begin
if Execute then
begin
TargetName := FileName;
writeln('Filter Index: ', FilterIndex);
case FilterIndex of
1: // HTML
begin
if Pos('.', TargetName) = 0 then
TargetName := TargetName + '.html';
S := HTMLHead + VST2.ContentToHTML(tstVisible) + '</body></html>';
Data := PChar(S);
DataSize := Length(S);
end;
2: // Unicode UTF-16 text file
begin
TargetName := ChangeFileExt(TargetName, '.uni');
WS := VST2.ContentToUnicode(tstVisible, #9);
Data := PWideChar(WS);
DataSize := 2 * Length(WS);
end;
3: // Rich text UTF-16 file
begin
TargetName := ChangeFileExt(TargetName, '.rtf');
S := VST2.ContentToRTF(tstVisible);
Data := PChar(S);
DataSize := Length(S);
end;
4: // Comma separated values ANSI text file
begin
TargetName := ChangeFileExt(TargetName, '.csv');
S := VST2.ContentToText(tstVisible, ListSeparator);
Data := PChar(S);
DataSize := Length(S);
end;
5: // Unicode UTF-8 text file
begin
TargetName := ChangeFileExt(TargetName, '.txt');
S := VST2.ContentToUTF8(tstVisible, #9);
Data := PChar(S);
DataSize := Length(S);
end;
else
// Plain text file
TargetName := ChangeFileExt(TargetName, '.txt');
S := VST2.ContentToText(tstVisible, #9);
Data := PChar(S);
DataSize := Length(S);
end;
with TFileStream.Create(TargetName, fmCreate) do
try
WriteBuffer(Data^, DataSize);
finally
Free;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.VST2DragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
Accept := True;
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i GeneralAbilitiesDemo.lrs}
end.

715
components/virtualtreeview-new/branches/4.8/demos/advanced/GridDemo.lfm Normal file
View File

@ -0,0 +1,715 @@
object GridForm: TGridForm
Left = 341
Height = 393
Top = 353
Width = 736
ActiveControl = VST5
Caption = 'GridForm'
ClientHeight = 393
ClientWidth = 736
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
LCLVersion = '0.9.29'
object Label15: TLabel
Left = 519
Height = 186
Top = 8
Width = 208
Anchors = [akTop, akRight]
Caption = 'This sample demonstrates the grid extensions introduced in Virtual Treeview. The main difference to normal mode is the way cell content is handled (editing, selection etc.). In Grid mode always the entire cell is used. Another point is the key handling .'
ParentColor = False
WordWrap = True
end
object Label1: TLabel
AnchorSideTop.Control = Label15
AnchorSideTop.Side = asrBottom
Left = 519
Height = 81
Top = 202
Width = 205
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
Caption = 'The main column in this sample is reduced to an indicator and is set as a fixed column.'
ParentColor = False
WordWrap = True
end
object VST5: TVirtualStringTree
Cursor = 63
Left = 8
Height = 385
Top = 6
Width = 499
Anchors = [akTop, akLeft, akRight, akBottom]
ClipboardFormats.Strings = (
'CSV'
'HTML Format'
'Plain text'
'Rich Text Format'
'Rich Text Format Without Objects'
'Unicode text'
'Virtual Tree Data'
)
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
DefaultNodeHeight = 19
DefaultText = 'Node'
DragMode = dmAutomatic
EditDelay = 300
Font.Height = -11
Font.Name = 'Microsoft Sans Serif'
Header.AutoSizeIndex = 2
Header.Background = clBtnShadow
Header.Columns = <
item
Options = [coParentBidiMode, coVisible, coFixed]
Position = 0
Width = 20
end
item
Margin = 0
Position = 1
Text = 'Customer ID'
Width = 100
end
item
Margin = 0
Position = 2
Text = 'First Name'
Width = 120
end
item
Margin = 0
Position = 3
Text = 'Last Name'
Width = 120
end
item
Margin = 0
Position = 4
Text = 'Order date'
Width = 100
end>
Header.DefaultHeight = 17
Header.Font.Height = -12
Header.Font.Name = 'Microsoft Sans Serif'
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoShowImages, hoVisible]
Header.Style = hsFlatButtons
HintMode = hmTooltip
ParentFont = False
ParentShowHint = False
RootNodeCount = 100
ScrollBarOptions.AlwaysVisible = True
ShowHint = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoTristateTracking]
TreeOptions.MiscOptions = [toEditable, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toUseBlendedImages]
TreeOptions.SelectionOptions = [toDisableDrawSelection, toExtendedFocus, toMiddleClickSelect, toMultiSelect, toRightClickSelect, toCenterScrollIntoView]
WantTabs = True
OnAfterCellPaint = VST5AfterCellPaint
OnBeforeCellPaint = VST5BeforeCellPaint
OnBeforeItemErase = VST5BeforeItemErase
OnCreateEditor = VST5CreateEditor
OnFocusChanging = VST5FocusChanging
OnGetText = VST5GetText
OnPaintText = VST5PaintText
OnInitNode = VST5InitNode
OnStateChange = VST5StateChange
end
object GridLineCheckBox: TCheckBox
Left = 520
Height = 22
Top = 361
Width = 130
Anchors = [akRight, akBottom]
Caption = 'Toggle grid lines'
Checked = True
OnClick = GridLineCheckBoxClick
State = cbChecked
TabOrder = 1
end
object TreeImages: TImageList
left = 22
top = 36
Bitmap = {
4C69120000001000000010000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFF0000
00FF000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FFFFFFFFFF000000FF0000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFF000000FF0000
00FFFFFFFFFF000000FF800000FF800000FF800000FF800000FF800000FF8000
00FF00000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8000
00FF800000FF000000000000000000000000000000FFFFFFFFFF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8000
00FFFFFFFFFF800000FF0000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FFFFFFFFFF000000FF000000FFFFFFFFFF8000
00FF800000FF800000FF800000FF00000000000000FFFFFFFFFF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF00000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FFFFFFFFFF000000FF000000FF000000FF0000
00FF000000FFFFFFFFFF800000FF00000000000000FF000000FF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FFFFFFFFFF000000FF000000FF000000FF0000
00FF000000FFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF00000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00FFFFFF00FFFFFF000000FF000000FF000000FF0000
00FF000000FF000000000000000000000000000000FF808080FF008080FF8080
80FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000FF008080FF8080
80FF008080FF000000FF0000000000000000000000FF008080FF808080FF0000
00FF000000000000000000000000000000000000000000000000000000FF0080
80FF808080FF000000FF0000000000000000000000FF808080FF008080FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF8080
80FF008080FF000000FF0000000000000000000000FF008080FF808080FF0080
80FF808080FF008080FF808080FF008080FF808080FF008080FF808080FF0080
80FF808080FF000000FF0000000000000000000000FF808080FF008080FF8080
80FF008080FF808080FF800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF000000FF0000000000000000000000FF008080FF808080FF0080
80FF808080FF008080FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF800000FF800000FF0000000000000000000000FF808080FF008080FF8080
80FF008080FF808080FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF800000FFFFFFFFFF800000FF00000000000000FF008080FF808080FF0080
80FF808080FF008080FF800000FFFFFFFFFF800000FF800000FF800000FFFFFF
FFFF800000FF800000FF800000FF00000000000000FF808080FF008080FF8080
80FF008080FF808080FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF00000000000000FF008080FF808080FF0080
80FF808080FF008080FF800000FFFFFFFFFF800000FF800000FF800000FF8000
00FF800000FFFFFFFFFF800000FF0000000000000000000000FF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FFFFFF0000000000000000808080FF00FF
FFFF0000000000000000808080FF000000FF000000FF000000FF000000000000
0000000000000000000000000000808080FF00FFFFFF00000000808080FFFFFF
FFFF00000000808080FF00FFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
000000000000000000000000000000000000808080FF00FFFFFF808080FF00FF
FFFF808080FF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFF0000
00FF0000000000000000000000000000000000FFFFFF808080FF00FFFFFFFFFF
FFFF808080FF808080FF808080FF808080FFFFFFFFFF000000FFFFFFFFFFFFFF
FFFF000000FF0000000000000000808080FF808080FF808080FFFFFFFFFF00FF
FFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF000000FF000000000000000000000000FFFFFFFF808080FFFFFF
FFFFFFFFFFFF808080FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000808080FF0000000000000000808080FF00FF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000808080FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000080FF000080FFFFFFFFFF0000
0000000000000000000000000000000000000000000000000000000000000000
80FF000080FFFFFFFFFF0000000000000000000080FF000080FF000080FF0000
80FFFFFFFFFF0000000000000000000000000000000000000000000080FF0000
80FFFFFFFFFF00000000000000000000000000000000000080FF000080FF0000
80FF000080FFFFFFFFFF000000000000000000000000000080FF000080FFFFFF
FFFF000000000000000000000000000000000000000000000000000000000000
80FF000080FF000080FFFFFFFFFF00000000000080FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000080FF000080FF000080FF000080FF000080FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000080FF000080FF000080FFFFFFFFFF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000080FF000080FF000080FF000080FF000080FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
80FF000080FF000080FFFFFFFFFF00000000000080FF000080FFFFFFFFFF0000
0000000000000000000000000000000000000000000000000000000080FF0000
80FF000080FFFFFFFFFF000000000000000000000000000080FF000080FFFFFF
FFFF0000000000000000000000000000000000000000000080FF000080FF0000
80FFFFFFFFFF0000000000000000000000000000000000000000000080FFFFFF
FFFF0000000000000000000000000000000000000000000080FF000080FF0000
80FFFFFFFFFF0000000000000000000000000000000000000000000000000000
80FFFFFFFFFF0000000000000000000000000000000000000000000080FFFFFF
FFFF000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000080FFFFFFFFFF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF0000000000000000800000FFFFFFFFFF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF0000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000
00FF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFF808080FF808080FF808080FFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFF808080FF0000000000FFFFFF00000000808080FFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FF808080FF0000000000FFFFFF0000000000FFFFFF808080FF808080FF8080
80FF808080FF808080FF00000000000000FF0000000000000000000000000000
00FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF000000FF0000000000000000000000000000
00FF808080FFFFFFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF0000
000000FFFFFF808080FF000000FF000000FF0000000000000000000000000000
00FF808080FFFFFFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FF
FFFF00000000808080FF000000FF000000FF000000FF000000FF000000FF0000
00FF808080FFFFFFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF0000
000000FFFFFF808080FF000000FF000000000000000000000000000000000000
0000808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF0000000000000000000000000000
0000000000000000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF0000000000000000000000000000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00000000000000FF000000000000
0000000000000000000000000000000000FFFFFFFFFF808080FF808080FF8080
80FF808080FF808080FFFFFFFFFF000000FF00000000000000FF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00000000000000FFFFFF00FF0000
00FF000000000000000000000000000000FFFFFFFFFF808080FF808080FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF00FFFFFF
00FF000000FF0000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFF0000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FF000000FF00000000000000FF000000FF000000FF000000FF0000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FFFFFF00FF000000FF000000000000000000000000000000000000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF00FFFFFF
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FFFFFF00FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000FF000000FF000000FF000000FF0000
00FF00000000800000FF800000FF000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000FF800000FF800000FF000000000000000000000000000000000000
0000000000FF00000000000000FF000000000000000000000000000000000000
000000000000800000FF800000FF000000FF000000FF000000FF000000FF0000
00FF00000000000000FF00000000000000FF0000000000000000000000000000
000000000000800000FF800000FF000000FFFFFFFFFFFFFFFFFF000000FF0000
0000000000FF00000000000000FF00000000000000FF00000000000000000000
0000000000FF800000FF800000FF000000FFFFFFFFFF000000FF000000000000
00FFFFFFFFFF000000FF00000000000000FF00000000000000FF000000FF0000
00FF00000000800000FF800000FF000000FFFFFFFFFFFFFFFFFF000000FFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF00000000000000FFFFFFFFFF000000FF0000
00000000000000000000800000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFF000000FF000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFF000000FF000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FF808080FF808080FF808080FF808080FF00000000000000000000
0000000000000000000000000000000000000000000000000000808080FF8080
80FFFF0000FFFF0000FFFFFFFFFF00000000008000FF000000FF000000FF0000
00000000000000000000000000000000000000000000808080FFFF0000FFFF00
00FF00000000FFFFFFFF00000000008000FF008000FF008000FF008000FF0000
00FF00000000000000000000000000000000808080FFFF0000FFFFFFFFFF0000
0000FFFFFFFF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF000000FF000000000000000000000000808080FFFF0000FFFF0000FFFFFF
FFFF00000000808080FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFF8080
80FF808080FF0000000000000000000000FFFF0000FFFF0000FF000000000080
00FF008000FF808080FFFFFFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8080
80FFFFFFFFFF808080FF00000000000000FFFF0000FFFF0000FF008000FF0080
00FF008000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFF0000
00FF000000FF000000FF000000FF000000FFFF0000FFFF0000FF008000FF0080
00FF008000FF808080FFFFFFFFFF00FFFFFF808000FF808000FF808000FF8080
80FFFFFFFFFF808080FF000000FF000000FFFF0000FFFF0000FFFF0000FF0080
00FF008000FF808080FFFFFFFFFF808000FFFFFFFFFF808080FF008000FF8000
00FFFFFFFFFF808080FF000000FF000000FFFF0000FFFF0000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFF808000FF808080FF008000FFFF0000FF8000
00FFFFFFFFFF808080FF000000FF00000000000000FFFF0000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFF808000FFFF0000FFFF0000FFFF0000FF8000
00FFFFFFFFFF808080FF000000FF00000000000000FFFF0000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFF00FFFFFF800000FF800000FF800000FF8080
80FFFFFFFFFF808080FF000000FF0000000000000000000000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF000000000000000000000000000000FF0000
00FFFF0000FF808080FFFFFFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00FF
FFFFFFFFFFFF808080FF000000FF000000000000000000000000000000000000
0000000000FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF008000FF008000FF008000FF008000FF008000FF008000FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0080
00FFFFFFFFFFFFFFFFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0080
00FFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0080
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF008000FF008000FF008000FF008000FF008000FF008000FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FF808080FF808080FF808080FF808080FF808080FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FFFFFFFFFF808080FF808080FF808080FF808080FF808080FF8080
80FF000000FF0000000000000000800000FF0000000000000000000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000800000FF800000FF00000000000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF800000FF800000FF800000FF000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF800000FF800000FF800000FF800000FF0000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FFFFFFFFFF800000FF8000
00FF800000FFFFFFFFFF000000FF800000FF800000FF800000FF000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF800000FF800000FF00000000000000000000
0000000000FF000000FF808080FFFFFFFFFF808080FFFFFFFFFF800000FF8000
00FF800000FFFFFFFFFF000000FF800000FF0000000000000000000000000000
00000000000000000000808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
00000000000000000000000000FF000000FF808080FFFFFFFFFF800000FF8000
00FF800000FFFFFFFFFF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000808080FF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFF808080FF808080FF808080FF8080
80FF808080FF808080FF0000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF0000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000808080FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFFFFFFFFF808080FF808080FF808080FF8080
80FF808080FF808080FF0000000000000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF00FFFFFF808080FF000000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF8080
80FFC0C0C0FF808080FF000000FF808080FFFFFFFFFF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFF00FFFFFF0000
00FF808080FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF000000FF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFF000000FF808080FF000000FF0000000000000000808080FFFFFFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFF00FF
FFFF808080FF000000FF000000FF0000000000000000808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF00000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFF000000FF000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF000000FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF00000000000000000000
000000000000FF0000FF800000FF00000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFF000000FF000000000000
0000FF0000FF808000FF800000FF00000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF000000FF000000FFFF00
00FF808000FF800000FF0000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0C0FFC0C0C0FFFF0000FF8080
00FF800000FF000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFFF0000FF808000FF8000
00FF00000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF808080FF00FFFFFF800000FFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFC0C0C0FF808080FFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF808080FFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF00000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000
0000000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000
00FF000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFF
FFFF000000FF0000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000
00FF000000FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0
C0FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0
C0FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFC0C0C0FF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000000000FF000000FF808080FFC0C0C0FF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF000000000000000000000000000000FF000000FF8080
80FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF00000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000
000000000000FF0000FF800000FF808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000
00FFFF0000FF808000FF800000FF808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFF00
00FF808000FF800000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF8080
00FF800000FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF8000
00FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FFC0C0
C0FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFF808080FF00FFFFFF800000FFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFC0C0C0FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFC0C0C0FF808080FFFFFFFFFF8080
80FFFFFFFFFF000000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000000000FF000000FF808080FFC0C0C0FF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF000000000000000000000000000000FF000000FF8080
80FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF0000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
end
end

235
components/virtualtreeview-new/branches/4.8/demos/advanced/GridDemo.pas Normal file
View File

@ -0,0 +1,235 @@
unit GridDemo;
{$MODE Delphi}
// Virtual Treeview sample form demonstrating following features:
// - TVirtualStringTree with enabled grid extensions and a fixed column.
// - Owner draw column to simulate a fixed column.
// - Extend focus, multiselection without selection rectangle.
// - Various editors, specific to each column.
// Written by Mike Lischke.
interface
uses
delphicompat, LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, LResources, LCLType, variants;
type
{ TGridForm }
TGridForm = class(TForm)
VST5: TVirtualStringTree;
GridLineCheckBox: TCheckBox;
Label15: TLabel;
TreeImages: TImageList;
Label1: TLabel;
procedure VST5BeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
procedure VST5BeforeItemErase(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
var Color: TColor; var EraseAction: TItemEraseAction);
procedure VST5CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure VST5FocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn,
NewColumn: TColumnIndex; var Allowed: Boolean);
procedure VST5GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VST5InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure VST5PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
procedure GridLineCheckBoxClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure VST5AfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellRect: TRect);
procedure VST5StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
end;
var
GridForm: TGridForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
Editors, States;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.FormCreate(Sender: TObject);
begin
VST5.NodeDataSize := SizeOf(TGridData);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5BeforeItemErase(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
ItemRect: TRect; var Color: TColor; var EraseAction: TItemEraseAction);
// Some nodes get a different background color.
begin
with Canvas do
begin
if Node.Index mod 6 = 0 then
Color := $49DDEF // $70A33F // $436BFF
else
Color := VST5.Color;
EraseAction := eaColor;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5FocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn,
NewColumn: TColumnIndex; var Allowed: Boolean);
begin
// Do not allow focusing the indicator column (which is a fixed column).
Allowed := NewColumn > 0;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
Data: PGridData;
D: TDateTime;
begin
Data := Sender.GetNodeData(Node);
// These are the editor kinds used in the grid tree.
Data.ValueType[0] := vtNumber;
Data.ValueType[1] := vtPickString;
Data.ValueType[2] := vtPickString;
Data.ValueType[3] := vtDate;
// fill some default values
Data.Value[0] := Variant(Node.Index);
Data.Value[1] := 'John';
Data.Value[2] := 'Doe';
// A date value slightly randomized around today. Need the way
// using a local variable to tell the compiler we are not
// using a float as variant, but a TDateTime.
D := Date + Random(14) - 7;
Data.Value[3] := D;
if Sender.FocusedColumn < 1 then
Sender.FocusedColumn := 1;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
var
Data: PGridData;
begin
if Column > 0 then
begin
Data := Sender.GetNodeData(Node);
CellText := String(Data.Value[Column - 1]);
end
else
CellText := '';
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
var
Data: PGridData;
begin
Data := Sender.GetNodeData(Node);
if Data.Changed then
TargetCanvas.Font.Style := [fsBold];
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5BeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
begin
// Fill random cells with our own background, but don't touch the currently focused cell.
if ((Column <> Sender.FocusedColumn) or (Node <> Sender.FocusedNode)) and
((Column - 2) = (Integer(Node.Index) mod (VST5.Header.Columns.Count - 1))) then
begin
TargetCanvas.Brush.Color := $E0E0E0;
TargetCanvas.FillRect(CellRect);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
out EditLink: IVTEditLink);
// This is the callback of the tree control to ask for an application defined edit link. Providing one here allows
// us to control the editing process up to which actual control will be created.
// TGridEditLink implements an interface and hence benefits from reference counting. We don't need to keep a reference
// to free it. As soon as the tree finished editing the class will be destroyed automatically.
begin
EditLink := TGridEditLink.Create;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.GridLineCheckBoxClick(Sender: TObject);
begin
if GridLineCheckBox.Checked then
VST5.TreeOptions.PaintOptions := VST5.TreeOptions.PaintOptions + [toShowHorzGridLines, toShowVertGridLines]
else
VST5.TreeOptions.PaintOptions := VST5.TreeOptions.PaintOptions - [toShowHorzGridLines, toShowVertGridLines];
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5AfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; CellRect: TRect);
begin
if Column = 0 then
with TargetCanvas do
begin
// Decorate the fixed indicator column by filling it with an edge similar to that of TCustomGrid.
if toShowVertGridLines in VST5.TreeOptions.PaintOptions then
Inc(CellRect.Right);
if toShowHorzGridLines in VST5.TreeOptions.PaintOptions then
Inc(CellRect.Bottom);
DrawEdge(Handle, CellRect, BDR_RAISEDINNER, BF_RECT or BF_MIDDLE);
if Node = Sender.FocusedNode then
TreeImages.Draw(TargetCanvas, CellRect.Left + 4, CellRect.Top, 17);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGridForm.VST5StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i GridDemo.lrs}
end.

3170
components/virtualtreeview-new/branches/4.8/demos/advanced/HeaderCustomDrawDemo.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

312
components/virtualtreeview-new/branches/4.8/demos/advanced/HeaderCustomDrawDemo.pas Normal file
View File

@ -0,0 +1,312 @@
unit HeaderCustomDrawDemo;
{$MODE Delphi}
{$H+}
// Virtual Treeview sample form demonstrating following features:
// - Advanced header custom draw.
// Written by Mike Lischke.
interface
uses
LCLIntf, VTGraphics, Types, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, StdCtrls, ExtCtrls, LResources, LCLType, LCLProc;
type
THeaderOwnerDrawForm = class(TForm)
Label8: TLabel;
HeaderCustomDrawTree: TVirtualStringTree;
HeaderImages: TImageList;
AnimationTimer: TTimer;
procedure HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo;
var Elements: THeaderPaintElements);
procedure HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo;
const Elements: THeaderPaintElements);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure AnimationTimerTimer(Sender: TObject);
procedure HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
procedure HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
private
FBackBitmap1,
FBackBitmap2,
FCheckerBackground: TBitmap;
FHeaderBitmap: TBitmap;
FLeftPos: Integer;
procedure CreateCheckerBackground;
procedure PaintSelection(Bitmap: TBitmap);
procedure FillBackground(R: TRect; Target: TCanvas);
end;
var
HeaderOwnerDrawForm: THeaderOwnerDrawForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
States, LclExt;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader;
var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements);
// This event tells the tree which part we want to draw ourselves. Don't forget to enable custom drawing in the header
// options and switch the Style property of every column, which we handle here to vsOwnerDraw.
begin
with PaintInfo do
begin
// First check the column member. If it is NoColumn then it's about the header background.
if Column = nil then
Elements := [hpeBackground] // No other flag is recognized for the header background.
else
begin
// Using the index here ensures a column, regardless of its position, always has the same draw style.
// By using the Position member, we could make a certain column place stand out, regardless of the column order.
// Don't forget to change the AdvancedHeaderDraw event body accordingly after you changed the indicator here.
case Column.Index of
0: // Default drawing.
;
1: // Background only customization.
Include(Elements, hpeBackground);
2: // Full customization (well, quite).
Elements := [hpeBackground, hpeText{, hpeDropMark, hpeHeaderGlyph, hpeSortGlyph}];
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo;
const Elements: THeaderPaintElements);
var
S: string;
Size: TSize;
SourceRect,
TargetRect: TRect;
begin
with PaintInfo do
begin
// First check the column member. If it is NoColumn then it's about the header background.
if Column = nil then
begin
if hpeBackground in Elements then
begin
TargetCanvas.Brush.Color := clBackground;
TargetCanvas.FillRect(PaintRectangle);
end;
end
else
begin
case Column.Index of
0: // Will never come here.
;
1: // Background only customization.
begin
FBackBitmap1.Width := PaintRectangle.Right - PaintRectangle.Left;
FBackBitmap1.Height := PaintRectangle.Bottom - PaintRectangle.Top;
FillBackground(PaintRectangle, FBackbitmap1.Canvas);
if IsHoverIndex and MMXAvailable then
PaintSelection(FBackBitmap1);
TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap1);
end;
2: // Full customization. Check elements to learn what must be drawn in the various stages.
begin
if hpeBackground in Elements then
with FBackBitmap2 do
begin
Width := PaintRectangle.Right - PaintRectangle.Left;
Height := PaintRectangle.Bottom - PaintRectangle.Top;
TargetRect := Rect(0, 0, Width, Height);
Canvas.Brush.Color := $E1FFFF;
Canvas.FillRect(TargetRect);
InflateRect(TargetRect, - 10, -10);
SourceRect := TargetRect;
OffsetRect(SourceRect, -SourceRect.Left + FLeftPos, -SourceRect.Top);
Canvas.CopyRect(TargetRect, FHeaderBitmap.Canvas, SourceRect);
TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap2);
end;
if hpeText in Elements then
begin
TargetCanvas.Font.Name := 'Webdings';
TargetCanvas.Font.Charset := SYMBOL_CHARSET;
TargetCanvas.Font.Size := 60;
if IsHoverIndex then
TargetCanvas.Font.Color := $80FF;
S := 'û';
Size := TargetCanvas.TextExtent(S);
SetBkMode(TargetCanvas.Handle, TRANSPARENT);
TargetCanvas.TextOut(PaintRectangle.Left + 10, Paintrectangle.Bottom - Size.cy, S);
end;
// Other elements go here.
end;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.CreateCheckerBackground;
begin
FCheckerBackground := TBitmap.Create;
with FCheckerBackground do
begin
Width := 16;
Height := 16;
Canvas.Brush.Color := clBtnShadow;
Canvas.FillRect(Rect(0, 0, Width, Height));
Canvas.Brush.Color := clBtnHighlight;
Canvas.FillRect(Rect(0, 0, 8, 8));
Canvas.FillRect(Rect(8, 8, 16, 16));
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.PaintSelection(Bitmap: TBitmap);
const
Alpha = 75;
var
R: TRect;
begin
R := Rect(0, 0, Bitmap.Width, Bitmap.Height);
VTGraphics.AlphaBlend(0, Bitmap.Canvas.Handle, R, Point(0, 0), bmConstantAlphaAndColor, Alpha,
ColorToRGB(clHighlight));
with Bitmap do
begin
Canvas.Pen.Color := clHighlight;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(0, 0, Width, Height);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.FillBackground(R: TRect; Target: TCanvas);
// Tiles the background image over the given target bitmap.
var
X, Y: Integer;
dX, dY: Integer;
begin
with Target do
begin
dX := FCheckerBackground.Width;
dY := FCheckerBackground.Height;
Y := 0;
while Y < R.Bottom - R.Top do
begin
X := 0;
while X < R.Right - R.Left do
begin
Draw(X, Y, FCheckerBackground);
Inc(X, dX);
end;
Inc(Y, dY);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.FormCreate(Sender: TObject);
begin
FBackBitmap1 := TBitmap.Create;
FBackBitmap1.PixelFormat := OptimalPixelFormat;
FBackBitmap2 := TBitmap.Create;
//FBackBitmap2.PixelFormat := OptimalPixelFormat;
CreateCheckerBackground;
FHeaderBitmap := TBitmap.Create;
FHeaderBitmap.LoadFromLazarusResource('Transcriptions');
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.FormDestroy(Sender: TObject);
begin
FCheckerBackground.Free;
FBackBitmap1.Free;
FBackBitmap2.Free;
FHeaderBitmap.Free;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.AnimationTimerTimer(Sender: TObject);
begin
FLeftPos := (FLeftPos + FHeaderBitmap.Width div 2000) mod FHeaderBitmap.Width;
with HeaderCustomDrawTree.Header do
Invalidate(Columns[2]);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Reenable animation after a drag operation.
AnimationTimer.Enabled := True;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Stop animation when mouse button is down.
AnimationTimer.Enabled := False;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
begin
CellText := 'Some simple text.';
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i HeaderCustomDrawDemo.lrs}
{$i bitmap.lrs}
end.

1990
components/virtualtreeview-new/branches/4.8/demos/advanced/Main.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

180
components/virtualtreeview-new/branches/4.8/demos/advanced/Main.pas Normal file
View File

@ -0,0 +1,180 @@
unit Main;
{$MODE Delphi}
// Advanced demo for Virtual Treeview showing various effects and features in several forms.
// This is the main form which serves as container window for the demo forms.
// Written by Mike Lischke.
interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Buttons, ExtCtrls, StdCtrls, ActnList, LResources;
type
TMainForm = class(TForm)
PageScroller1: TPanel;
SpeedDemoButton: TSpeedButton;
AbilitiesDemoButton: TSpeedButton;
PropertiesDemoButton: TSpeedButton;
VisibilityDemoButton: TSpeedButton;
GridDemoButton: TSpeedButton;
AlignDemoButton: TSpeedButton;
QuitButton: TSpeedButton;
PaintTreeDemoButton: TSpeedButton;
MainPanel: TPanel;
StatusBar: TStatusBar;
ContainerPanel: TPanel;
Label1: TLabel;
Label2: TLabel;
XPDemoButton: TSpeedButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
procedure QuitButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DemoButtonClick(Sender: TObject);
procedure FormShow(Sender: TObject);
end;
var
MainForm: TMainForm;
procedure LoadUnicodeStrings(const Name: string; var Strings: array of String);
procedure SetStatusbarText(const S: string);
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
SpeedDemo, GeneralAbilitiesDemo, DrawTreeDemo, PropertiesDemo,
GridDemo, VisibilityDemo, AlignDemo, WindowsXPStyleDemo, MultilineDemo, HeaderCustomDrawDemo,
States;
//----------------------------------------------------------------------------------------------------------------------
procedure LoadUnicodeStrings(const Name: string; var Strings: array of String);
// Loads the Unicode strings from the resource.
var
Res: TLResource;
Head, Tail: PChar;
I: Integer;
begin
Res := LazarusResources.Find(Name);
if (Res <> nil) and (Res.Value <> '') then
begin
Head := PChar(Res.Value);
Tail := Head;
for I := 0 to High(Strings) do
begin
Head := Tail;
while not (Tail^ in [#0, #13]) do
Inc(Tail);
SetString(Strings[I], Head, Tail - Head);
// Skip carriage return and linefeed.
Inc(Tail, 2);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure SetStatusbarText(const S: string);
begin
MainForm.StatusBar.SimpleText := S;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.QuitButtonClick(Sender: TObject);
begin
Close;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.FormCreate(Sender: TObject);
begin
// Show hints 10 seconds.
Application.HintHidePause := 10000;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.DemoButtonClick(Sender: TObject);
// This method is a kind of scheduler. Here we switch between the demo forms.
var
NewDemoClass: TFormClass;
NewDemo: TForm;
begin
case (Sender as TSpeedButton).Tag of
0:
NewDemoClass := TSpeedForm;
1:
NewDemoClass := TGeneralForm;
2:
NewDemoClass := TPropertiesForm;
3:
NewDemoClass := TVisibilityForm;
5:
NewDemoClass := TGridForm;
6:
NewDemoClass := TDrawTreeForm;
7:
NewDemoClass := TAlignForm;
8:
NewDemoClass := TWindowsXPForm;
9:
NewDemoClass := TNodeForm;
10:
NewDemoClass := THeaderOwnerDrawForm;
else
NewDemoClass := nil;
end;
if (ContainerPanel.ControlCount = 0) or not (ContainerPanel.Controls[0] is NewDemoClass) then
begin
if ContainerPanel.ControlCount > 0 then
ContainerPanel.Controls[0].Free;
if Assigned(NewDemoClass) then
begin
NewDemo := NewDemoClass.Create(Self);
NewDemo.Hide;
NewDemo.BorderStyle := bsNone;
NewDemo.Parent := ContainerPanel;
NewDemo.Align := alClient;
NewDemo.Show;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.FormShow(Sender: TObject);
begin
StateForm.Show;
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i Main.lrs}
{$i unicode.lrs}
end.

99
components/virtualtreeview-new/branches/4.8/demos/advanced/MultilineDemo.lfm Normal file
View File

@ -0,0 +1,99 @@
object NodeForm: TNodeForm
Left = 497
Height = 542
Top = 332
Width = 773
ActiveControl = Panel1
Caption = 'NodeForm'
ClientHeight = 542
ClientWidth = 773
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
LCLVersion = '0.9.29'
object Label8: TLabel
Left = 12
Height = 102
Top = 424
Width = 732
Anchors = [akLeft, akRight, akBottom]
Caption = 'Since Virtual Treeview uses Unicode for text display it is not easy to provide multiline support on Windows 9x/Me systems. Under Windows NT (4.0, 2000, XP) there is support by the operation system and so full word breaking is possible there. Otherwise you have to insert line breaks manually to have multiline captions. Of course there is no difference in handling between multiline and single line nodes (except for the vertical alignment of the latter).'
ParentColor = False
ShowAccelChar = False
WordWrap = True
end
object Panel1: TPanel
Left = 12
Height = 393
Top = 4
Width = 732
Anchors = [akTop, akLeft, akRight, akBottom]
ClientHeight = 393
ClientWidth = 732
Color = clAppWorkspace
ParentColor = False
TabOrder = 0
object MLTree: TVirtualStringTree
Left = 96
Height = 373
Top = 8
Width = 549
Anchors = [akTop, akLeft, akRight, akBottom]
ClipboardFormats.Strings = (
'CSV'
'HTML Format'
'Plain text'
'Rich Text Format'
'Rich Text Format Without Objects'
'Unicode text'
'Virtual Tree Data'
)
Colors.SelectionRectangleBlendColor = 10539203
DefaultNodeHeight = 130
DefaultText = 'Node'
Header.AutoSizeIndex = 0
Header.Columns = <
item
Position = 1
Width = 495
end
item
Position = 0
end>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Options = [hoAutoResize, hoColumnResize, hoDrag]
HintMode = hmTooltip
LineMode = lmBands
NodeAlignment = naFromTop
NodeDataSize = 4
ParentShowHint = False
RootNodeCount = 30
SelectionCurveRadius = 10
ShowHint = True
TabOrder = 0
TextMargin = 5
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoSpanColumns, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toEditable, toInitOnSave, toReportMode, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toHideFocusRect, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toMultiSelect]
OnEditing = MLTreeEditing
OnGetText = MLTreeGetText
OnPaintText = MLTreePaintText
OnInitNode = MLTreeInitNode
OnMeasureItem = MLTreeMeasureItem
OnStateChange = MLTreeStateChange
end
end
object AutoAdjustCheckBox: TCheckBox
Left = 12
Height = 22
Top = 399
Width = 327
Anchors = [akLeft, akBottom]
Caption = 'Automatically adjust node height to node text.'
OnClick = AutoAdjustCheckBoxClick
TabOrder = 1
end
end

159
components/virtualtreeview-new/branches/4.8/demos/advanced/MultilineDemo.pas Normal file
View File

@ -0,0 +1,159 @@
unit MultilineDemo;
{$MODE Delphi}
{$H+}
// Virtual Treeview sample form demonstrating following features:
// - Multiline node captions.
// Written by Mike Lischke.
interface
uses
LCLIntf, SysUtils, Classes, Forms, Controls, Graphics, VirtualTrees,
ExtCtrls, StdCtrls, LResources;
type
TNodeForm = class(TForm)
Panel1: TPanel;
MLTree: TVirtualStringTree;
Label8: TLabel;
AutoAdjustCheckBox: TCheckBox;
procedure MLTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure FormCreate(Sender: TObject);
procedure MLTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
procedure MLTreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
procedure MLTreeEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure MLTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
procedure MLTreeMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
var NodeHeight: Integer);
procedure AutoAdjustCheckBoxClick(Sender: TObject);
end;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
Main, States;
var
DemoText: array[0..29] of String;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.MLTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
begin
Node.Align := 20; // Alignment of expand/collapse button nearly at the top of the node.
if (Node.Index mod 3) = 0 then
begin
MLTree.NodeHeight[Node] := 40;
end
else
begin
MLTree.NodeHeight[Node] := 120;
Include(InitialStates, ivsMultiline);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.FormCreate(Sender: TObject);
begin
LoadUnicodeStrings('Lorem ipsum', DemoText);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.MLTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
// Returns the text for the given node. This text was loaded at form creation time from the application resource.
begin
// The display is organized so that for every two main text nodes a node with empty main text is used. This
// node however gets text in its second column (with column spanning enabled).
// This creates the visual effect of a chapter heading and two indented paragraphs.
// Another possibility to get this effect is to use child nodes and only one column.
// Note: the main column is in the second position!
case Column of
0: // Main column.
if (Node.Index mod 3) = 0 then
CellText := ''
else
CellText := DemoText[Node.Index mod 30];
1:
if (Node.Index mod 3) = 0 then
CellText := DemoText[Node.Index mod 30]
else
CellText := '';
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.MLTreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
begin
if (Node.Index mod 3) = 0 then
begin
TargetCanvas.Font.Size := 12;
TargetCanvas.Font.Style := [fsBold];
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.MLTreeEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var Allowed: Boolean);
begin
Allowed := (Node.Index mod 3) <> 0;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.MLTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.MLTreeMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
var NodeHeight: Integer);
begin
if Sender.MultiLine[Node] and AutoAdjustCheckBox.Checked then
begin
TargetCanvas.Font := Sender.Font;
NodeHeight := MLTree.ComputeNodeHeight(TargetCanvas, Node, 0);
end;
// ...else use what's set by default.
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.AutoAdjustCheckBoxClick(Sender: TObject);
begin
MLTree.ReinitNode(nil, True);
MLTree.Invalidate;
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i MultilineDemo.lrs}
end.

701
components/virtualtreeview-new/branches/4.8/demos/advanced/PropertiesDemo.lfm Normal file
View File

@ -0,0 +1,701 @@
object PropertiesForm: TPropertiesForm
Left = 397
Height = 389
Top = 294
Width = 637
ActiveControl = VST3
Caption = 'PropertiesForm'
ClientHeight = 389
ClientWidth = 637
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
LCLVersion = '0.9.29'
object Label9: TLabel
Left = 420
Height = 81
Top = 6
Width = 212
Anchors = [akTop, akRight]
Caption = 'This tree demonstrates a typical property page as it can be found in the property dialog for Word and other documents.'
ParentColor = False
WordWrap = True
end
object Label10: TLabel
AnchorSideTop.Control = Label9
AnchorSideTop.Side = asrBottom
Left = 420
Height = 81
Top = 97
Width = 212
Anchors = [akTop, akRight]
BorderSpacing.Top = 10
Caption = 'What makes this demonstration special is the sample implementation for node editors.'
ParentColor = False
WordWrap = True
end
object VST3: TVirtualStringTree
Left = 10
Height = 380
Top = 6
Width = 399
Anchors = [akTop, akLeft, akRight, akBottom]
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
DefaultNodeHeight = 20
DefaultText = 'Node'
Header.AutoSizeIndex = 1
Header.Columns = <
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAutoSpring]
Position = 0
Text = 'Properties'
Width = 203
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAutoSpring]
Position = 1
Text = 'Values'
Width = 194
end>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 18
Header.Options = [hoAutoResize, hoColumnResize, hoVisible, hoAutoSpring]
HintMode = hmHint
Images = TreeImages
IncrementalSearch = isAll
IncrementalSearchTimeout = 500
Indent = 19
ParentShowHint = False
RootNodeCount = 2
ShowHint = True
TabOrder = 0
TreeOptions.AnimationOptions = [toAnimatedToggle]
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toEditable, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect, toCenterScrollIntoView]
TreeOptions.StringOptions = [toAutoAcceptEditChange]
OnChange = VST3Change
OnCreateEditor = VST3CreateEditor
OnEditing = VST3Editing
OnGetText = VST3GetText
OnPaintText = VST3PaintText
OnGetImageIndex = VST3GetImageIndex
OnGetHint = VST3GetHint
OnIncrementalSearch = VST3IncrementalSearch
OnInitChildren = VST3InitChildren
OnInitNode = VST3InitNode
OnStateChange = VST3StateChange
end
object RadioGroup1: TRadioGroup
Left = 416
Height = 69
Top = 317
Width = 216
Anchors = [akRight, akBottom]
AutoFill = True
Caption = ' Incremental search direction: '
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 50
ClientWidth = 212
ItemIndex = 0
Items.Strings = (
'Forward'
'Backward'
)
OnClick = RadioGroup1Click
TabOrder = 1
end
object TreeImages: TImageList
left = 422
top = 224
Bitmap = {
4C69120000001000000010000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000080FF000080FFFFFFFFFF0000
0000000000000000000000000000000000000000000000000000000000000000
80FF000080FFFFFFFFFF0000000000000000000080FF000080FF000080FF0000
80FFFFFFFFFF0000000000000000000000000000000000000000000080FF0000
80FFFFFFFFFF00000000000000000000000000000000000080FF000080FF0000
80FF000080FFFFFFFFFF000000000000000000000000000080FF000080FFFFFF
FFFF000000000000000000000000000000000000000000000000000000000000
80FF000080FF000080FFFFFFFFFF00000000000080FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000080FF000080FF000080FF000080FF000080FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000080FF000080FF000080FFFFFFFFFF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000080FF000080FF000080FF000080FF000080FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
80FF000080FF000080FFFFFFFFFF00000000000080FF000080FFFFFFFFFF0000
0000000000000000000000000000000000000000000000000000000080FF0000
80FF000080FFFFFFFFFF000000000000000000000000000080FF000080FFFFFF
FFFF0000000000000000000000000000000000000000000080FF000080FF0000
80FFFFFFFFFF0000000000000000000000000000000000000000000080FFFFFF
FFFF0000000000000000000000000000000000000000000080FF000080FF0000
80FFFFFFFFFF0000000000000000000000000000000000000000000000000000
80FFFFFFFFFF0000000000000000000000000000000000000000000080FFFFFF
FFFF000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000080FFFFFFFFFF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFF0000
00FF000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FFFFFFFFFF000000FF0000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFF000000FF0000
00FFFFFFFFFF000000FF800000FF800000FF800000FF800000FF800000FF8000
00FF00000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8000
00FF800000FF000000000000000000000000000000FFFFFFFFFF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8000
00FFFFFFFFFF800000FF0000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FFFFFFFFFF000000FF000000FFFFFFFFFF8000
00FF800000FF800000FF800000FF00000000000000FFFFFFFFFF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF00000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FFFFFFFFFF000000FF000000FF000000FF0000
00FF000000FFFFFFFFFF800000FF00000000000000FF000000FF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FFFFFFFFFF000000FF000000FF000000FF0000
00FF000000FFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF00000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00FFFFFF00FFFFFF000000FF000000FF000000FF0000
00FF000000FF000000000000000000000000000000FF808080FF008080FF8080
80FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000FF008080FF8080
80FF008080FF000000FF0000000000000000000000FF008080FF808080FF0000
00FF000000000000000000000000000000000000000000000000000000FF0080
80FF808080FF000000FF0000000000000000000000FF808080FF008080FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF8080
80FF008080FF000000FF0000000000000000000000FF008080FF808080FF0080
80FF808080FF008080FF808080FF008080FF808080FF008080FF808080FF0080
80FF808080FF000000FF0000000000000000000000FF808080FF008080FF8080
80FF008080FF808080FF800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF000000FF0000000000000000000000FF008080FF808080FF0080
80FF808080FF008080FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF800000FF800000FF0000000000000000000000FF808080FF008080FF8080
80FF008080FF808080FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF800000FFFFFFFFFF800000FF00000000000000FF008080FF808080FF0080
80FF808080FF008080FF800000FFFFFFFFFF800000FF800000FF800000FFFFFF
FFFF800000FF800000FF800000FF00000000000000FF808080FF008080FF8080
80FF008080FF808080FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF00000000000000FF008080FF808080FF0080
80FF808080FF008080FF800000FFFFFFFFFF800000FF800000FF800000FF8000
00FF800000FFFFFFFFFF800000FF0000000000000000000000FF000000FF0000
00FF000000FF000000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF800000FF000000000000000000000000000000000000
00000000000000000000800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FFFFFF0000000000000000808080FF00FF
FFFF0000000000000000808080FF000000FF000000FF000000FF000000000000
0000000000000000000000000000808080FF00FFFFFF00000000808080FFFFFF
FFFF00000000808080FF00FFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
000000000000000000000000000000000000808080FF00FFFFFF808080FF00FF
FFFF808080FF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFF0000
00FF0000000000000000000000000000000000FFFFFF808080FF00FFFFFFFFFF
FFFF808080FF808080FF808080FF808080FFFFFFFFFF000000FFFFFFFFFFFFFF
FFFF000000FF0000000000000000808080FF808080FF808080FFFFFFFFFF00FF
FFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF000000FF000000000000000000000000FFFFFFFF808080FFFFFF
FFFFFFFFFFFF808080FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000808080FF0000000000000000808080FF00FF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000808080FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF0000000000000000800000FFFFFFFFFF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000
00FF800000FF0000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000
00FF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFF808080FF808080FF808080FFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFF808080FF0000000000FFFFFF00000000808080FFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FF808080FF0000000000FFFFFF0000000000FFFFFF808080FF808080FF8080
80FF808080FF808080FF00000000000000FF0000000000000000000000000000
00FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF000000FF0000000000000000000000000000
00FF808080FFFFFFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF0000
000000FFFFFF808080FF000000FF000000FF0000000000000000000000000000
00FF808080FFFFFFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FF
FFFF00000000808080FF000000FF000000FF000000FF000000FF000000FF0000
00FF808080FFFFFFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF0000
000000FFFFFF808080FF000000FF000000000000000000000000000000000000
0000808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF0000000000000000000000000000
0000000000000000000000000000800000FF800000FF800000FF800000FF8000
00FF800000FF800000FF800000FF800000FF0000000000000000000000000000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00000000000000FF000000000000
0000000000000000000000000000000000FFFFFFFFFF808080FF808080FF8080
80FF808080FF808080FFFFFFFFFF000000FF00000000000000FF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00000000000000FFFFFF00FF0000
00FF000000000000000000000000000000FFFFFFFFFF808080FF808080FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF00FFFFFF
00FF000000FF0000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFF0000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FF000000FF00000000000000FF000000FF000000FF000000FF0000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FFFFFF00FF000000FF000000000000000000000000000000000000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF00FFFFFF
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FFFFFF00FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000FF000000FF000000FF000000FF0000
00FF00000000800000FF800000FF000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000FF800000FF800000FF000000000000000000000000000000000000
0000000000FF00000000000000FF000000000000000000000000000000000000
000000000000800000FF800000FF000000FF000000FF000000FF000000FF0000
00FF00000000000000FF00000000000000FF0000000000000000000000000000
000000000000800000FF800000FF000000FFFFFFFFFFFFFFFFFF000000FF0000
0000000000FF00000000000000FF00000000000000FF00000000000000000000
0000000000FF800000FF800000FF000000FFFFFFFFFF000000FF000000000000
00FFFFFFFFFF000000FF00000000000000FF00000000000000FF000000FF0000
00FF00000000800000FF800000FF000000FFFFFFFFFFFFFFFFFF000000FFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF00000000000000FFFFFFFFFF000000FF0000
00000000000000000000800000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFF000000FF000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFF000000FF000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FF808080FF808080FF808080FF808080FF00000000000000000000
0000000000000000000000000000000000000000000000000000808080FF8080
80FFFF0000FFFF0000FFFFFFFFFF00000000008000FF000000FF000000FF0000
00000000000000000000000000000000000000000000808080FFFF0000FFFF00
00FF00000000FFFFFFFF00000000008000FF008000FF008000FF008000FF0000
00FF00000000000000000000000000000000808080FFFF0000FFFFFFFFFF0000
0000FFFFFFFF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF000000FF000000000000000000000000808080FFFF0000FFFF0000FFFFFF
FFFF00000000808080FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFF8080
80FF808080FF0000000000000000000000FFFF0000FFFF0000FF000000000080
00FF008000FF808080FFFFFFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8080
80FFFFFFFFFF808080FF00000000000000FFFF0000FFFF0000FF008000FF0080
00FF008000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFF0000
00FF000000FF000000FF000000FF000000FFFF0000FFFF0000FF008000FF0080
00FF008000FF808080FFFFFFFFFF00FFFFFF808000FF808000FF808000FF8080
80FFFFFFFFFF808080FF000000FF000000FFFF0000FFFF0000FFFF0000FF0080
00FF008000FF808080FFFFFFFFFF808000FFFFFFFFFF808080FF008000FF8000
00FFFFFFFFFF808080FF000000FF000000FFFF0000FFFF0000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFF808000FF808080FF008000FFFF0000FF8000
00FFFFFFFFFF808080FF000000FF00000000000000FFFF0000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFF808000FFFF0000FFFF0000FFFF0000FF8000
00FFFFFFFFFF808080FF000000FF00000000000000FFFF0000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFF00FFFFFF800000FF800000FF800000FF8080
80FFFFFFFFFF808080FF000000FF0000000000000000000000FFFF0000FFFF00
00FFFF0000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF000000000000000000000000000000FF0000
00FFFF0000FF808080FFFFFFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00FF
FFFFFFFFFFFF808080FF000000FF000000000000000000000000000000000000
0000000000FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF008000FF008000FF008000FF008000FF008000FF008000FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0080
00FFFFFFFFFFFFFFFFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0080
00FFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0080
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFFFFFF008000FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF008000FF008000FF008000FF008000FF008000FF008000FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF008000FF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF008000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FF808080FF808080FF808080FF808080FF808080FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000808080FFFFFFFFFF808080FF808080FF808080FF808080FF808080FF8080
80FF000000FF0000000000000000800000FF0000000000000000000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000800000FF800000FF00000000000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF800000FF800000FF800000FF000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF800000FF800000FF800000FF800000FF0000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FFFFFFFFFF800000FF8000
00FF800000FFFFFFFFFF000000FF800000FF800000FF800000FF000000000000
0000808080FFFFFFFFFF808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF800000FF800000FF00000000000000000000
0000000000FF000000FF808080FFFFFFFFFF808080FFFFFFFFFF800000FF8000
00FF800000FFFFFFFFFF000000FF800000FF0000000000000000000000000000
00000000000000000000808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
00000000000000000000000000FF000000FF808080FFFFFFFFFF800000FF8000
00FF800000FFFFFFFFFF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000808080FF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFF808080FF808080FF808080FF8080
80FF808080FF808080FF0000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF00000000808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF0000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000808080FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFFFFFFFFF808080FF808080FF808080FF8080
80FF808080FF808080FF0000000000000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF00FFFFFF808080FF000000FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF00FFFFFF808080FF000000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF8080
80FFC0C0C0FF808080FF000000FF808080FFFFFFFFFF00FFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFF00FFFFFF0000
00FF808080FF808080FF000000FF00000000808080FFFFFFFFFF00FFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0
C0FF000000FF808080FF000000FF00000000808080FFFFFFFFFFC0C0C0FF00FF
FFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FF
FFFF000000FF808080FF000000FF0000000000000000808080FFFFFFFFFFC0C0
C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFFC0C0C0FF00FFFFFF00FF
FFFF808080FF000000FF000000FF0000000000000000808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF000000FF000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF00000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFF000000FF000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF000000FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF0000000000000000000000000000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF00000000000000000000
000000000000FF0000FF800000FF00000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFF000000FF000000000000
0000FF0000FF808000FF800000FF00000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF000000FF000000FF000000FFFF00
00FF808000FF800000FF0000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0C0FFC0C0C0FFFF0000FF8080
00FF800000FF000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFFF0000FF808000FF8000
00FF00000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF808080FF00FFFFFF800000FFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFC0C0C0FF808080FFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF808080FFFFFFFFFFFFFFFFFFC0C0C0FF000000FF0000
000000000000000000000000000000000000808080FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FF000000FF0000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF00000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000
0000000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000
00FF000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFF
FFFF000000FF0000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000
00FF000000FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0FFC0C0
C0FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0
C0FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFC0C0C0FF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000000000FF000000FF808080FFC0C0C0FF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF000000000000000000000000000000FF000000FF8080
80FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000808080FF808080FF808080FF808080FF8080
80FF808080FF808080FF808080FF000000000000000000000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FF808080FF8080
80FF808080FF808080FF808080FF808080FF808080FF00000000000000000000
0000000000000000000000000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000
000000000000FF0000FF800000FF808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FF0000
00FFFF0000FF808000FF800000FF808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFF00
00FF808000FF800000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF8080
00FF800000FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF8000
00FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FFC0C0
C0FFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF808000FF800000FFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFF808080FF00FFFFFF800000FFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFFFFFFFFF808080FFFFFFFFFF8080
80FFFFFFFFFFFFFFFFFFC0C0C0FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000808080FFC0C0C0FF808080FFFFFFFFFF8080
80FFFFFFFFFF000000FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF00000000000000FF000000FF808080FFC0C0C0FF8080
80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC0C0C0FF000000FF000000000000000000000000000000FF000000FF8080
80FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0C0FFC0C0
C0FFC0C0C0FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF0000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
end
end

320
components/virtualtreeview-new/branches/4.8/demos/advanced/PropertiesDemo.pas Normal file
View File

@ -0,0 +1,320 @@
unit PropertiesDemo;
{$MODE Delphi}
// Virtual Treeview sample form demonstrating following features:
// - Property page like string tree with individual node editors.
// - Incremental search.
// Written by Mike Lischke.
interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ExtCtrls, LResources, LMessages;
const
// Helper message to decouple node change handling from edit handling.
WM_STARTEDITING = LM_USER + 778;
type
TPropertiesForm = class(TForm)
VST3: TVirtualStringTree;
Label9: TLabel;
Label10: TLabel;
TreeImages: TImageList;
RadioGroup1: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure VST3Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure VST3CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure VST3Editing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure VST3GetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
procedure VST3GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var Index: Integer);
procedure VST3GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VST3InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure VST3InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure VST3PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
procedure VST3IncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const Text: String;
var Result: Integer);
procedure RadioGroup1Click(Sender: TObject);
procedure VST3StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
private
procedure WMStartEditing(var Message: TLMessage); message WM_STARTEDITING;
end;
var
PropertiesForm: TPropertiesForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
Editors, Math, Main, States;
//----------------- TPropertiesForm ------------------------------------------------------------------------------------
procedure TPropertiesForm.FormCreate(Sender: TObject);
begin
// Always tell the tree how much data space per node it must allocated for us. We can do this here, in the
// object inspector or in the OnGetNodeDataSize event.
VST3.NodeDataSize := SizeOf(TPropertyData);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
begin
case Node.Index of
0:
ChildCount := 13;
1:
ChildCount := 8;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
Data: PPropertyData;
begin
if ParentNode = nil then
InitialStates := InitialStates + [ivsHasChildren, ivsExpanded]
else
begin
Data := Sender.GetNodeData(Node);
Data.ValueType := ValueTypes[ParentNode.Index, Node.Index];
if Data.ValueType = vtDate then
Data.Value := DateToStr(Now)
else
Data.Value := DefaultValue[ParentNode.Index, Node.Index];
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
var
Data: PPropertyData;
begin
if TextType = ttNormal then
case Column of
0:
if Node.Parent = Sender.RootNode then
begin
// root nodes
if Node.Index = 0 then
CellText := 'Description'
else
CellText := 'Origin';
end
else
CellText := PropertyTexts[Node.Parent.Index, Node.Index, ptkText];
1:
begin
Data := Sender.GetNodeData(Node);
CellText := Data.Value;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3GetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
begin
// Add a dummy hint to the normal hint to demonstrate multiline hints.
if (Column = 0) and (Node.Parent <> Sender.RootNode) then
HintText := PropertyTexts[Node.Parent.Index, Node.Index, ptkHint] + LineEnding + '(Multiline hints are supported too).';
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer);
var
Data: PPropertyData;
begin
if (Kind in [ikNormal, ikSelected]) and (Column = 0) then
begin
if Node.Parent = Sender.RootNode then
Index := 12 // root nodes, this is an open folder
else
begin
Data := Sender.GetNodeData(Node);
if Data.ValueType <> vtNone then
Index := 14
else
Index := 13;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3Editing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
var
Data: PPropertyData;
begin
with Sender do
begin
Data := GetNodeData(Node);
Allowed := (Node.Parent <> RootNode) and (Column = 1) and (Data.ValueType <> vtNone);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
with Sender do
begin
// Start immediate editing as soon as another node gets focused.
if Assigned(Node) and (Node.Parent <> RootNode) and not (tsIncrementalSearching in TreeStates) then
begin
// We want to start editing the currently selected node. However it might well happen that this change event
// here is caused by the node editor if another node is currently being edited. It causes trouble
// to start a new edit operation if the last one is still in progress. So we post us a special message and
// in the message handler we then can start editing the new node. This works because the posted message
// is first executed *after* this event and the message, which triggered it is finished.
PostMessage(Self.Handle, WM_STARTEDITING, Integer(Node), 0);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
out EditLink: IVTEditLink);
// This is the callback of the tree control to ask for an application defined edit link. Providing one here allows
// us to control the editing process up to which actual control will be created.
// TPropertyEditLink implements an interface and hence benefits from reference counting. We don't need to keep a
// reference to free it. As soon as the tree finished editing the class will be destroyed automatically.
begin
EditLink := TPropertyEditLink.Create;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
var
Data: PPropertyData;
begin
// Make the root nodes underlined and draw changed nodes in bold style.
if Node.Parent = Sender.RootNode then
TargetCanvas.Font.Style := [fsUnderline]
else
begin
Data := Sender.GetNodeData(Node);
if Data.Changed then
TargetCanvas.Font.Style := [fsBold]
else
TargetCanvas.Font.Style := [];
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3IncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const Text: String;
var Result: Integer);
var
S,
PropText: string;
begin
S := Text;
SetStatusbarText('Searching for: ' + S);
if Node.Parent = Sender.RootNode then
begin
// root nodes
if Node.Index = 0 then
PropText := 'Description'
else
PropText := 'Origin';
end
else
begin
PropText := PropertyTexts[Node.Parent.Index, Node.Index, ptkText];
end;
// By using StrLIComp we can specify a maximum length to compare. This allows us to find also nodes
// which match only partially. Don't forget to specify the shorter string length as search length.
Result := StrLIComp(PChar(S), PChar(PropText), Min(Length(S), Length(PropText)))
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.RadioGroup1Click(Sender: TObject);
begin
with Sender as TRadioGroup do
if ItemIndex = 0 then
VST3.IncrementalSearchDirection := sdForward
else
VST3.IncrementalSearchDirection := sdBackward;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.VST3StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if tsIncrementalSearching in Enter then
SetStatusbarText('Searching for: ' + Sender.SearchBuffer);
if tsIncrementalSearching in Leave then
SetStatusbarText('');
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertiesForm.WMStartEditing(var Message: TLMessage);
// This message was posted by ourselves from the node change handler above to decouple that change event and our
// intention to start editing a node. This is necessary to avoid interferences between nodes editors potentially created
// for an old edit action and the new one we start here.
var
Node: PVirtualNode;
begin
Node := Pointer(Message.WParam);
// Note: the test whether a node can really be edited is done in the OnEditing event.
VST3.EditNode(Node, 1);
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i PropertiesDemo.lrs}
end.

4
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Arabic.uni Normal file
View File

@ -0,0 +1,4 @@
الجـديـد
المنتجــات
دليـل المواقـع العربية
المساعـدة الفنية

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Background.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 45 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Background2.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 125 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Book.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Chart.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Chinese.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 24 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Clipboard.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.1 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Cyrillic.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 24 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Earth.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.1 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Exit.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/ExtraRes.or Normal file
View File

Binary file not shown.

8
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/ExtraRes.rc Normal file
View File

@ -0,0 +1,8 @@
Arabic Unicode "Arabic.uni"
Hebrew Unicode "Hebrew.uni"
Greek Unicode "Greek.uni"
LoremIpsum Unicode "Lorem ipsum.uni"
Transcriptions Bitmap "Transcriptions.bmp"

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/ExtraRes.res Normal file
View File

Binary file not shown.

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Eye.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Fist.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

5
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/ForeignStrings.rc Normal file
View File

@ -0,0 +1,5 @@
Arabic Unicode "Arabic.uni"
Hebrew Unicode "Hebrew.uni"
Greek Unicode "Greek.uni"
LoremIpsum Unicode "Lorem ipsum.uni"

9
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Greek.uni Normal file
View File

@ -0,0 +1,9 @@
Greek text part 1
Εκλογές στο Ισραήλ
Απεβίωσε ο Γιάννης Ξενάκης
Μεταμόσχευση χεριού
Σάμπα, κλόουν, μασκαράδες και πενιές
Greek text part 2
Δοκιμάζει τις αντοχές του
Ενα ντέρμπι αχρείαστο!
Το Πόρτο Αλέγρε καλεί το Νταβός

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Header.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.8 KiB

3
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Hebrew.uni Normal file
View File

@ -0,0 +1,3 @@
הלכות תלמוד תורה
.יש בכללן שתי מצוות עשה--(א) ללמוד תורה; (ב) לכבד מלמדיה ויודעיה. וביאור שתי מצוות אלו בפרקים אלו
הלכות תלמוד תורה פרק א

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Image list 24x24.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 46 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Image list 32x32.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 54 KiB

30
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Lorem ipsum.uni Normal file
View File

@ -0,0 +1,30 @@
Chapter heading spanned over two columns.
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Integer pede urna, posuere sed, blandit a, viverra et, erat. Praesent elementum tellus blandit magna. Duis in turpis nec dui accumsan iaculis. Vivamus a velit. Etiam porttitor. Nullam volutpat. Ut ante justo, accumsan sed, condimentum id, condimentum et, dolor. Aenean nec sapien. Praesent felis leo, iaculis et, convallis eget, fermentum a, est. Etiam consequat sagittis odio. Donec vitae elit. Suspendisse vitae magna. Suspendisse potenti.
Praesent euismod tincidunt dui. Sed quis magna. Donec rutrum lacus nec sem semper ultrices. Maecenas cursus. Mauris pellentesque, erat id pretium consectetuer, massa justo faucibus velit, vitae mattis ligula felis eget eros. Vestibulum ante. Morbi sit amet sem non libero aliquet imperdiet. Proin massa wisi, dignissim eu, aliquam eu, facilisis ut, dolor. Curabitur gravida, tortor sed blandit adipiscing, mi magna faucibus orci, sit amet convallis purus purus eget est. Nam nonummy mi vitae tellus. Sed scelerisque. Vivamus at enim.
Chapter heading spanned over two columns.
Vestibulum in felis. Quisque ut pede feugiat sem ullamcorper pulvinar. Praesent nisl nulla, venenatis a, cursus vel, vestibulum vitae, enim. Curabitur massa. Nullam pharetra, lorem eget viverra nonummy, nulla velit ornare pede, ut dictum diam mauris gravida nisl. Donec non urna sed ante interdum congue. Nulla quam. Ut odio nibh, ullamcorper eget, interdum accumsan, sagittis at, erat. Quisque vel massa. Donec mi elit, tempus quis, tempor in, condimentum a, felis.
Suspendisse ante. Pellentesque libero felis, pulvinar sed, ornare nec, vestibulum ac, orci. Donec ac orci. Donec auctor enim non elit. Curabitur aliquam metus eget turpis. Nullam augue libero, tristique vel, rhoncus nec, mollis vel, velit. Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Curabitur eget velit et dolor tristique hendrerit. Nulla auctor ultricies neque. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos hymenaeos. Phasellus neque. In quam. Sed vestibulum ullamcorper nulla. Nullam vel erat sed arcu viverra auctor.
Chapter heading spanned over two columns.
Praesent quis sem. In massa erat, viverra at, accumsan a, euismod et, mi. Vestibulum nonummy consequat purus. Proin lobortis diam at nisl. Proin leo. Sed dui quam, luctus sed, tincidunt molestie, vestibulum in, pede. Ut at ligula et dui pulvinar lacinia. Morbi molestie mi sit amet mauris. Pellentesque at est quis sem auctor ornare. Proin venenatis. Sed odio. Nunc varius venenatis tortor. Aliquam et tortor. Etiam dolor. Quisque eu mauris nec lectus tincidunt faucibus. Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Morbi nonummy odio a urna. Cras laoreet.
Praesent egestas, lectus vitae lacinia elementum, augue dolor placerat erat, quis porttitor erat arcu eu urna. Maecenas in nisl sit amet elit aliquam pellentesque. Integer est. Nullam ac purus sed lorem pellentesque commodo. Etiam iaculis placerat orci. Quisque lobortis massa eget purus. Donec condimentum euismod enim. Sed nec nibh. Phasellus mi. Donec malesuada, justo volutpat sodales laoreet, justo nunc dictum lacus, ac auctor quam tortor quis lectus.
Chapter heading spanned over two columns.
Duis faucibus nunc non tortor. Cras pretium. Nulla ullamcorper est eu nulla. In nec wisi sed odio interdum fringilla. Donec mattis. Quisque porta adipiscing ipsum. Suspendisse eu ipsum et sem commodo iaculis. In lacinia rhoncus tellus. Phasellus placerat nisl eget risus. Integer pede libero, congue eu, ultricies non, viverra non, nisl. Phasellus consequat tortor nec lacus. Donec eros augue, luctus ac, tempor eu, tincidunt eu, quam. Quisque a lorem at lectus suscipit iaculis. Donec erat. Aliquam mattis porttitor felis. Duis pellentesque metus. Aenean auctor neque in arcu. Morbi dui mi, tincidunt vel, interdum at, pulvinar sit amet, urna.
Duis nec leo. Fusce dignissim. Aliquam erat volutpat. Integer a sapien non ligula suscipit vulputate. Vestibulum ac urna eu magna consectetuer pulvinar. Nulla facilisi. Aliquam sed leo. Duis diam lacus, mattis a, malesuada eu, tincidunt ac, neque. Sed metus. Suspendisse nec velit. Donec sed risus. Duis dui massa, ultricies eget, scelerisque sed, gravida ac, dolor. Maecenas vestibulum, nibh in congue aliquam, lectus odio consequat ante, ullamcorper fermentum mauris est sed orci. Vestibulum vitae libero quis dolor elementum sodales. Praesent et mi.
Chapter heading spanned over two columns.
Vestibulum at turpis. Donec id wisi in orci scelerisque tincidunt. Donec non wisi et massa rutrum semper. Donec tellus. Nulla mauris. Maecenas ullamcorper, nibh sed pulvinar euismod, enim velit pulvinar dolor, sed consectetuer massa metus a metus. Maecenas interdum dictum orci. Nunc laoreet, purus sit amet faucibus rhoncus, tortor nunc semper dui, sit amet egestas justo wisi in elit. Praesent quis orci. Fusce mattis libero nec ligula sodales consequat. Integer vulputate.
Aliquam semper ultricies urna. Curabitur sed dolor at est sollicitudin suscipit. Aenean volutpat, ligula nec laoreet fringilla, sapien neque suscipit justo, eget sagittis libero dolor et lectus. Quisque eu nulla. Donec enim elit, tristique at, ultricies at, convallis non, ligula. Proin at lectus. Ut ac est. Nunc eu quam. Cras ac lacus et quam laoreet cursus. Sed sed risus. Nunc ac libero. Donec fermentum varius neque. Quisque eu lorem in mauris dignissim blandit. Suspendisse venenatis est non nunc. Cras aliquet, leo vitae tristique volutpat, ligula eros lobortis wisi, a rutrum orci arcu in purus. Pellentesque blandit. Sed eget quam a orci venenatis euismod.
Chapter heading spanned over two columns.
Donec sit amet nulla eget elit luctus nonummy. Cras ultricies ultricies turpis. Nullam vulputate, nisl vel placerat suscipit, lectus turpis porta eros, in nonummy justo eros a pede. Nulla eros. Sed placerat, odio at commodo convallis, sapien nisl lacinia mauris, quis tristique metus lorem quis lorem. Vivamus varius. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Integer ut odio. Suspendisse venenatis venenatis augue. Praesent aliquam libero nec eros. Morbi nunc. Suspendisse pellentesque arcu at massa. Nunc ut erat. Vivamus lectus eros, sodales sit amet, faucibus vitae, tristique quis, elit. Cras sodales. Curabitur lacus augue, ultricies at, porta vel, fringilla non, nunc. Integer eu neque. Ut at erat.
Proin ante. Sed vehicula neque commodo libero. Nam gravida lacinia purus. Nulla sed nunc vitae urna condimentum porttitor. Suspendisse tincidunt, tellus at euismod nonummy, justo leo vulputate nulla, sed pharetra dui massa et magna. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Duis elit. Curabitur sit amet lorem sed nunc condimentum tincidunt. Nam ultrices cursus ante. Aenean sodales ullamcorper wisi. Donec egestas diam sit amet wisi. Mauris convallis lacus.
Chapter heading spanned over two columns.
Suspendisse urna eros, bibendum venenatis, imperdiet sit amet, ultricies ut, nibh. Cras ac eros. Donec malesuada. Quisque tincidunt ante porta neque. Etiam libero. Phasellus dolor quam, convallis et, vehicula vel, mattis nec, purus. Quisque sit amet lacus. Vivamus vel risus. Nulla purus massa, bibendum et, eleifend nec, suscipit non, magna. Integer tellus. Aenean nonummy tincidunt massa.
Donec ac elit sit amet wisi molestie convallis. Proin tortor orci, luctus non, egestas ut, ultrices ut, mi. Ut at leo. Nunc in orci eget dui volutpat pretium. In tortor. Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Vivamus risus. Cras tempus tortor in purus. Nullam dictum vulputate est. Sed in nulla. Duis a tellus. Etiam ut pede. Duis purus tellus, mattis eu, venenatis ac, dignissim at, metus. Sed placerat, diam in interdum iaculis, libero sem fermentum wisi, a venenatis tortor felis sit amet mi.
Chapter heading spanned over two columns.
Maecenas rhoncus lacinia erat. Integer bibendum, erat nec luctus adipiscing, lorem risus convallis nibh, non cursus wisi felis eu mi. Curabitur elementum augue at mauris. Integer eget neque. Nulla eleifend urna et tellus. Phasellus sodales augue ut augue. Phasellus urna ligula, ornare quis, ornare sed, tempus vitae, orci. Sed bibendum gravida tellus. Morbi sit amet nunc sed dolor tincidunt viverra. Phasellus quis metus. Suspendisse sagittis luctus lacus. Integer nec turpis. Mauris massa. Etiam justo felis, convallis sed, gravida sed, aliquet in, dolor. Cras facilisis vulputate dui. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus.
Mauris est augue, ornare nec, imperdiet at, tincidunt vitae, sapien. In hac habitasse platea dictumst. Nullam dapibus, nulla in fermentum imperdiet, felis ipsum blandit felis, a viverra dui neque et ante. Maecenas ligula massa, dignissim eu, vehicula a, tempor in, elit. Vestibulum et dui. Maecenas pulvinar elementum enim. Nam neque arcu, rhoncus sit amet, mattis at, bibendum quis, nulla. Donec tellus nisl, ullamcorper id, varius eu, sollicitudin eget, justo. Duis id wisi sit amet pede fermentum ultrices. Nullam magna odio, accumsan non, vestibulum id, convallis ut, est. Proin neque tellus, varius eu, euismod quis, venenatis vel, libero. Nunc lorem wisi, posuere quis, mattis et, auctor eu, elit. Maecenas vitae velit. Nullam diam. Sed libero nibh, varius ut, venenatis a, ultrices at, nulla. Donec nec tellus. Mauris vel quam a odio nonummy rhoncus.
Chapter heading spanned over two columns.
Suspendisse potenti. Cras at dui in lorem tristique porttitor. Nulla in elit. Mauris quis turpis et libero rutrum fermentum. Curabitur enim. In non velit. Etiam dapibus rutrum wisi. Donec iaculis tincidunt nisl. Vivamus nec velit. Maecenas turpis eros, molestie vitae, accumsan a, congue at, mi. Sed nulla tellus, tempor et, consequat id, vehicula vitae, arcu. In hac habitasse platea dictumst. Nulla facilisi. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Ut est sapien, congue nec, luctus in, tincidunt ut, metus.
Mauris laoreet. Proin porttitor accumsan ligula. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos hymenaeos. Vestibulum ac enim sed neque imperdiet lobortis. In at leo. Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Donec non est. Sed vel neque ut felis mollis placerat. Morbi lacinia, sapien nec mattis venenatis, est elit ultrices lorem, et bibendum augue ipsum nec justo. Pellentesque sit amet eros. Mauris ac quam id est iaculis lobortis. In placerat, ante quis tristique suscipit, wisi leo commodo lacus, vel pulvinar dolor dolor id quam. Curabitur ac nisl. Duis sit amet tortor at lorem molestie vulputate. Duis posuere. Ut nec erat. Cras eget purus.
Chapter heading spanned over two columns.
Aliquam a nunc id lacus pulvinar tincidunt. Vestibulum ante ipsum primis in faucibus orci luctus et ultrices posuere cubilia Curae; Vestibulum tempus, sapien vitae fringilla ultrices, nibh tortor sodales ante, ut bibendum diam risus nec eros. Suspendisse potenti. Quisque quis magna sit amet mauris bibendum molestie. Cras suscipit purus at metus. Quisque id erat vel turpis sodales ullamcorper. Sed sed enim. Morbi ac magna. Phasellus ac justo non nisl interdum semper. Aliquam eleifend, odio et lacinia semper, leo odio mattis neque, non ultricies magna sapien sit amet eros.
Sed dapibus. Proin euismod lectus et nunc. Aliquam dolor eros, tincidunt vitae, lobortis vitae, laoreet vel, ante. Praesent et diam vel velit volutpat varius. Nunc mauris neque, luctus vel, aliquam a, egestas id, nunc. In sollicitudin viverra tellus. Pellentesque bibendum, nulla ac blandit volutpat, justo tellus pharetra ipsum, sit amet pellentesque nunc mauris in elit. Duis nec neque quis leo faucibus ornare. Phasellus euismod velit sit amet nibh. Nullam dictum. In dolor lacus, aliquet id, egestas sit amet, aliquet at, orci.

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Multiline.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 9.9 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Omega.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 24 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Paintbrush.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Sheets.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/Transcriptions.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 183 KiB

BIN
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/XP.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.8 KiB

5397
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/bitmap.lrs Normal file
View File

File diff suppressed because it is too large Load Diff

2
components/virtualtreeview-new/branches/4.8/demos/advanced/Res/buildres.bat Normal file
View File

@ -0,0 +1,2 @@
lazres unicode.lrs Greek.uni Arabic.uni Hebrew.uni "Lorem ipsum.uni"
lazres bitmap.lrs Transcriptions.bmp

1685
components/virtualtreeview-new/branches/4.8/demos/advanced/SpeedDemo.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

201
components/virtualtreeview-new/branches/4.8/demos/advanced/SpeedDemo.pas Normal file
View File

@ -0,0 +1,201 @@
unit SpeedDemo;
{$MODE Delphi}
// Virtual Treeview sample form demonstrating following features:
// - Speed.
// - Background image.
// Written by Mike Lischke.
interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ExtDlgs, ComCtrls, Menus, LResources, Buttons;
type
TSpeedForm = class(TForm)
Label1: TLabel;
VST1: TVirtualStringTree;
Label3: TLabel;
Label6: TLabel;
GroupBox2: TGroupBox;
SBCheckBox: TCheckBox;
LoadBackgroundButton: TButton;
GroupBox1: TGroupBox;
AddRootButton: TButton;
NodeCountEdit: TEdit;
AddChildButton: TButton;
DeleteSelectionButton: TButton;
Label4: TLabel;
OPD: TOpenPictureDialog;
Label2: TLabel;
Label5: TLabel;
Label7: TLabel;
ClearButton: TButton;
procedure SBCheckBoxClick(Sender: TObject);
procedure LoadBackgroundButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure AddButtonClick(Sender: TObject);
procedure VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VST1Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure VST1StructureChange(Sender: TBaseVirtualTree; Node: PVirtualNode; Reason: TChangeReason);
procedure DeleteSelectionButtonClick(Sender: TObject);
procedure VST1StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
end;
var
SpeedForm: TSpeedForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
States;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.AddButtonClick(Sender: TObject);
var
Count: Integer;
Start: Cardinal;
begin
Screen.Cursor := crHourGlass;
with VST1 do
try
Start := GetTickCount;
case (Sender as TButton).Tag of
0: // add to root
begin
Count := StrToInt(NodeCountEdit.Text);
RootNodeCount := Integer(RootNodeCount) + Count;
end;
1: // add as child
if Assigned(FocusedNode) then
begin
Count := StrToInt(NodeCountEdit.Text);
ChildCount[FocusedNode] := Integer(ChildCount[FocusedNode]) + Count;
Expanded[FocusedNode] := True;
InvalidateToBottom(FocusedNode);
end;
end;
Label1.Caption := Format('Last operation duration: %d ms', [GetTickCount - Start]);
Label3.Caption := Format('Nodes in tree: %d', [VST1.TotalCount]);
finally
Screen.Cursor := crDefault;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.ClearButtonClick(Sender: TObject);
var
Start: Cardinal;
begin
Screen.Cursor := crHourGlass;
try
Start := GetTickCount;
VST1.Clear;
Label1.Caption := Format('Clear operation duration: %d ms', [GetTickCount - Start]);
Label3.Caption := 'Nodes in tree: 0';
finally
Screen.Cursor := crDefault;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.LoadBackgroundButtonClick(Sender: TObject);
begin
with OPD do
begin
if Execute then
begin
VST1.Background.LoadFromFile(FileName);
if SBCheckBox.Checked then
VST1.Invalidate
else
SBCheckBox.Checked := True;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.SBCheckBoxClick(Sender: TObject);
begin
if SBCheckBox.Checked then
VST1.TreeOptions.PaintOptions := VST1.TreeOptions.PaintOptions + [toShowBackground]
else
VST1.TreeOptions.PaintOptions := VST1.TreeOptions.PaintOptions - [toShowBackground];
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
begin
CellText := Format('Level %d, Index %d', [Sender.GetNodeLevel(Node), Node.Index]);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.VST1Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
Label6.Caption := Format('Selected: %d', [VST1.SelectedCount]);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.VST1StructureChange(Sender: TBaseVirtualTree; Node: PVirtualNode; Reason: TChangeReason);
begin
Label6.Caption := Format('Selected: %d', [VST1.SelectedCount]);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.DeleteSelectionButtonClick(Sender: TObject);
var
Start: Cardinal;
begin
Screen.Cursor := crHourGlass;
try
Start := GetTickCount;
VST1.DeleteSelectedNodes;
Label1.Caption := Format('Delete operation duration: %d ms', [GetTickCount - Start]);
Label3.Caption := 'Nodes in tree: ' + IntToStr(VST1.TotalCount);
finally
Screen.Cursor := crDefault;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSpeedForm.VST1StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i SpeedDemo.lrs}
end.

518
components/virtualtreeview-new/branches/4.8/demos/advanced/States.lfm Normal file
View File

@ -0,0 +1,518 @@
object StateForm: TStateForm
Left = 403
Height = 589
Top = 147
Width = 478
HorzScrollBar.Page = 477
VertScrollBar.Page = 588
ActiveControl = EnableCheckBox
BorderStyle = bsToolWindow
Caption = 'Watch Virtual Treeview at work:'
ClientHeight = 589
ClientWidth = 478
Font.Height = -14
Font.Name = 'Arial Narrow'
object EnableCheckBox: TCheckBox
Left = 9
Height = 13
Top = 14
Width = 120
Caption = 'Enable state tracking'
OnClick = EnableCheckBoxClick
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 18
Height = 96
Top = 41
Width = 228
Caption = ' Changes: '
ClientHeight = 78
ClientWidth = 224
TabOrder = 1
object CheckBox1: TCheckBox
Left = 9
Height = 13
Top = 1
Width = 98
Caption = 'Change pending'
Enabled = False
TabOrder = 0
end
object CheckBox3: TCheckBox
Left = 9
Height = 13
Top = 19
Width = 127
Caption = 'Toggle focus selection'
Enabled = False
TabOrder = 1
end
object CheckBox4: TCheckBox
Left = 9
Height = 13
Top = 37
Width = 85
Caption = 'Clear pending'
Enabled = False
TabOrder = 2
end
object CheckBox32: TCheckBox
Left = 9
Height = 13
Top = 54
Width = 143
Caption = 'Structure change pending'
Enabled = False
TabOrder = 3
end
end
object GroupBox2: TGroupBox
Left = 16
Height = 169
Top = 245
Width = 228
Caption = ' Mouse actions: '
ClientHeight = 151
ClientWidth = 224
TabOrder = 2
object CheckBox8: TCheckBox
Left = 6
Height = 13
Top = 115
Width = 131
Caption = 'Draw selection pending'
Enabled = False
TabOrder = 0
end
object CheckBox9: TCheckBox
Left = 6
Height = 13
Top = 131
Width = 90
Caption = 'Draw selecting'
Enabled = False
TabOrder = 1
end
object CheckBox19: TCheckBox
Left = 6
Height = 13
Top = 3
Width = 134
Caption = 'Left mouse button down'
Enabled = False
TabOrder = 2
end
object CheckBox20: TCheckBox
Left = 6
Height = 13
Top = 21
Width = 126
Caption = 'Mouse check pending'
Enabled = False
TabOrder = 3
end
object CheckBox21: TCheckBox
Left = 6
Height = 13
Top = 39
Width = 147
Caption = 'Middle mouse button down'
Enabled = False
TabOrder = 4
end
object CheckBox27: TCheckBox
Left = 6
Height = 13
Top = 59
Width = 141
Caption = 'Right mouse button down'
Enabled = False
TabOrder = 5
end
object CheckBox43: TCheckBox
Left = 6
Height = 13
Top = 77
Width = 124
Caption = 'Mouse wheel panning'
Enabled = False
TabOrder = 6
end
object CheckBox44: TCheckBox
Left = 6
Height = 13
Top = 95
Width = 124
Caption = 'Mouse wheel scrolling'
Enabled = False
TabOrder = 7
end
end
object GroupBox3: TGroupBox
Left = 258
Height = 114
Top = 313
Width = 210
Caption = ' Keyboard actions: '
ClientHeight = 96
ClientWidth = 206
TabOrder = 3
object CheckBox10: TCheckBox
Left = 9
Height = 13
Top = 17
Width = 52
Caption = 'Editing'
Enabled = False
TabOrder = 0
end
object CheckBox11: TCheckBox
Left = 9
Height = 13
Top = 35
Width = 79
Caption = 'Edit pending'
Enabled = False
TabOrder = 1
end
object CheckBox15: TCheckBox
Left = 9
Height = 13
Top = 72
Width = 164
Caption = 'Incremental search in progress'
Enabled = False
TabOrder = 2
end
object CheckBox16: TCheckBox
Left = 9
Height = 13
Top = 54
Width = 151
Caption = 'Incremental search pending'
Enabled = False
TabOrder = 3
end
object CheckBox18: TCheckBox
Left = 9
Height = 13
Top = -1
Width = 112
Caption = 'Key check pending'
Enabled = False
TabOrder = 4
end
end
object GroupBox4: TGroupBox
Left = 258
Height = 168
Top = 41
Width = 210
Caption = ' Clipboard and drag''n drop actions: '
ClientHeight = 150
ClientWidth = 206
TabOrder = 4
object CheckBox5: TCheckBox
Left = 9
Height = 13
Top = 92
Width = 103
Caption = 'Clipboard flushing'
Enabled = False
TabOrder = 0
end
object CheckBox6: TCheckBox
Left = 9
Height = 13
Top = 110
Width = 131
Caption = 'Clipboard copy pending'
Enabled = False
TabOrder = 1
end
object CheckBox7: TCheckBox
Left = 9
Height = 13
Top = 128
Width = 123
Caption = 'Clipboard cut pending'
Enabled = False
TabOrder = 2
end
object CheckBox24: TCheckBox
Left = 9
Height = 13
Top = 74
Width = 151
Caption = 'OLE drag''n drop in progress'
Enabled = False
TabOrder = 3
end
object CheckBox25: TCheckBox
Left = 9
Height = 13
Top = 56
Width = 138
Caption = 'OLE drag''n drop pending'
Enabled = False
TabOrder = 4
end
object CheckBox37: TCheckBox
Left = 9
Height = 13
Top = 37
Width = 157
Caption = 'VCL dd with app. drag object'
Enabled = False
TabOrder = 5
end
object CheckBox41: TCheckBox
Left = 9
Height = 13
Top = 1
Width = 150
Caption = 'VCL drag''n drop in progress'
Enabled = False
TabOrder = 6
end
object CheckBox42: TCheckBox
Left = 9
Height = 13
Top = 19
Width = 137
Caption = 'VCL drag''n drop pending'
Enabled = False
TabOrder = 7
end
end
object GroupBox5: TGroupBox
Left = 16
Height = 96
Top = 141
Width = 228
Caption = ' Tree cache: '
ClientHeight = 78
ClientWidth = 224
TabOrder = 5
object CheckBox31: TCheckBox
Left = 11
Height = 13
Top = 3
Width = 184
Caption = 'Tree cache validation stop request'
Enabled = False
TabOrder = 0
end
object CheckBox36: TCheckBox
Left = 11
Height = 13
Top = 51
Width = 100
Caption = 'Tree cache valid'
Enabled = False
TabOrder = 1
end
object CheckBox39: TCheckBox
Left = 11
Height = 13
Top = 19
Width = 160
Caption = 'Tree cache is being validated'
Enabled = False
TabOrder = 2
end
object CheckBox40: TCheckBox
Left = 11
Height = 13
Top = 35
Width = 158
Caption = 'Tree cache invalid or unused'
Enabled = False
TabOrder = 3
end
end
object GroupBox6: TGroupBox
Left = 258
Height = 105
Top = 209
Width = 210
Caption = ' Collapse/Expand/Scroll: '
ClientHeight = 87
ClientWidth = 206
TabOrder = 6
object CheckBox2: TCheckBox
Left = 9
Height = 13
Top = 7
Width = 132
Caption = 'Full collapse in progress'
Enabled = False
TabOrder = 0
end
object CheckBox12: TCheckBox
Left = 9
Height = 13
Top = 25
Width = 128
Caption = 'Full expand in progress'
Enabled = False
TabOrder = 1
end
object CheckBox28: TCheckBox
Left = 9
Height = 13
Top = 43
Width = 60
Caption = 'Scrolling'
Enabled = False
TabOrder = 2
end
object CheckBox29: TCheckBox
Left = 9
Height = 13
Top = 62
Width = 110
Caption = 'Auto scroll pending'
Enabled = False
TabOrder = 3
end
end
object GroupBox7: TGroupBox
Left = 258
Height = 141
Top = 432
Width = 210
Caption = ' Miscellanous: '
ClientHeight = 123
ClientWidth = 206
TabOrder = 7
object CheckBox13: TCheckBox
Left = 9
Height = 13
Top = 26
Width = 161
Caption = 'Last hint window was from VT'
Enabled = False
TabOrder = 0
end
object CheckBox14: TCheckBox
Left = 9
Height = 13
Top = 63
Width = 77
Caption = 'In animation'
Enabled = False
TabOrder = 1
end
object CheckBox17: TCheckBox
Left = 9
Height = 13
Top = 81
Width = 58
Caption = 'Iterating'
Enabled = False
TabOrder = 2
end
object CheckBox23: TCheckBox
Left = 9
Height = 13
Top = 44
Width = 133
Caption = 'Need root count update'
Enabled = False
TabOrder = 3
end
object CheckBox33: TCheckBox
Left = 9
Height = 13
Top = 8
Width = 143
Caption = 'Synchronous mode active'
Enabled = False
TabOrder = 4
end
object CheckBox46: TCheckBox
Left = 9
Height = 13
Top = 99
Width = 114
Caption = 'Popup menu shown'
Enabled = False
TabOrder = 5
end
end
object GroupBox8: TGroupBox
Left = 18
Height = 150
Top = 422
Width = 228
Caption = ' Window related actions: '
ClientHeight = 132
ClientWidth = 224
TabOrder = 8
object CheckBox22: TCheckBox
Left = 9
Height = 13
Top = 114
Width = 141
Caption = 'Default node height scale'
Enabled = False
TabOrder = 0
end
object CheckBox26: TCheckBox
Left = 9
Height = 13
Top = 58
Width = 82
Caption = 'Tree painting'
Enabled = False
TabOrder = 1
end
object CheckBox30: TCheckBox
Left = 9
Height = 13
Top = 38
Width = 97
Caption = 'Window resizing'
Enabled = False
TabOrder = 2
end
object CheckBox34: TCheckBox
Left = 9
Height = 13
Top = 74
Width = 136
Caption = 'Tumb tracking (scrollbar)'
Enabled = False
TabOrder = 3
end
object CheckBox35: TCheckBox
Left = 9
Height = 13
Top = 90
Width = 95
Caption = 'Updates locked'
Enabled = False
TabOrder = 4
end
object CheckBox38: TCheckBox
Left = 9
Height = 13
Top = 2
Width = 186
Caption = 'Windows XP Theme support in use'
Enabled = False
TabOrder = 5
end
object CheckBox45: TCheckBox
Left = 9
Height = 13
Top = 20
Width = 179
Caption = 'Treewindow is under construction'
Enabled = False
TabOrder = 6
end
end
end

218
components/virtualtreeview-new/branches/4.8/demos/advanced/States.pas Normal file
View File

@ -0,0 +1,218 @@
unit States;
{$MODE Delphi}
{$H+}
interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, VirtualTrees, LResources;
type
TStateForm = class(TForm)
EnableCheckBox: TCheckBox;
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox32: TCheckBox;
GroupBox2: TGroupBox;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
CheckBox19: TCheckBox;
CheckBox20: TCheckBox;
CheckBox21: TCheckBox;
CheckBox27: TCheckBox;
CheckBox43: TCheckBox;
CheckBox44: TCheckBox;
GroupBox3: TGroupBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox15: TCheckBox;
CheckBox16: TCheckBox;
CheckBox18: TCheckBox;
GroupBox4: TGroupBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox24: TCheckBox;
CheckBox25: TCheckBox;
CheckBox37: TCheckBox;
CheckBox41: TCheckBox;
CheckBox42: TCheckBox;
GroupBox5: TGroupBox;
CheckBox31: TCheckBox;
CheckBox36: TCheckBox;
CheckBox39: TCheckBox;
CheckBox40: TCheckBox;
GroupBox6: TGroupBox;
CheckBox2: TCheckBox;
CheckBox12: TCheckBox;
CheckBox28: TCheckBox;
CheckBox29: TCheckBox;
GroupBox7: TGroupBox;
CheckBox13: TCheckBox;
CheckBox14: TCheckBox;
CheckBox17: TCheckBox;
CheckBox23: TCheckBox;
CheckBox33: TCheckBox;
GroupBox8: TGroupBox;
CheckBox22: TCheckBox;
CheckBox26: TCheckBox;
CheckBox30: TCheckBox;
CheckBox34: TCheckBox;
CheckBox35: TCheckBox;
CheckBox38: TCheckBox;
CheckBox45: TCheckBox;
CheckBox46: TCheckBox;
procedure EnableCheckBoxClick(Sender: TObject);
protected
procedure SetActiveState(CheckBox: TCheckBox; Active: Boolean);
end;
var
StateForm: TStateForm;
procedure UpdateStateDisplay(CurrentStates, Enter, Leave: TVirtualTreeStates);
//----------------------------------------------------------------------------------------------------------------------
implementation
//----------------------------------------------------------------------------------------------------------------------
procedure UpdateStateDisplay(CurrentStates, Enter, Leave: TVirtualTreeStates);
var
NewStates: TVirtualTreeStates;
begin
with StateForm do
if EnableCheckBox.Checked then
begin
// At this point the new states are not yet set. So construct the new set here.
NewStates := CurrentStates + Enter - Leave;
SetActiveState(CheckBox1, tsChangePending in NewStates);
SetActiveState(CheckBox2, tsCollapsing in NewStates);
SetActiveState(CheckBox3, tsToggleFocusedSelection in NewStates);
SetActiveState(CheckBox4, tsClearPending in NewStates);
SetActiveState(CheckBox5, tsClipboardFlushing in NewStates);
SetActiveState(CheckBox6, tsCopyPending in NewStates);
SetActiveState(CheckBox7, tsCutPending in NewStates);
SetActiveState(CheckBox8, tsDrawSelPending in NewStates);
SetActiveState(CheckBox9, tsDrawSelecting in NewStates);
SetActiveState(CheckBox10, tsEditing in NewStates);
SetActiveState(CheckBox11, tsEditPending in NewStates);
SetActiveState(CheckBox12, tsExpanding in NewStates);
SetActiveState(CheckBox13, tsHint in NewStates);
SetActiveState(CheckBox14, tsInAnimation in NewStates);
SetActiveState(CheckBox15, tsIncrementalSearching in NewStates);
SetActiveState(CheckBox16, tsIncrementalSearchPending in NewStates);
SetActiveState(CheckBox17, tsIterating in NewStates);
SetActiveState(CheckBox18, tsKeyCheckPending in NewStates);
SetActiveState(CheckBox19, tsLeftButtonDown in NewStates);
SetActiveState(CheckBox20, tsMouseCheckPending in NewStates);
SetActiveState(CheckBox21, tsMiddleButtonDown in NewStates);
SetActiveState(CheckBox22, tsNeedScale in NewStates);
SetActiveState(CheckBox23, tsNeedRootCountUpdate in NewStates);
SetActiveState(CheckBox24, tsOLEDragging in NewStates);
SetActiveState(CheckBox25, tsOLEDragPending in NewStates);
SetActiveState(CheckBox26, tsPainting in NewStates);
SetActiveState(CheckBox27, tsRightButtonDown in NewStates);
SetActiveState(CheckBox28, tsScrolling in NewStates);
SetActiveState(CheckBox29, tsScrollPending in NewStates);
SetActiveState(CheckBox30, tsSizing in NewStates);
SetActiveState(CheckBox31, tsStopValidation in NewStates);
SetActiveState(CheckBox32, tsStructureChangePending in NewStates);
SetActiveState(CheckBox33, tsSynchMode in NewStates);
SetActiveState(CheckBox34, tsThumbTracking in NewStates);
SetActiveState(CheckBox35, tsUpdating in NewStates);
SetActiveState(CheckBox36, tsUseCache in NewStates);
SetActiveState(CheckBox37, tsUserDragObject in NewStates);
SetActiveState(CheckBox38, tsUseThemes in NewStates);
SetActiveState(CheckBox39, tsValidating in NewStates);
SetActiveState(CheckBox40, tsValidationNeeded in NewStates);
SetActiveState(CheckBox41, tsVCLDragging in NewStates);
SetActiveState(CheckBox42, tsVCLDragPending in NewStates);
SetActiveState(CheckBox43, tsWheelPanning in NewStates);
SetActiveState(CheckBox44, tsWheelScrolling in NewStates);
SetActiveState(CheckBox45, tsWindowCreating in NewStates);
SetActiveState(CheckBox46, tsPopupMenuShown in NewStates);
Update;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TStateForm.EnableCheckBoxClick(Sender: TObject);
begin
CheckBox1.Enabled := EnableCheckBox.Checked;
CheckBox2.Enabled := EnableCheckBox.Checked;
CheckBox3.Enabled := EnableCheckBox.Checked;
CheckBox4.Enabled := EnableCheckBox.Checked;
CheckBox5.Enabled := EnableCheckBox.Checked;
CheckBox6.Enabled := EnableCheckBox.Checked;
CheckBox7.Enabled := EnableCheckBox.Checked;
CheckBox8.Enabled := EnableCheckBox.Checked;
CheckBox9.Enabled := EnableCheckBox.Checked;
CheckBox10.Enabled := EnableCheckBox.Checked;
CheckBox11.Enabled := EnableCheckBox.Checked;
CheckBox12.Enabled := EnableCheckBox.Checked;
CheckBox13.Enabled := EnableCheckBox.Checked;
CheckBox14.Enabled := EnableCheckBox.Checked;
CheckBox15.Enabled := EnableCheckBox.Checked;
CheckBox16.Enabled := EnableCheckBox.Checked;
CheckBox17.Enabled := EnableCheckBox.Checked;
CheckBox18.Enabled := EnableCheckBox.Checked;
CheckBox19.Enabled := EnableCheckBox.Checked;
CheckBox20.Enabled := EnableCheckBox.Checked;
CheckBox21.Enabled := EnableCheckBox.Checked;
CheckBox22.Enabled := EnableCheckBox.Checked;
CheckBox23.Enabled := EnableCheckBox.Checked;
CheckBox24.Enabled := EnableCheckBox.Checked;
CheckBox25.Enabled := EnableCheckBox.Checked;
CheckBox26.Enabled := EnableCheckBox.Checked;
CheckBox27.Enabled := EnableCheckBox.Checked;
CheckBox28.Enabled := EnableCheckBox.Checked;
CheckBox29.Enabled := EnableCheckBox.Checked;
CheckBox30.Enabled := EnableCheckBox.Checked;
CheckBox31.Enabled := EnableCheckBox.Checked;
CheckBox32.Enabled := EnableCheckBox.Checked;
CheckBox33.Enabled := EnableCheckBox.Checked;
CheckBox34.Enabled := EnableCheckBox.Checked;
CheckBox35.Enabled := EnableCheckBox.Checked;
CheckBox36.Enabled := EnableCheckBox.Checked;
CheckBox37.Enabled := EnableCheckBox.Checked;
CheckBox38.Enabled := EnableCheckBox.Checked;
CheckBox39.Enabled := EnableCheckBox.Checked;
CheckBox40.Enabled := EnableCheckBox.Checked;
CheckBox41.Enabled := EnableCheckBox.Checked;
CheckBox42.Enabled := EnableCheckBox.Checked;
CheckBox43.Enabled := EnableCheckBox.Checked;
CheckBox44.Enabled := EnableCheckBox.Checked;
CheckBox45.Enabled := EnableCheckBox.Checked;
CheckBox46.Enabled := EnableCheckBox.Checked;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TStateForm.SetActiveState(CheckBox: TCheckBox; Active: Boolean);
begin
CheckBox.Checked := Active;
if Active then
CheckBox.Font.Style := [fsBold]
else
CheckBox.Font.Style := [];
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i States.lrs}
end.

8248
components/virtualtreeview-new/branches/4.8/demos/advanced/VisibilityDemo.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

344
components/virtualtreeview-new/branches/4.8/demos/advanced/VisibilityDemo.pas Normal file
View File

@ -0,0 +1,344 @@
unit VisibilityDemo;
{$MODE Delphi}
{$H+}
// Virtual Treeview sample form demonstrating following features:
// - Hiding nodes.
// - Synchronization between 2 trees (expand, scroll, selection).
// - Wheel scrolling and panning.
// Written by Mike Lischke.
interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ComCtrls, ExtCtrls, LResources;
type
TVisibilityForm = class(TForm)
Label17: TLabel;
RadioGroup1: TRadioGroup;
VST2: TVirtualStringTree;
VST1: TVirtualStringTree;
VST3: TVirtualStringTree;
Splitter2: TSplitter;
Panel2: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure VST1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure VST1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure FormCreate(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VST3Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
procedure VST2InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
procedure VSTCollapsedExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure VST2Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure Splitter2CanResize(Sender: TObject; var NewSize: Integer;
var Accept: Boolean);
procedure Splitter2Paint(Sender: TObject);
procedure VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
private
FChanging: Boolean;
procedure HideNodes(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
end;
var
VisibilityForm: TVisibilityForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses States;
type
PLinkData = ^TLinkData;
TLinkData = record
Caption: String;
OtherNode: PVirtualNode;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
Level: Integer;
begin
Level := Sender.GetNodeLevel(Node);
if Level < 4 then
Include(InitialStates, ivsHasChildren);
if Level > 0 then
Node.CheckType := TCheckType(Level)
else
Node.CheckType := ctTriStateCheckBox;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
begin
ChildCount := Random(5);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.FormCreate(Sender: TObject);
var
Run1, Run2: PVirtualNode;
Data1, Data2: PLinkData;
begin
Randomize;
VST1.RootNodeCount := 5;
// The base idea behind linking two (or more) trees together is that one has access to the nodes of the others.
// This can be reached in several ways. I use here the simplest approach by validating both trees fully and creating
// cross references for all nodes. Another one would be to create a common data base and link all trees to this.
VST2.NodeDataSize := SizeOf(TLinkData);
VST2.RootNodeCount := 5;
VST3.NodeDataSize := SizeOf(TLinkData);
VST3.RootNodeCount := 5;
VST3.BackgroundOffsetX := Splitter2.Left + Splitter2.Width;
// Create cross references. This will validate all nodes.
Run1 := VST2.GetFirst;
Run2 := VST3.GetFirst;
while Assigned(Run1) do
begin
Data1 := VST2.GetNodeData(Run1);
Data1.OtherNode := Run2;
Data2 := VST3.GetNodeData(Run2);
Data2.OtherNode := Run1;
Run1 := VST2.GetNext(Run1);
Run2 := VST3.GetNext(Run2);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.HideNodes(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
begin
case PtrUInt(Data) of
0: // show all nodes
Sender.IsVisible[Node] := True;
1: // hide every second
Sender.IsVisible[Node] := not Odd(Node.Index);
2: // hide nodes with child nodes only
Sender.IsVisible[Node] := not Sender.HasChildren[Node];
3: // hide all
Sender.IsVisible[Node] := False;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.RadioGroup1Click(Sender: TObject);
begin
with Sender as TRadioGroup do
begin
VST1.BeginUpdate;
try
VST1.IterateSubtree(nil, HideNodes, Pointer(ItemIndex), [], True);
finally
VST1.EndUpdate;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
var
Data: PLinkData;
begin
Data := Sender.GetNodeData(Node);
if Length(Data.Caption) = 0 then
Data.Caption := 'Node ' + IntToStr(Sender.AbsoluteIndex(Node));
CellText := Data.Caption;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST3Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
// Synchronizes scroll offsets of VST2 and VST3.
begin
if not FChanging then
begin
FChanging := True;
try
VST3.Update;
VST2.OffsetY := VST3.OffsetY;
VST2.Update;
finally
FChanging := False;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
// Synchronizes scroll offsets of VST2 and VST3.
begin
if not FChanging then
begin
FChanging := True;
try
VST2.Update;
VST3.OffsetY := VST2.OffsetY;
VST3.Update;
finally
FChanging := False;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST2InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
begin
ChildCount := Sender.GetNodeLevel(Node) + 2;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VSTCollapsedExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode);
// Collapse/Expand state synchronization.
var
OtherTree: TBaseVirtualTree;
Data: PLinkData;
begin
// Avoid recursive calls.
if not FChanging then
begin
FChanging := True;
try
if Sender = VST2 then
OtherTree := VST3
else
OtherTree := VST2;
Data := Sender.GetNodeData(Node);
OtherTree.ToggleNode(Data.OtherNode);
finally
FChanging := False;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST2Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
// Keep selected nodes in sync.
var
Data: PLinkData;
OtherTree: TBaseVirtualTree;
begin
if not FChanging and Assigned(Node) then
begin
FChanging := True;
try
Data := Sender.GetNodeData(Node);
if Sender = VST2 then
OtherTree := VST3
else
OtherTree := VST2;
OtherTree.Selected[Data.OtherNode] := True;
OtherTree.FocusedNode := Data.OtherNode;
finally
FChanging := False;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.Splitter2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
// This method is called just before resizing is done. This is a good opportunity to adjust the background image
// offset.
begin
VST3.BackgroundOffsetX := NewSize + Splitter2.Width;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.Splitter2Paint(Sender: TObject);
begin
with Splitter2, Canvas do
begin
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, Width, VST2.Header.Height));
Brush.Color := clWindow;
FillRect(Rect(0, VST2.Header.Height, Width, Height));
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
begin
CellText := Format('Node Level %d, Index %d', [Sender.GetNodeLevel(Node), Node.Index]);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.FormShow(Sender: TObject);
begin
StateForm.Hide;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVisibilityForm.FormHide(Sender: TObject);
begin
StateForm.Show;
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i VisibilityDemo.lrs}
end.

4454
components/virtualtreeview-new/branches/4.8/demos/advanced/WindowsXPStyleDemo.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

286
components/virtualtreeview-new/branches/4.8/demos/advanced/WindowsXPStyleDemo.pas Normal file
View File

@ -0,0 +1,286 @@
unit WindowsXPStyleDemo;
{$MODE Delphi}
// Virtual Treeview sample form demonstrating following features:
// - Windows XP style treeview.
// Written by Mike Lischke.
interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, ComCtrls, Menus, StdCtrls,
LResources, Printers, PrintersDlgs, ExtCtrls;
type
{ TWindowsXPForm }
TWindowsXPForm = class(TForm)
ToolBar2: TToolBar;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
ToolButton16: TToolButton;
ToolButton7: TToolButton;
XPTree: TVirtualStringTree;
LargeImages: TImageList;
SmallImages: TImageList;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
PrintDialog: TPrintDialog;
procedure XPTreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer);
procedure FormCreate(Sender: TObject);
procedure XPTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure XPTreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure XPTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
procedure XPTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
procedure XPTreeCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
var Result: Integer);
procedure XPTreeGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
procedure Label4Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
procedure XPTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
end;
var
WindowsXPForm: TWindowsXPForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
States;
type
PEntry = ^TEntry;
TEntry = record
Caption: String;
Image: Integer;
Size: Int64;
end;
var
TreeEntries: array[0..17] of TEntry = (
(Caption: 'My Computer'; Image: 0; Size: 0),
(Caption: 'Network Places'; Image: 1; Size: 0),
(Caption: 'Recycle Bin'; Image: 2; Size: 0),
(Caption: 'My Documents'; Image: 3; Size: 0),
(Caption: 'My Music'; Image: 4; Size: 0),
(Caption: 'My Pictures'; Image: 5; Size: 0),
(Caption: 'Control Panel'; Image: 6; Size: 0),
(Caption: 'Help'; Image: 7; Size: 0),
(Caption: 'Help Document'; Image: 8; Size: 0),
(Caption: 'User Accounts'; Image: 9; Size: 0),
(Caption: 'Internet'; Image: 10; Size: 0),
(Caption: 'Network Group'; Image: 11; Size: 0),
(Caption: 'Folder'; Image: 12; Size: 0),
(Caption: 'Window'; Image: 13; Size: 0),
(Caption: 'Warning'; Image: 14; Size: 0),
(Caption: 'Information'; Image: 15; Size: 0),
(Caption: 'Critical'; Image: 16; Size: 0),
(Caption: 'Security'; Image: 17; Size: 0)
);
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer);
var
Data: PEntry;
begin
Data := Sender.GetNodeData(Node);
case Kind of
ikNormal, ikSelected:
if (Column = 0) and (Node.Parent = Sender.RootNode) then
Index := Data.Image;
ikState:
case Column of
0:
if Node.Parent <> Sender.RootNode then
Index := 21;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.FormCreate(Sender: TObject);
begin
XPTree.NodeDataSize := SizeOf(TEntry);
{$ifdef LCLWin32}
//enable native look under win32
//todo: enable only in winxp
XPTree.TreeOptions.PaintOptions := XPTree.TreeOptions.PaintOptions + [toThemeAware];
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
Data: PEntry;
begin
if ParentNode = nil then
begin
Include(InitialStates, ivsHasChildren);
Data := Sender.GetNodeData(Node);
Data^ := TreeEntries[Node.Index mod 18];
Data.Size := Random(100000);
Node.CheckType := ctCheckBox;
end
else
Node.CheckType := ctRadioButton;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode;
var ChildCount: Cardinal);
begin
ChildCount := 5;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: String);
var
Data: PEntry;
begin
Data := Sender.GetNodeData(Node);
case Column of
0:
if Node.Parent = Sender.RootNode then
CellText := Data.Caption
else
Text := 'More entries';
1:
if Node.Parent = Sender.RootNode then
CellText := FloatToStr(Data.Size / 1000) + ' MB';
2:
if Node.Parent = Sender.RootNode then
CellText := 'System Folder';
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
with Sender, Treeview do
begin
if SortColumn > NoColumn then
Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
// Do not sort the last column, it contains nothing to sort.
if Column = 2 then
SortColumn := NoColumn
else
begin
if (SortColumn = NoColumn) or (SortColumn <> Column) then
begin
SortColumn := Column;
SortDirection := sdAscending;
end
else
if SortDirection = sdAscending then
SortDirection := sdDescending
else
SortDirection := sdAscending;
Columns[SortColumn].Color := $F7F7F7;
SortTree(SortColumn, SortDirection, False);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode;
Column: TColumnIndex; var Result: Integer);
var
Data1, Data2: PEntry;
begin
Data1 := Sender.GetNodeData(Node1);
Data2 := Sender.GetNodeData(Node2);
case Column of
0:
Result := CompareText(Data1.Caption, Data2.Caption);
1:
Result := Data1.Size - Data2.Size;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
begin
// Show only a dummy hint. It is just to demonstrate how to do it.
HintText := 'Size larger than 536 MB' + LineEnding +
'Folders: addins, AppPatch, Config, Connection Wizard, ...' + LineEnding +
'Files: 1280.bmp, 1280x1024.bmp, 2001 94 mars.bmp, ac3api.ini, ...';
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.Label4Click(Sender: TObject);
begin
OpenURL('http://groups.yahoo.com/group/VirtualExplorerTree');
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.ToolButton9Click(Sender: TObject);
begin
//todo: implement Print support in VTV
//if PrintDialog.Execute then ;
// XPTree.Print(Printer, False);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.XPTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
begin
if not (csDestroying in ComponentState) then
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i WindowsXPStyleDemo.lrs}
end.

5397
components/virtualtreeview-new/branches/4.8/demos/advanced/bitmap.lrs Normal file
View File

File diff suppressed because it is too large Load Diff

43
components/virtualtreeview-new/branches/4.8/demos/advanced/shlobjext.pas Normal file
View File

@ -0,0 +1,43 @@
unit shlobjext;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
const
SFGAO_CANRENAME=$00000010;
SFGAO_CANDELETE=$00000020;
SFGAO_HASPROPSHEET =$00000040;
SFGAO_DROPTARGET =$00000100;
SFGAO_CAPABILITYMASK =$00000177;
SFGAO_ISSLOW = $00004000;
SFGAO_GHOSTED =$00008000;
SFGAO_LINK=$00010000;
SFGAO_SHARE=$00020000;
SFGAO_READONLY =$00040000;
SFGAO_HIDDEN=$00080000;
SFGAO_DISPLAYATTRMASK = SFGAO_ISSLOW or SFGAO_GHOSTED or SFGAO_LINK or SFGAO_SHARE or SFGAO_READONLY or SFGAO_HIDDEN;
{ (SFGAO_ISSLOW \
| SFGAO_GHOSTED \
| SFGAO_LINK \
| SFGAO_SHARE \
| SFGAO_READONLY \
| SFGAO_HIDDEN)
}
SFGAO_FILESYSANCESTOR = $10000000;
SFGAO_FOLDER = $20000000;
SFGAO_FILESYSTEM = $40000000;
SFGAO_HASSUBFOLDER = $80000000;
SFGAO_CONTENTSMASK = $80000000;
SFGAO_VALIDATE = $01000000;
SFGAO_REMOVABLE = $02000000;
SFGAO_COMPRESSED = $04000000;
implementation
end.

209
components/virtualtreeview-new/branches/4.8/demos/advanced/unicode.lrs Normal file
View File

@ -0,0 +1,209 @@
LazarusResources.Add('Greek','UNI',[
'Greek text part 1'#13#10#206#149#206#186#206#187#206#191#206#179#206#173#207
+#130' '#207#131#207#132#206#191' '#206#153#207#131#207#129#206#177#206#174
+#206#187#13#10#206#145#207#128#206#181#206#178#206#175#207#137#207#131#206
+#181' '#206#191' '#206#147#206#185#206#172#206#189#206#189#206#183#207#130' '
+#206#158#206#181#206#189#206#172#206#186#206#183#207#130#13#10#206#156#206
+#181#207#132#206#177#206#188#207#140#207#131#207#135#206#181#207#133#207#131
+#206#183' '#207#135#206#181#207#129#206#185#206#191#207#141' '#13#10#206#163
+#206#172#206#188#207#128#206#177', '#206#186#206#187#207#140#206#191#207#133
+#206#189', '#206#188#206#177#207#131#206#186#206#177#207#129#206#172#206#180
+#206#181#207#130' '#206#186#206#177#206#185' '#207#128#206#181#206#189#206
+#185#206#173#207#130#13#10'Greek text part 2'#13#10#206#148#206#191#206#186
+#206#185#206#188#206#172#206#182#206#181#206#185' '#207#132#206#185#207#130
+' '#206#177#206#189#207#132#206#191#207#135#206#173#207#130' '#207#132#206
+#191#207#133#13#10#206#149#206#189#206#177' '#206#189#207#132#206#173#207#129
+#206#188#207#128#206#185' '#206#177#207#135#207#129#206#181#206#175#206#177
+#207#131#207#132#206#191'!'#13#10#206#164#206#191' '#206#160#207#140#207#129
+#207#132#206#191' '#206#145#206#187#206#173#206#179#207#129#206#181' '#206
+#186#206#177#206#187#206#181#206#175' '#207#132#206#191' '#206#157#207#132
+#206#177#206#178#207#140#207#130
]);
LazarusResources.Add('Arabic','UNI',[
#216#167#217#132#216#172#217#128#216#175#217#138#217#128#216#175#13#10#216#167
+#217#132#217#133#217#134#216#170#216#172#217#128#217#128#216#167#216#170#13
+#10#216#175#217#132#217#138#217#128#217#132' '#216#167#217#132#217#133#217
+#136#216#167#217#130#217#128#216#185' '#216#167#217#132#216#185#216#177#216
+#168#217#138#216#169' '#13#10#216#167#217#132#217#133#216#179#216#167#216#185
+#217#128#216#175#216#169' '#216#167#217#132#217#129#217#134#217#138#216#169
+' '
]);
LazarusResources.Add('Hebrew','UNI',[
#215#148#215#156#215#155#215#149#215#170' '#215#170#215#156#215#158#215#149
+#215#147' '#215#170#215#149#215#168#215#148#13#10'.'#215#153#215#169' '#215
+#145#215#155#215#156#215#156#215#159' '#215#169#215#170#215#153' '#215#158
+#215#166#215#149#215#149#215#170' '#215#162#215#169#215#148'--('#215#144') '
+#215#156#215#156#215#158#215#149#215#147' '#215#170#215#149#215#168#215#148
+'; ('#215#145') '#215#156#215#155#215#145#215#147' '#215#158#215#156#215#158
+#215#147#215#153#215#148' '#215#149#215#153#215#149#215#147#215#162#215#153
+#215#148'. '#215#149#215#145#215#153#215#144#215#149#215#168' '#215#169#215
+#170#215#153' '#215#158#215#166#215#149#215#149#215#170' '#215#144#215#156
+#215#149' '#215#145#215#164#215#168#215#167#215#153#215#157' '#215#144#215
+#156#215#149#13#10#215#148#215#156#215#155#215#149#215#170' '#215#170#215#156
+#215#158#215#149#215#147' '#215#170#215#149#215#168#215#148' '#215#164#215
+#168#215#167' '#215#144
]);
LazarusResources.Add('Lorem ipsum','UNI',[
'Chapter heading spanned over two columns.'#13#10'Lorem ipsum dolor sit amet,'
+' consectetuer adipiscing elit. Integer pede urna, posuere sed, blandit a, v'
+'iverra et, erat. Praesent elementum tellus blandit magna. Duis in turpis ne'
+'c dui accumsan iaculis. Vivamus a velit. Etiam porttitor. Nullam volutpat. '
+'Ut ante justo, accumsan sed, condimentum id, condimentum et, dolor. Aenean '
+'nec sapien. Praesent felis leo, iaculis et, convallis eget, fermentum a, es'
+'t. Etiam consequat sagittis odio. Donec vitae elit. Suspendisse vitae magna'
+'. Suspendisse potenti.'#13#10'Praesent euismod tincidunt dui. Sed quis magn'
+'a. Donec rutrum lacus nec sem semper ultrices. Maecenas cursus. Mauris pell'
+'entesque, erat id pretium consectetuer, massa justo faucibus velit, vitae m'
+'attis ligula felis eget eros. Vestibulum ante. Morbi sit amet sem non liber'
+'o aliquet imperdiet. Proin massa wisi, dignissim eu, aliquam eu, facilisis '
+'ut, dolor. Curabitur gravida, tortor sed blandit adipiscing, mi magna fauci'
+'bus orci, sit amet convallis purus purus eget est. Nam nonummy mi vitae tel'
+'lus. Sed scelerisque. Vivamus at enim.'#13#10'Chapter heading spanned over '
+'two columns.'#13#10'Vestibulum in felis. Quisque ut pede feugiat sem ullamc'
+'orper pulvinar. Praesent nisl nulla, venenatis a, cursus vel, vestibulum vi'
+'tae, enim. Curabitur massa. Nullam pharetra, lorem eget viverra nonummy, nu'
+'lla velit ornare pede, ut dictum diam mauris gravida nisl. Donec non urna s'
+'ed ante interdum congue. Nulla quam. Ut odio nibh, ullamcorper eget, interd'
+'um accumsan, sagittis at, erat. Quisque vel massa. Donec mi elit, tempus qu'
+'is, tempor in, condimentum a, felis.'#13#10'Suspendisse ante. Pellentesque '
+'libero felis, pulvinar sed, ornare nec, vestibulum ac, orci. Donec ac orci.'
+' Donec auctor enim non elit. Curabitur aliquam metus eget turpis. Nullam au'
+'gue libero, tristique vel, rhoncus nec, mollis vel, velit. Lorem ipsum dolo'
+'r sit amet, consectetuer adipiscing elit. Curabitur eget velit et dolor tri'
+'stique hendrerit. Nulla auctor ultricies neque. Class aptent taciti sociosq'
+'u ad litora torquent per conubia nostra, per inceptos hymenaeos. Phasellus '
+'neque. In quam. Sed vestibulum ullamcorper nulla. Nullam vel erat sed arcu '
+'viverra auctor.'#13#10'Chapter heading spanned over two columns.'#13#10'Pra'
+'esent quis sem. In massa erat, viverra at, accumsan a, euismod et, mi. Vest'
+'ibulum nonummy consequat purus. Proin lobortis diam at nisl. Proin leo. Sed'
+' dui quam, luctus sed, tincidunt molestie, vestibulum in, pede. Ut at ligul'
+'a et dui pulvinar lacinia. Morbi molestie mi sit amet mauris. Pellentesque '
+'at est quis sem auctor ornare. Proin venenatis. Sed odio. Nunc varius venen'
+'atis tortor. Aliquam et tortor. Etiam dolor. Quisque eu mauris nec lectus t'
+'incidunt faucibus. Lorem ipsum dolor sit amet, consectetuer adipiscing elit'
+'. Morbi nonummy odio a urna. Cras laoreet.'#13#10'Praesent egestas, lectus '
+'vitae lacinia elementum, augue dolor placerat erat, quis porttitor erat arc'
+'u eu urna. Maecenas in nisl sit amet elit aliquam pellentesque. Integer est'
+'. Nullam ac purus sed lorem pellentesque commodo. Etiam iaculis placerat or'
+'ci. Quisque lobortis massa eget purus. Donec condimentum euismod enim. Sed '
+'nec nibh. Phasellus mi. Donec malesuada, justo volutpat sodales laoreet, ju'
+'sto nunc dictum lacus, ac auctor quam tortor quis lectus.'#13#10'Chapter he'
+'ading spanned over two columns.'#13#10'Duis faucibus nunc non tortor. Cras '
+'pretium. Nulla ullamcorper est eu nulla. In nec wisi sed odio interdum frin'
+'gilla. Donec mattis. Quisque porta adipiscing ipsum. Suspendisse eu ipsum e'
+'t sem commodo iaculis. In lacinia rhoncus tellus. Phasellus placerat nisl e'
+'get risus. Integer pede libero, congue eu, ultricies non, viverra non, nisl'
+'. Phasellus consequat tortor nec lacus. Donec eros augue, luctus ac, tempor'
+' eu, tincidunt eu, quam. Quisque a lorem at lectus suscipit iaculis. Donec '
+'erat. Aliquam mattis porttitor felis. Duis pellentesque metus. Aenean aucto'
+'r neque in arcu. Morbi dui mi, tincidunt vel, interdum at, pulvinar sit ame'
+'t, urna.'#13#10'Duis nec leo. Fusce dignissim. Aliquam erat volutpat. Integ'
+'er a sapien non ligula suscipit vulputate. Vestibulum ac urna eu magna cons'
+'ectetuer pulvinar. Nulla facilisi. Aliquam sed leo. Duis diam lacus, mattis'
+' a, malesuada eu, tincidunt ac, neque. Sed metus. Suspendisse nec velit. Do'
+'nec sed risus. Duis dui massa, ultricies eget, scelerisque sed, gravida ac,'
+' dolor. Maecenas vestibulum, nibh in congue aliquam, lectus odio consequat '
+'ante, ullamcorper fermentum mauris est sed orci. Vestibulum vitae libero qu'
+'is dolor elementum sodales. Praesent et mi.'#13#10'Chapter heading spanned '
+'over two columns.'#13#10'Vestibulum at turpis. Donec id wisi in orci sceler'
+'isque tincidunt. Donec non wisi et massa rutrum semper. Donec tellus. Nulla'
+' mauris. Maecenas ullamcorper, nibh sed pulvinar euismod, enim velit pulvin'
,'ar dolor, sed consectetuer massa metus a metus. Maecenas interdum dictum or'
+'ci. Nunc laoreet, purus sit amet faucibus rhoncus, tortor nunc semper dui, '
+'sit amet egestas justo wisi in elit. Praesent quis orci. Fusce mattis liber'
+'o nec ligula sodales consequat. Integer vulputate.'#13#10'Aliquam semper ul'
+'tricies urna. Curabitur sed dolor at est sollicitudin suscipit. Aenean volu'
+'tpat, ligula nec laoreet fringilla, sapien neque suscipit justo, eget sagit'
+'tis libero dolor et lectus. Quisque eu nulla. Donec enim elit, tristique at'
+', ultricies at, convallis non, ligula. Proin at lectus. Ut ac est. Nunc eu '
+'quam. Cras ac lacus et quam laoreet cursus. Sed sed risus. Nunc ac libero. '
+'Donec fermentum varius neque. Quisque eu lorem in mauris dignissim blandit.'
+' Suspendisse venenatis est non nunc. Cras aliquet, leo vitae tristique volu'
+'tpat, ligula eros lobortis wisi, a rutrum orci arcu in purus. Pellentesque '
+'blandit. Sed eget quam a orci venenatis euismod.'#13#10'Chapter heading spa'
+'nned over two columns.'#13#10'Donec sit amet nulla eget elit luctus nonummy'
+'. Cras ultricies ultricies turpis. Nullam vulputate, nisl vel placerat susc'
+'ipit, lectus turpis porta eros, in nonummy justo eros a pede. Nulla eros. S'
+'ed placerat, odio at commodo convallis, sapien nisl lacinia mauris, quis tr'
+'istique metus lorem quis lorem. Vivamus varius. Cum sociis natoque penatibu'
+'s et magnis dis parturient montes, nascetur ridiculus mus. Integer ut odio.'
+' Suspendisse venenatis venenatis augue. Praesent aliquam libero nec eros. M'
+'orbi nunc. Suspendisse pellentesque arcu at massa. Nunc ut erat. Vivamus le'
+'ctus eros, sodales sit amet, faucibus vitae, tristique quis, elit. Cras sod'
+'ales. Curabitur lacus augue, ultricies at, porta vel, fringilla non, nunc. '
+'Integer eu neque. Ut at erat.'#13#10'Proin ante. Sed vehicula neque commodo'
+' libero. Nam gravida lacinia purus. Nulla sed nunc vitae urna condimentum p'
+'orttitor. Suspendisse tincidunt, tellus at euismod nonummy, justo leo vulpu'
+'tate nulla, sed pharetra dui massa et magna. Cum sociis natoque penatibus e'
+'t magnis dis parturient montes, nascetur ridiculus mus. Duis elit. Curabitu'
+'r sit amet lorem sed nunc condimentum tincidunt. Nam ultrices cursus ante. '
+'Aenean sodales ullamcorper wisi. Donec egestas diam sit amet wisi. Mauris c'
+'onvallis lacus.'#13#10'Chapter heading spanned over two columns.'#13#10'Sus'
+'pendisse urna eros, bibendum venenatis, imperdiet sit amet, ultricies ut, n'
+'ibh. Cras ac eros. Donec malesuada. Quisque tincidunt ante porta neque. Eti'
+'am libero. Phasellus dolor quam, convallis et, vehicula vel, mattis nec, pu'
+'rus. Quisque sit amet lacus. Vivamus vel risus. Nulla purus massa, bibendum'
+' et, eleifend nec, suscipit non, magna. Integer tellus. Aenean nonummy tinc'
+'idunt massa.'#13#10'Donec ac elit sit amet wisi molestie convallis. Proin t'
+'ortor orci, luctus non, egestas ut, ultrices ut, mi. Ut at leo. Nunc in orc'
+'i eget dui volutpat pretium. In tortor. Lorem ipsum dolor sit amet, consect'
+'etuer adipiscing elit. Vivamus risus. Cras tempus tortor in purus. Nullam d'
+'ictum vulputate est. Sed in nulla. Duis a tellus. Etiam ut pede. Duis purus'
+' tellus, mattis eu, venenatis ac, dignissim at, metus. Sed placerat, diam i'
+'n interdum iaculis, libero sem fermentum wisi, a venenatis tortor felis sit'
+' amet mi.'#13#10'Chapter heading spanned over two columns.'#13#10'Maecenas '
+'rhoncus lacinia erat. Integer bibendum, erat nec luctus adipiscing, lorem r'
+'isus convallis nibh, non cursus wisi felis eu mi. Curabitur elementum augue'
+' at mauris. Integer eget neque. Nulla eleifend urna et tellus. Phasellus so'
+'dales augue ut augue. Phasellus urna ligula, ornare quis, ornare sed, tempu'
+'s vitae, orci. Sed bibendum gravida tellus. Morbi sit amet nunc sed dolor t'
+'incidunt viverra. Phasellus quis metus. Suspendisse sagittis luctus lacus. '
+'Integer nec turpis. Mauris massa. Etiam justo felis, convallis sed, gravida'
+' sed, aliquet in, dolor. Cras facilisis vulputate dui. Cum sociis natoque p'
+'enatibus et magnis dis parturient montes, nascetur ridiculus mus.'#13#10'Ma'
+'uris est augue, ornare nec, imperdiet at, tincidunt vitae, sapien. In hac h'
+'abitasse platea dictumst. Nullam dapibus, nulla in fermentum imperdiet, fel'
+'is ipsum blandit felis, a viverra dui neque et ante. Maecenas ligula massa,'
+' dignissim eu, vehicula a, tempor in, elit. Vestibulum et dui. Maecenas pul'
+'vinar elementum enim. Nam neque arcu, rhoncus sit amet, mattis at, bibendum'
+' quis, nulla. Donec tellus nisl, ullamcorper id, varius eu, sollicitudin eg'
+'et, justo. Duis id wisi sit amet pede fermentum ultrices. Nullam magna odio'
+', accumsan non, vestibulum id, convallis ut, est. Proin neque tellus, variu'
+'s eu, euismod quis, venenatis vel, libero. Nunc lorem wisi, posuere quis, m'
+'attis et, auctor eu, elit. Maecenas vitae velit. Nullam diam. Sed libero ni'
+'bh, varius ut, venenatis a, ultrices at, nulla. Donec nec tellus. Mauris ve'
,'l quam a odio nonummy rhoncus.'#13#10'Chapter heading spanned over two colu'
+'mns.'#13#10'Suspendisse potenti. Cras at dui in lorem tristique porttitor. '
+'Nulla in elit. Mauris quis turpis et libero rutrum fermentum. Curabitur eni'
+'m. In non velit. Etiam dapibus rutrum wisi. Donec iaculis tincidunt nisl. V'
+'ivamus nec velit. Maecenas turpis eros, molestie vitae, accumsan a, congue '
+'at, mi. Sed nulla tellus, tempor et, consequat id, vehicula vitae, arcu. In'
+' hac habitasse platea dictumst. Nulla facilisi. Cum sociis natoque penatibu'
+'s et magnis dis parturient montes, nascetur ridiculus mus. Ut est sapien, c'
+'ongue nec, luctus in, tincidunt ut, metus.'#13#10'Mauris laoreet. Proin por'
+'ttitor accumsan ligula. Class aptent taciti sociosqu ad litora torquent per'
+' conubia nostra, per inceptos hymenaeos. Vestibulum ac enim sed neque imper'
+'diet lobortis. In at leo. Lorem ipsum dolor sit amet, consectetuer adipisci'
+'ng elit. Donec non est. Sed vel neque ut felis mollis placerat. Morbi lacin'
+'ia, sapien nec mattis venenatis, est elit ultrices lorem, et bibendum augue'
+' ipsum nec justo. Pellentesque sit amet eros. Mauris ac quam id est iaculis'
+' lobortis. In placerat, ante quis tristique suscipit, wisi leo commodo lacu'
+'s, vel pulvinar dolor dolor id quam. Curabitur ac nisl. Duis sit amet torto'
+'r at lorem molestie vulputate. Duis posuere. Ut nec erat. Cras eget purus.'
+#13#10'Chapter heading spanned over two columns.'#13#10'Aliquam a nunc id la'
+'cus pulvinar tincidunt. Vestibulum ante ipsum primis in faucibus orci luctu'
+'s et ultrices posuere cubilia Curae; Vestibulum tempus, sapien vitae fringi'
+'lla ultrices, nibh tortor sodales ante, ut bibendum diam risus nec eros. Su'
+'spendisse potenti. Quisque quis magna sit amet mauris bibendum molestie. Cr'
+'as suscipit purus at metus. Quisque id erat vel turpis sodales ullamcorper.'
+' Sed sed enim. Morbi ac magna. Phasellus ac justo non nisl interdum semper.'
+' Aliquam eleifend, odio et lacinia semper, leo odio mattis neque, non ultri'
+'cies magna sapien sit amet eros.'#13#10'Sed dapibus. Proin euismod lectus e'
+'t nunc. Aliquam dolor eros, tincidunt vitae, lobortis vitae, laoreet vel, a'
+'nte. Praesent et diam vel velit volutpat varius. Nunc mauris neque, luctus '
+'vel, aliquam a, egestas id, nunc. In sollicitudin viverra tellus. Pellentes'
+'que bibendum, nulla ac blandit volutpat, justo tellus pharetra ipsum, sit a'
+'met pellentesque nunc mauris in elit. Duis nec neque quis leo faucibus orna'
+'re. Phasellus euismod velit sit amet nibh. Nullam dictum. In dolor lacus, a'
+'liquet id, egestas sit amet, aliquet at, orci.'#13#10
]);

135
components/virtualtreeview-new/branches/4.8/demos/dataarray/Main.lfm Normal file
View File

@ -0,0 +1,135 @@
object Form1: TForm1
Left = 188
Height = 437
Top = 104
Width = 612
ActiveControl = Button1
Caption = 'Form1'
ClientHeight = 437
ClientWidth = 612
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnClose = FormClose
OnCreate = FormCreate
LCLVersion = '0.9.27'
object Label1: TLabel
Left = 207
Height = 14
Top = 351
Width = 149
Anchors = [akRight, akBottom]
Caption = 'Array data of the clicked node'
ParentColor = False
end
object Label2: TLabel
Left = 367
Height = 14
Top = 335
Width = 222
Anchors = [akRight, akBottom]
Caption = 'Find and show the node by specific array index'
ParentColor = False
end
object Label3: TLabel
Left = 367
Height = 14
Top = 351
Width = 237
Anchors = [akRight, akBottom]
Caption = 'Type index to get related tree node on the screen:'
ParentColor = False
end
object Button1: TButton
Left = 8
Height = 25
Top = 342
Width = 83
Anchors = [akLeft, akBottom]
BorderSpacing.InnerBorder = 4
Caption = 'Add nodes'
OnClick = Button1Click
TabOrder = 0
end
object btnDelete: TButton
Left = 96
Height = 25
Top = 342
Width = 97
Anchors = [akLeft, akBottom]
BorderSpacing.InnerBorder = 4
Caption = 'Delete selected'
OnClick = btnDeleteClick
TabOrder = 1
end
object Edit1: TEdit
Left = 208
Height = 21
Top = 376
Width = 153
Anchors = [akRight, akBottom]
ReadOnly = True
TabOrder = 2
end
object btnCleanAll: TButton
Left = 56
Height = 25
Top = 374
Width = 75
Anchors = [akLeft, akBottom]
BorderSpacing.InnerBorder = 4
Caption = 'Clean all'
OnClick = btnCleanAllClick
TabOrder = 3
end
object Edit2: TEdit
Left = 368
Height = 21
Top = 378
Width = 97
Anchors = [akRight, akBottom]
OnChange = Edit2Change
TabOrder = 4
end
object MyTree: TVirtualStringTree
Left = 3
Height = 321
Top = 8
Width = 605
Anchors = [akTop, akLeft, akRight, akBottom]
AutoScrollDelay = 1
BorderStyle = bsSingle
DefaultText = 'Node'
Header.Columns = <
item
Text = 'Text'
Width = 150
end
item
Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
Position = 1
Text = 'Pointers'
Width = 300
end
item
Position = 2
Text = 'Random'
Width = 100
end>
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoShowSortGlyphs, hoVisible]
Header.SortColumn = 0
Header.Style = hsXPStyle
RootNodeCount = 10
TabOrder = 5
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking]
TreeOptions.SelectionOptions = [toMultiSelect]
OnBeforeCellPaint = MyTreeBeforeCellPaint
OnCompareNodes = MyTreeCompareNodes
OnFocusChanged = MyTreeFocusChanged
OnFreeNode = MyTreeFreeNode
OnGetText = MyTreeGetText
OnPaintText = MyTreePaintText
OnHeaderClick = MyTreeHeaderClick
end
end

549
components/virtualtreeview-new/branches/4.8/demos/dataarray/Main.pas Normal file
View File

@ -0,0 +1,549 @@
unit Main;
{$MODE Delphi}
{
How to use TVirtualTree with your data
already stored somewhere (array or memory)?
You need to solve cross-linked problem between
your data and TVirtualTree record node and avoid
doubling data in TVirtualTree record node?
This example shows one way of what you need
to accomplish.
Additionally, here you can find how to
conditionally color you cell's background
and font foreground and how to sort VST by
clicking on columns.
Also shows which property are initially needed
to be set for comfortable using.
This is my humble contribution for
users who start to use Mike Lischke's
TVirtualTree component.
Thank you Mike for such a beautiful component.
The initial developer of this code is Sasa Zeman.
Mailto: public@szutils.net or sasaz72@mail.ru
Web site: www.szutils.net
Created: 7 Jun 2004
This example is distributed "AS IS", WITHOUT
WARRANTY OF ANY KIND, either express or implied.
You use it at your own risk!
}
interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, StdCtrls, LResources, Buttons;
type
{ Problem description:
VST is designed to use your own declared record data
in his nodes, which are automatically created and
destroying. That is beautiful, easy and fast.
But, what if you have your data already formated somewhere
in array or memory and your algorithms are already optimized
to use it on that way? How to use VST with them?
Since VST node can consist any data record, that can be only
a index or pointer to your real data. The only problem left is
that actions in your data must affect on corespondent VST node.
One way is to sequentially go through the VST and find the node
which consists equal index index, which rapidly decrease
performance...
To handle this situation the most efficiently, your array data
record must additionally consist the pointer to the VST
corespondent node...
}
TMyRecord = record
// Point directly from my record to corespondent VST Node
// That is useful if your action inside
// the record involve on your VTS node,
// for example, if disabling mean deletion
// of corespondent node, etc.
NodePointer: PVirtualNode;
Active: Boolean;
MyText: String;
RNDNumber: integer;
end;
rTreeData = record
//This point to my index into my array
//Instead of index, here you can
//store the pointer to your data.
//That depend of what is your intentions
//and your data structure
IndexInMyData: integer;
end;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
btnDelete: TButton;
Edit1: TEdit;
btnCleanAll: TButton;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
MyTree: TVirtualStringTree;
procedure MyTreeBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
procedure MyTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure Button1Click(Sender: TObject);
procedure MyTreeCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure MyTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure btnDeleteClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MyTreePaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
procedure MyTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure MyTreeFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnCleanAllClick(Sender: TObject);
procedure Edit2Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyArrayData: array of TMyRecord;
implementation
uses
Math;
procedure TForm1.MyTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
var
Data: ^rTreeData;
begin
// To get Node Data
Data := Sender.GetNodeData(Node);
with MyArrayData[Data.IndexInMyData] do
case Column of
0: CellText := MyText;
1:
begin
CellText := format('Stored %p Actual %p',
[NodePointer,Node]);
end;
2: CellText := inttostr(RNDNumber);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Node: PVirtualNode;
Data: ^rTreeData;
i,Idx: integer;
Timer: cardinal;
begin
// Add 100000 new records and corespondent VST nodes
Timer := GetTickCount;
MyTree.BeginUpdate;
Idx := length(MyArrayData);
SetLength(MyArrayData, length(MyArrayData)+100000);
for i := 1 to 100000 do
begin
// Add a node to the root of the Tree
Node := MyTree.AddChild(nil);
Data := MyTree.GetNodeData(Node);
//Create link to your data record into VST node
Data.IndexInMyData := Idx;
// Working with your array data
with MyArrayData[Data.IndexInMyData] do
begin
//Create link into your data record to VST node
NodePointer := Node;
RNDNumber := round(Random(1 shl 16));
MyText := format(' Index %d',[Data.IndexInMyData])
end;
inc(Idx)
end;
MyTree.EndUpdate;
Timer := GetTickCount-Timer;
caption := format('Adding %d ms, Total nodes %d, Total arrays %d',[Timer, MyTree.RootNodeCount,length(MyArrayData)] );
end;
procedure TForm1.MyTreeCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
n1,n2: ^rTreeData;
d1,d2: ^TMyRecord;
begin
n1 := MyTree.GetNodeData(Node1);
n2 := MyTree.GetNodeData(Node2);
// Get the pointers where your data are
// in the array, to speed-up process
d1 := @MyArrayData[n1.IndexInMyData];
d2 := @MyArrayData[n2.IndexInMyData];
case Column of
0: Result := CompareValue(n1.IndexInMyData,n2.IndexInMyData);
1: ;
2: Result := CompareValue(
d1.RNDNumber,
d2.RNDNumber
)
else
Result := 0;
end
end;
procedure TForm1.MyTreeHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Direction : TSortDirection;
begin
// Descending order with pressed Shift, otherwise Ascending
// Or you can save Direction or use
// MyTree.Header.SortDirection and MyTree.Header.SortColumn
// to get automatically Descending/Ascending sorting
// by only clicking on header
if ssShift in Shift
then
Direction := sdDescending
else
Direction := sdAscending;
// Sort all columns except the second
if Column<>1 then
begin
// Set direction image on the sorted column
MyTree.Header.SortColumn := Column;
// Set the right direction image
MyTree.Header.SortDirection := Direction;
// Sorting process
MyTree.SortTree(Column, Direction);
end
end;
procedure TForm1.btnDeleteClick(Sender: TObject);
var
Timer: cardinal;
begin
// Delete all selected nodes
Timer := GetTickCount;
MyTree.BeginUpdate;
MyTree.DeleteSelectedNodes;
MyTree.EndUpdate;
Timer := GetTickCount-Timer;
caption := format('Deleting %d ms, Total nodes %d, Total arrays %d',[Timer, MyTree.RootNodeCount,length(MyArrayData)] );
end;
procedure TForm1.FormCreate(Sender: TObject);
const
ColumnParams: array[0..2] of
record
Name: ShortString;
Len: integer;
Alignment:TAlignment;
end =
((Name:'Text' ; Len:150 ; Alignment: taLeftJustify),
(Name:'Pointers' ; Len:300 ; Alignment: taLeftJustify),
(Name:'Random' ; Len:120 ; Alignment: taLeftJustify)
);
var
NewColumn: TVirtualTreeColumn;
i: integer;
begin
// Initialize size of node in MyTree
// This is the most important to be done before any using of VST,
// because that is the only way how VST can allocate needed
// space for your node
MyTree.NodeDataSize := sizeof(rTreeData);
// When you add data by yourself,
// be sure that there is no node in tree
MyTree.RootNodeCount := 0;
// If you want to manually set necessary events or parameters,
// without Object Inspector. That will help in case
// you have accidentally deleted your component
// and you do not have a time to work with Object Inspector
// and rearrange the events or other properties
// First follows the properties you may set it here or with
// Object Inspector to be more suitable for standard using
// Shows the header columns
MyTree.Header.Options :=
MyTree.Header.Options + [hoVisible];
// Shows the header like XP does
MyTree.Header.Style := hsXPStyle;
// Allows multi selection of nodes
MyTree.TreeOptions.SelectionOptions :=
MyTree.TreeOptions.SelectionOptions +[toMultiSelect];
// Allows that automatic multi selection is possible
// beyond the screen
MyTree.TreeOptions.AutoOptions :=
MyTree.TreeOptions.AutoOptions + [toAutoScroll];
// If delay of 1000 ms is too slow during
// automatic multi selection
MyTree.AutoScrollDelay := 100;
// Disable automatic deletion of moved data during
// Drag&Drop operation
MyTree.TreeOptions.AutoOptions :=
MyTree.TreeOptions.AutoOptions - [toAutoDeleteMovedNodes];
// To show the bacground image on VST
MyTree.TreeOptions.PaintOptions :=
MyTree.TreeOptions.PaintOptions +[toShowBackground];
// If you do not want to show the tree lines
// MyTree.TreeOptions.PaintOptions :=
// MyTree.TreeOptions.PaintOptions -[toShowTreeLines];
// If you do not want to show left margine of the main node
// MyTree.TreeOptions.PaintOptions :=
// MyTree.TreeOptions.PaintOptions -[toShowRoot];
// If you want to add your columns manually
MyTree.Header.Columns.Clear;
for i := 0 to length(ColumnParams)-1 do
with MyTree.Header, ColumnParams[i] do
begin
NewColumn := Columns.Add;
NewColumn.Text := Name;
NewColumn.Width := Len;
NewColumn.Alignment := Alignment;
end;
// If you want that the second column
// do not respond on clicking
MyTree.Header.Columns[1].Options :=
MyTree.Header.Columns[1].Options - [coAllowClick];
// Setting used events manually
MyTree.OnBeforeCellPaint := MyTreeBeforeCellPaint;
MyTree.OnCompareNodes := MyTreeCompareNodes;
MyTree.OnFocusChanged := MyTreeFocusChanged;
MyTree.OnFreeNode := MyTreeFreeNode;
MyTree.OnGetText := MyTreeGetText;
MyTree.OnHeaderClick := MyTreeHeaderClick;
MyTree.OnPaintText := MyTreePaintText;
// To show headers
MyTree.Header.Options :=
MyTree.Header.Options + [hoVisible];
//To show Direction Glyphs
MyTree.Header.Options :=
MyTree.Header.Options + [hoShowSortGlyphs];
end;
procedure TForm1.MyTreeBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
begin
// This is example how to conditionally
// color the cell's backgrounds
// Color cell's background only for
// the first three columns with every second nodes
if (Column<2) and
((Node.Index mod 2)=0)
then begin
TargetCanvas.Brush.Color := clYellow;
TargetCanvas.FillRect(CellRect);
end
end;
procedure TForm1.MyTreePaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
var
n1: ^rTreeData;
d1: ^TMyRecord;
begin
// This is example how to conditionally
// color the cell's font color foregrounds
if (Column=1) and
((Node.Index mod 2)=0)
then
TargetCanvas.Font.Color := clRed;
if (Column=2)
then begin
n1 := MyTree.GetNodeData(Node);
d1 := @MyArrayData[n1.IndexInMyData];
// Coloring cell's data depending of your data
if (d1.RNDNumber mod 2)=0
then begin
TargetCanvas.Font.Color := clBlue;
TargetCanvas.Font.Style := [fsBold];
end;
end;
end;
procedure TForm1.MyTreeFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
n1: ^rTreeData;
d1: ^TMyRecord;
begin
// Action when you delete the VST node
if Node <> nil then
begin
n1 := MyTree.GetNodeData(Node);
d1 := @MyArrayData[n1.IndexInMyData];
// Deactive record in array
d1.Active := false;
// Detach pointer to this node in your data
d1.NodePointer := nil
end;
end;
procedure TForm1.MyTreeFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
n1: ^rTreeData;
d1: ^TMyRecord;
begin
// Always be sure that Node exist before you
// delete VST node and use OnFocusChanged even
// in your code - they will be always triggered
// on node deletion
if Node<> nil then
begin
n1 := MyTree.GetNodeData(Node);
d1 := @MyArrayData[n1.IndexInMyData];
// Store MyText from array to TEdit
// after focused item was changed
Edit1.Text := d1.MyText+', Number '+ IntToStr(d1.RNDNumber)
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
btnCleanAll.Click
end;
procedure TForm1.btnCleanAllClick(Sender: TObject);
begin
// Fast deletion of all your data and VST nodes
MyTree.OnFreeNode := nil;
MyTree.Clear;
SetLength(MyArrayData,0);
MyTree.OnFreeNode := MyTreeFreeNode
end;
procedure TForm1.Edit2Change(Sender: TObject);
var
Node: PVirtualNode;
ind: integer;
begin
ind := StrToIntDef(Edit2.Text,0);
if ind<length(MyArrayData) then
begin
Node := MyArrayData[ind].NodePointer;
if Node<> nil then
begin
// Show it at center of VST
MyTree.ScrollIntoView(Node,True);
// Get text from the array
Edit1.Text :=
MyArrayData[ind].MyText+', Number '+ IntToStr(MyArrayData[ind].RNDNumber)
end else
Edit1.Text := 'Node do not exist!'
end
end;
initialization
{$i Main.lrs}
end.

68
components/virtualtreeview-new/branches/4.8/demos/dataarray/dataarray.lpi Normal file
View File

@ -0,0 +1,68 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<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="2">
<Item1>
<PackageName Value="virtualtreeview_package"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="dataarray.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="dataarray"/>
</Unit0>
<Unit1>
<Filename Value="Main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

18
components/virtualtreeview-new/branches/4.8/demos/dataarray/dataarray.lpr Normal file
View File

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

2246
components/virtualtreeview-new/branches/4.8/demos/images/Unit1.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

316
components/virtualtreeview-new/branches/4.8/demos/images/Unit1.pas Normal file
View File

@ -0,0 +1,316 @@
{
This example shows how to manipulate with imagse for each cell.
Also support sorting by column clicking and
way to drawing in a cell
The initial developer of this code is Sasa Zeman.
Mailto: public@szutils.net or sasaz72@mail.ru
Web site: www.szutils.net
Created: 7 Jun 2004
Modified: 10 March 2005
This example is distributed "AS IS", WITHOUT
WARRANTY OF ANY KIND, either express or implied.
You use it at your own risk!
Adapted for LCL by Luiz Am�rico
}
unit Unit1;
{$MODE Delphi}
interface
uses
DelphiCompat, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, LResources;
type
{ TForm1 }
TForm1 = class(TForm)
VST1: TVirtualStringTree;
ImageList1: TImageList;
ImageList2: TImageList;
procedure FormCreate(Sender: TObject);
procedure VST1BeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
procedure VST1InitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VST1GetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
procedure VST1Checking(Sender: TBaseVirtualTree; Node: PVirtualNode;
var NewState: TCheckState; var Allowed: Boolean);
procedure VST1HeaderClick(Sender: TVTHeader; Column: TColumnIndex;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure VST1CompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
PMyRec = ^TMyRec;
TMyRec = record
Main: String;
One, Two: integer;
Percent : integer;
Index: Integer;
end;
var
Form1: TForm1;
implementation
uses Math;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Link images in ImageList2 to VST1.StateImages if it
// not set already in Oject Inspector
// It is important to link to VST1.StateImages
// since we need to use images to all cells
// (in all columns, not only for main column)
// Otherwise it will not work properly with VST1.Images
// VST1.StateImages:= ImageList2;
// Set data size of data record used for each tree
VST1.NodeDataSize := SizeOf(TMyRec);
// Number of initial nodes
VST1.RootNodeCount := 20;
// Set XP syle for CheckImage
VST1.CheckImageKind:=ckXP;
//Start random number generator
Randomize
end;
procedure TForm1.VST1BeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
I, PercentageSize, RndPercent: integer;
ColorStart: Word;
Data: PMyRec;
R,G,B: byte;
begin
if (Column = 3) then
begin
Data := Sender.GetNodeData(Node);
RndPercent:=Data.Percent;
InflateRect(CellRect, -1, -1);
DrawEdge(TargetCanvas.Handle, CellRect, EDGE_SUNKEN, BF_ADJUST or BF_RECT);
PercentageSize := (CellRect.Right - CellRect.Left) * RndPercent div 100;
if True then
//Multi color approach
begin
ColorStart :=clYellow;
R:= GetRValue(ColorStart);
G:= GetGValue(ColorStart);
B:= GetBValue(ColorStart);
for I := CellRect.Right downto CellRect.Left do
begin
TargetCanvas.Brush.Color := RGB(R,G,B);
if CellRect.Right - CellRect.Left <= PercentageSize then
TargetCanvas.FillRect(CellRect);
Dec(CellRect.Right);
Dec(G);
end;
end else
//One color approach
begin
CellRect.Right := CellRect.Left + PercentageSize;
if RndPercent = 100 then
TargetCanvas.Brush.Color := clRed
else
TargetCanvas.Brush.Color := clLime;
TargetCanvas.FillRect(CellRect);
end;
end;
end;
procedure TForm1.VST1InitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
Data: PMyRec;
s: string;
begin
Data:=Sender.GetNodeData(Node);
// Data nitialization during node initialization
s:= Format('Level %3d, Index %3d', [Sender.GetNodeLevel(Node), Node.Index]);
Data.Main:='Main ' + s;
Data.One := Random(ImageList2.Count);
Data.Two := Random(ImageList2.Count);
Data.Percent := Random (101);
//fpc does not has RandomRange
//Data.Percent := RandomRange(0,100);
Data.Index:= Node.Index;
// Following code can be coded much efficiantly,
// but than again it works for now
// and determinate CheckType for each node
if Data.Index>=0 then
// Set RadioButton
Node.CheckType := ctRadioButton;
if Data.Index>=4 then
// Set CheckBox
Node.CheckType:= ctCheckBox;
if Data.Index>=8 then
// Set Button
Node.CheckType:= ctButton;
if Data.Index>=12 then
// Set ctTriStateCheckBox
Node.CheckType:= ctTriStateCheckBox;
if Data.Index>=16 then
// Set nothing
Node.CheckType:= ctNone;
end;
procedure TForm1.VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
var
Data: PMyRec;
begin
Data:=Sender.GetNodeData(Node);
case column of
0: CellText:=Data.Main;
1: CellText:=IntToStr(Data.One);
2: CellText:=IntToStr(Data.Two);
3: CellText:=IntToStr(Data.Percent)+'%';
end
end;
procedure TForm1.VST1GetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
var
Data: PMyRec;
begin
Data := Sender.GetNodeData(Node);
{
Kind:=ikNormal;
ikNormal,
ikSelected,
ikState,
ikOverlay
}
// Conditional image index setting for each cell (node and column)
case Column of
0: if Data.Index<12 then
ImageIndex:=3
else
ImageIndex:=25;
1: ImageIndex:=Data.One;
2: ImageIndex:=Data.Two;
end;
end;
procedure TForm1.VST1Checking(Sender: TBaseVirtualTree; Node: PVirtualNode;
var NewState: TCheckState; var Allowed: Boolean);
var
Data: PMyRec;
s: string;
begin
Data := Sender.GetNodeData(Node);
// Determinate which CheckType is pressed
// Instead of this, here can be some real action
case Node.CheckType of
ctTriStateCheckBox: s:='TriStateCheckBox';
ctCheckBox : s:='CheckBox';
ctRadioButton : s:='RadioButton';
ctButton : s:='Button';
end;
caption:=s+' '+Data.Main;
Allowed:=true
end;
procedure TForm1.VST1HeaderClick(Sender: TVTHeader; Column: TColumnIndex;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
// Determinate sorting direction
if Button=mbLeft then
with Sender do
begin
if SortColumn <> Column then
SortColumn := Column
else begin
if SortDirection = sdAscending then
SortDirection := sdDescending
else
SortDirection := sdAscending
end;
// Initiate sorting
VST1.SortTree(Column, Sender.SortDirection, False);
end;
end;
procedure TForm1.VST1CompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
Data1, Data2: PMyRec;
begin
Data1:=Sender.GetNodeData(Node1);
Data2:=Sender.GetNodeData(Node2);
// Depending on column in VST1.SortTree(...)
// returns comparing result to internal sorting procedure
Result:=0;
case column of
0: Result:=CompareStr(Data1.Main,Data2.Main);
1: begin
Result:=CompareValue(Data1.One,Data2.One);
// If numbers are equal, compare value from next column
// On this way we product more complex sorting
if Result=0 then
Result:=CompareValue(Data1.Two,Data2.Two);
end;
2: Result:=CompareValue(Data1.Two,Data2.Two);
3: Result:=CompareValue(Data1.Percent,Data2.Percent);
end
end;
initialization
{$i Unit1.lrs}
end.

68
components/virtualtreeview-new/branches/4.8/demos/images/images.lpi Normal file
View File

@ -0,0 +1,68 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<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="2">
<Item1>
<PackageName Value="virtualtreeview_package"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="images.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="images"/>
</Unit0>
<Unit1>
<Filename Value="Unit1.pas"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

30
components/virtualtreeview-new/branches/4.8/demos/images/images.lpr Normal file
View File

@ -0,0 +1,30 @@
program images;
{$mode objfpc}{$H+}
{$define DEBUG_VTV}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, Unit1
{$ifdef DEBUG_VTV}
,ipcchannel, vtlogger
{$endif}
;
begin
{$ifdef DEBUG_VTV}
Logger.Channels.Add(TIPCChannel.Create);
Logger.Clear;
Logger.ActiveClasses := [lcHeaderOffset];
{$endif}
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

98
components/virtualtreeview-new/branches/4.8/demos/mininal/Main.lfm Normal file
View File

@ -0,0 +1,98 @@
object MainForm: TMainForm
Left = 340
Height = 486
Top = 147
Width = 427
ActiveControl = VST
Caption = 'Simple Virtual Treeview demo'
ClientHeight = 486
ClientWidth = 427
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
LCLVersion = '0.9.27'
object Label1: TLabel
Left = 10
Height = 14
Top = 8
Width = 112
Caption = 'Last operation duration:'
ParentColor = False
end
object VST: TVirtualStringTree
Left = 10
Height = 360
Top = 24
Width = 410
BorderStyle = bsSingle
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
DefaultText = 'Node'
Header.AutoSizeIndex = -1
Header.Columns = <>
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
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
end
object ClearButton: TButton
Left = 97
Height = 25
Top = 452
Width = 183
BorderSpacing.InnerBorder = 4
Caption = 'Clear tree'
OnClick = ClearButtonClick
TabOrder = 1
end
object AddOneButton: TButton
Left = 97
Height = 25
Top = 392
Width = 183
BorderSpacing.InnerBorder = 4
Caption = 'Add node(s) to root'
OnClick = AddButtonClick
TabOrder = 2
end
object Edit1: TEdit
Left = 10
Height = 21
Top = 392
Width = 79
TabOrder = 3
Text = '1'
end
object Button1: TButton
Tag = 1
Left = 96
Height = 25
Top = 422
Width = 184
BorderSpacing.InnerBorder = 4
Caption = 'Add node(s) as children'
OnClick = AddButtonClick
TabOrder = 4
end
object CloseButton: TButton
Left = 345
Height = 25
Top = 452
Width = 75
BorderSpacing.InnerBorder = 4
Caption = 'Close'
OnClick = CloseButtonClick
TabOrder = 5
end
end

189
components/virtualtreeview-new/branches/4.8/demos/mininal/Main.pas Normal file
View File

@ -0,0 +1,189 @@
unit Main;
{$MODE Delphi}
{.$define DEBUG_VTV}
// Demonstration project for TVirtualStringTree to generally show how to get started.
// Written by Mike Lischke.
interface
uses
{$ifdef DEBUG_VTV}
vtlogger, ipcchannel,
{$endif}
LCLIntf, 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: String);
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: String;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.FormCreate(Sender: TObject);
begin
{$ifdef DEBUG_VTV}
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: String);
var
Data: PMyRec;
begin
// A handler for the OnGetText event is always needed as it provides the tree with the string data to display.
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-new/branches/4.8/demos/mininal/Minimal.exe.Manifest Normal file
View File

@ -0,0 +1 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity processorArchitecture="*" version="5.1.0.0" type="win32" name="Microsoft.Windows.Shell.shell32"/> <description>Windows Shell</description> <dependency> <dependentAssembly> <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*" /> </dependentAssembly> </dependency> </assembly>

61
components/virtualtreeview-new/branches/4.8/demos/mininal/minimal_lcl.lpi Normal file
View File

@ -0,0 +1,61 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<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="2">
<Item1>
<PackageName Value="virtualtreeview_package"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="minimal_lcl.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="minimal_lcl"/>
</Unit0>
<Unit1>
<Filename Value="Main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

18
components/virtualtreeview-new/branches/4.8/demos/mininal/minimal_lcl.lpr Normal file
View File

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

216
components/virtualtreeview-new/branches/4.8/demos/objects/MVCDemoMain.lfm Normal file
View File

@ -0,0 +1,216 @@
object fmMVCDemo: TfmMVCDemo
Left = 165
Height = 518
Top = 154
Width = 742
HorzScrollBar.Page = 741
VertScrollBar.Page = 517
ActiveControl = edCaption
Caption = 'Virtual Tree - MVC Demo written by Marian Aldenhövel'
ClientHeight = 518
ClientWidth = 742
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
object pnlControls: TPanel
Height = 118
Top = 400
Width = 742
Align = alBottom
BevelInner = bvLowered
BevelOuter = bvNone
Caption = ' '
ClientHeight = 118
ClientWidth = 742
TabOrder = 0
object Label1: TLabel
Left = 72
Height = 17
Top = 7
Width = 61
Alignment = taRightJustify
Caption = 'Caption:'
Color = clNone
ParentColor = False
end
object Label3: TLabel
Left = 47
Height = 17
Top = 31
Width = 86
Alignment = taRightJustify
Caption = 'Subcaption:'
Color = clNone
ParentColor = False
end
object Label4: TLabel
Left = 8
Height = 17
Top = 55
Width = 125
Alignment = taRightJustify
Caption = 'Incidence (0..63):'
Color = clNone
ParentColor = False
end
object Label2: TLabel
Left = 256
Height = 97
Top = 5
Width = 296
Caption = 'Edit the current node.'#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 = 136
Height = 21
Top = 5
Width = 112
OnChange = edCaptionChange
TabOrder = 0
Text = 'edCaption'
end
object edSubcaption: TEdit
Left = 136
Height = 21
Top = 29
Width = 112
OnChange = edSubcaptionChange
TabOrder = 1
Text = 'edCaption'
end
object edIncidence: TEdit
Left = 136
Height = 21
Top = 53
Width = 51
OnChange = edIncidenceChange
OnKeyDown = nil
OnKeyPress = edIncidenceKeyPress
TabOrder = 2
Text = '0'
end
object UpDown1: TUpDown
Left = 187
Height = 21
Top = 53
Width = 15
Associate = edIncidence
Max = 63
TabOrder = 3
end
object btnAdd: TButton
Left = 560
Height = 25
Top = 8
Width = 112
BorderSpacing.InnerBorder = 4
Caption = '+ Add a child'
OnClick = btnAddClick
TabOrder = 4
end
object btnDelete: TButton
Left = 560
Height = 25
Top = 40
Width = 112
BorderSpacing.InnerBorder = 4
Caption = '- Delete node'
OnClick = btnDeleteClick
TabOrder = 5
end
object cbLive: TCheckBox
Left = 680
Height = 24
Top = 8
Width = 58
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

218
components/virtualtreeview-new/branches/4.8/demos/objects/MVCDemoMain.pas Normal file
View File

@ -0,0 +1,218 @@
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, SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
MVCTypes,MVCPanel,StdCtrls,ExtCtrls,VirtualTrees,ComCtrls,
Buttons, LResources;
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
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.

128
components/virtualtreeview-new/branches/4.8/demos/objects/MVCPanel.pas Normal file
View File

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

1050
components/virtualtreeview-new/branches/4.8/demos/objects/MVCTypes.pas Normal file
View File

File diff suppressed because it is too large Load Diff

74
components/virtualtreeview-new/branches/4.8/demos/objects/mvcdemo.lpi Normal file
View File

@ -0,0 +1,74 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="6"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<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="lclextensions_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"/>
<ResourceBaseClass Value="Form"/>
<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="8"/>
<PathDelim Value="\"/>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

18
components/virtualtreeview-new/branches/4.8/demos/objects/mvcdemo.lpr Normal file
View File

@ -0,0 +1,18 @@
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, lclextensions_package;
begin
Application.Initialize;
Application.CreateForm(TfmMVCDemo, fmMVCDemo);
Application.Run;
end.

916
components/virtualtreeview-new/branches/4.8/demos/ole/Main.lfm Normal file
View File

@ -0,0 +1,916 @@
object MainForm: TMainForm
Left = 192
Height = 575
Top = 261
Width = 790
ActiveControl = Button1
Caption = 'Demo for drag''n drop and clipboard transfers'
ClientHeight = 575
ClientWidth = 790
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Arial'
OnCreate = FormCreate
LCLVersion = '0.9.27'
Visible = True
object Label1: TLabel
Left = 10
Height = 15
Top = 96
Width = 239
Caption = 'Tree 1 uses OLE when initiating a drag operation.'
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Arial'
ParentColor = False
ParentFont = False
end
object Label2: TLabel
Left = 360
Height = 33
Top = 80
Width = 337
AutoSize = False
Caption = 'Tree 2 uses VCL when initiating a drag operation. It also uses manual drag mode. Only marked lines are allowed to start a drag operation.'
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Arial'
ParentColor = False
ParentFont = False
WordWrap = True
end
object Panel3: TPanel
Height = 69
Width = 790
Align = alTop
ClientHeight = 69
ClientWidth = 790
Color = clWhite
ParentColor = False
TabOrder = 0
object Label6: TLabel
Left = 36
Height = 42
Top = 15
Width = 273
AutoSize = False
Caption = 'This demo shows how to cope with OLE drag''n drop as well as cut, copy and paste.'
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
WordWrap = True
end
end
object Button1: TButton
Left = 705
Height = 25
Top = 527
Width = 75
Anchors = [akRight, akBottom]
BorderSpacing.InnerBorder = 4
Caption = 'Close'
OnClick = Button1Click
TabOrder = 1
end
object Button3: TButton
Left = 709
Height = 25
Top = 80
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
Caption = 'Tree font...'
OnClick = Button3Click
ParentShowHint = False
TabOrder = 2
end
object Tree2: TVirtualStringTree
Left = 364
Height = 180
Top = 116
Width = 330
BorderStyle = bsSingle
ClipboardFormats.Strings = (
'Plain text'
'Unicode text'
'Virtual Tree Data'
)
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
DefaultNodeHeight = 24
DefaultText = 'Node'
DragOperations = [doCopy, doMove, doLink]
DragType = dtVCL
DragWidth = 350
EditDelay = 500
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Lucida Sans Unicode'
Header.Columns = <>
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
HintMode = hmTooltip
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 3
TreeOptions.AnimationOptions = [toAnimatedToggle]
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoHideButtons]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.SelectionOptions = [toMultiSelect, toCenterScrollIntoView]
OnBeforeItemErase = Tree2BeforeItemErase
OnDragAllowed = Tree2DragAllowed
OnDragOver = TreeDragOver
OnDragDrop = TreeDragDrop
OnFreeNode = TreeFreeNode
OnGetText = Tree1GetText
OnInitNode = TreeInitNode
OnNewText = Tree1NewText
end
object Tree1: TVirtualStringTree
Left = 8
Height = 180
Top = 116
Width = 330
BorderStyle = bsSingle
ClipboardFormats.Strings = (
'CSV'
'HTML Format'
'Plain text'
'Rich Text Format'
'Rich Text Format Without Objects'
'Unicode text'
)
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
DefaultNodeHeight = 24
DefaultText = 'Node'
DragMode = dmAutomatic
DragWidth = 350
EditDelay = 500
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Verdana'
Header.Columns = <>
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
HintMode = hmTooltip
Images = TreeImages
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 4
TreeOptions.AnimationOptions = [toAnimatedToggle]
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoHideButtons, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.SelectionOptions = [toMultiSelect]
OnDragOver = TreeDragOver
OnDragDrop = TreeDragDrop
OnFreeNode = TreeFreeNode
OnGetText = Tree1GetText
OnInitNode = TreeInitNode
OnNewText = Tree1NewText
end
object PageControl1: TPageControl
Left = 12
Height = 245
Top = 308
Width = 685
ActivePage = TabSheet1
Anchors = [akTop, akLeft, akBottom]
TabIndex = 3
TabOrder = 5
object RichTextTabSheet: TTabSheet
Caption = 'Rich text'
ClientHeight = 217
ClientWidth = 677
ImageIndex = 1
object Label3: TLabel
Left = 8
Height = 15
Top = 8
Width = 453
Caption = 'You can use the rich edit control as source and as target. It initiates OLE drag'' drop.'
ParentColor = False
end
end
object LogTabSheet: TTabSheet
Caption = 'Drag''n drop operation log'
ClientHeight = 217
ClientWidth = 677
object Label7: TLabel
Left = 6
Height = 41
Top = 8
Width = 403
AutoSize = False
Caption = 'The log below shows textual representations of the operation carried out. You can also use the control as VCL drag source.'
ParentColor = False
WordWrap = True
end
object LogListBox: TListBox
Left = 4
Height = 143
Hint = 'Use the list box to initiate a VCL drag''n drop.'
Top = 56
Width = 661
Anchors = [akTop, akLeft, akRight, akBottom]
DragMode = dmAutomatic
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object Button2: TButton
Left = 590
Height = 25
Top = 10
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
Caption = 'Clear log'
OnClick = Button2Click
TabOrder = 1
end
end
object TabSheet2: TTabSheet
Caption = 'More info'
ClientHeight = 217
ClientWidth = 677
ImageIndex = 3
object Label4: TLabel
Left = 12
Height = 37
Top = 52
Width = 649
AutoSize = False
Caption = 'For drag''n drop however it can (mainly for compatibility) either use OLE or VCL for drag operations. Since both approaches are incompatible and cannot be used together only one of them can be active at a time.'
ParentColor = False
WordWrap = True
end
object Label5: TLabel
Left = 12
Height = 29
Top = 94
Width = 653
AutoSize = False
Caption = 'This, though, applies only to the originator of a drag operation. The receiver can handle both situations simultanously.'
ParentColor = False
WordWrap = True
end
object Label9: TLabel
Left = 12
Height = 33
Top = 12
Width = 637
AutoSize = False
Caption = 'Virtual Treeview always uses OLE for clipboard operations. Windows ensures that an IDataObject is always available, even if an application used the clipboard in the old way.'
ParentColor = False
WordWrap = True
end
end
object TabSheet1: TTabSheet
Caption = 'Tips'
ClientHeight = 217
ClientWidth = 677
ImageIndex = 2
object Label8: TLabel
Left = 12
Height = 37
Top = 16
Width = 653
AutoSize = False
Caption = 'Try drag''n drop and clipboard operations also together with other applications like Word or the Internet Explorer.'
ParentColor = False
WordWrap = True
end
object Label10: TLabel
Left = 12
Height = 37
Top = 48
Width = 653
AutoSize = False
Caption = 'Also quite interesting is to start more than one instance of this demo and drag data between these instances. This works however only for OLE drag'' drop.'
ParentColor = False
WordWrap = True
end
end
end
object ActionList1: TActionList
left = 724
top = 156
object CutAction: TAction
Caption = 'Cut'
DisableIfNoHandler = True
OnExecute = CutActionExecute
ShortCut = 16472
end
object CopyAction: TAction
Caption = 'Copy'
DisableIfNoHandler = True
OnExecute = CopyActionExecute
ShortCut = 16451
end
object PasteAction: TAction
Caption = 'Paste'
DisableIfNoHandler = True
OnExecute = PasteActionExecute
ShortCut = 16470
end
end
object FontDialog: TFontDialog
Font.Height = -11
Font.Name = 'MS Sans Serif'
left = 756
top = 168
end
object TreeImages: TImageList
left = 706
top = 212
Bitmap = {
4C69120000001000000010000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000084FF000084FFFFFFFFFF0000
0000000000000000000000000000000000000000000000000000000000000000
84FF000084FFFFFFFFFF0000000000000000000084FF000084FF000084FF0000
84FFFFFFFFFF0000000000000000000000000000000000000000000084FF0000
84FFFFFFFFFF00000000000000000000000000000000000084FF000084FF0000
84FF000084FFFFFFFFFF000000000000000000000000000084FF000084FFFFFF
FFFF000000000000000000000000000000000000000000000000000000000000
84FF000084FF000084FFFFFFFFFF00000000000084FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000084FF000084FF000084FF000084FF000084FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000084FF000084FF000084FFFFFFFFFF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000084FF000084FF000084FF000084FF000084FFFFFFFFFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
84FF000084FF000084FFFFFFFFFF00000000000084FF000084FFFFFFFFFF0000
0000000000000000000000000000000000000000000000000000000084FF0000
84FF000084FFFFFFFFFF000000000000000000000000000084FF000084FFFFFF
FFFF0000000000000000000000000000000000000000000084FF000084FF0000
84FFFFFFFFFF0000000000000000000000000000000000000000000084FFFFFF
FFFF0000000000000000000000000000000000000000000084FF000084FF0000
84FFFFFFFFFF0000000000000000000000000000000000000000000000000000
84FFFFFFFFFF0000000000000000000000000000000000000000000084FFFFFF
FFFF000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000084FFFFFFFFFF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFF0000
00FF000000000000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FFFFFFFFFF000000FF0000000000000000000000000000
000000000000000000000000000000000000000000FFFFFFFFFF000000FF0000
00FFFFFFFFFF000000FF840000FF840000FF840000FF840000FF840000FF8400
00FF00000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8400
00FF840000FF000000000000000000000000000000FFFFFFFFFF000000FF0000
00FF000000FF000000FF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8400
00FFFFFFFFFF840000FF0000000000000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FFFFFFFFFF000000FF000000FFFFFFFFFF8400
00FF840000FF840000FF840000FF00000000000000FFFFFFFFFF000000FF0000
00FF000000FF000000FF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FF00000000000000FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FFFFFFFFFF000000FF000000FF000000FF0000
00FF000000FFFFFFFFFF840000FF00000000000000FF000000FF000000FF0000
00FF000000FF000000FF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FF000000000000000000000000000000000000
00000000000000000000840000FFFFFFFFFF000000FF000000FF000000FF0000
00FF000000FFFFFFFFFF840000FF000000000000000000000000000000000000
00000000000000000000840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FF000000000000000000000000000000000000
00000000000000000000840000FF840000FF840000FF840000FF840000FF8400
00FF840000FF840000FF840000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF00000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00FFFFFF00FFFFFF000000FF000000FF000000FF0000
00FF000000FF000000000000000000000000000000FF848484FF008484FF8484
84FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000FF008484FF8484
84FF008484FF000000FF0000000000000000000000FF008484FF848484FF0000
00FF000000000000000000000000000000000000000000000000000000FF0084
84FF848484FF000000FF0000000000000000000000FF848484FF008484FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF8484
84FF008484FF000000FF0000000000000000000000FF008484FF848484FF0084
84FF848484FF008484FF848484FF008484FF848484FF008484FF848484FF0084
84FF848484FF000000FF0000000000000000000000FF848484FF008484FF8484
84FF008484FF848484FF840000FF840000FF840000FF840000FF840000FF8400
00FF840000FF000000FF0000000000000000000000FF008484FF848484FF0084
84FF848484FF008484FF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF840000FF840000FF0000000000000000000000FF848484FF008484FF8484
84FF008484FF848484FF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF840000FFFFFFFFFF840000FF00000000000000FF008484FF848484FF0084
84FF848484FF008484FF840000FFFFFFFFFF840000FF840000FF840000FFFFFF
FFFF840000FF840000FF840000FF00000000000000FF848484FF008484FF8484
84FF008484FF848484FF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FF00000000000000FF008484FF848484FF0084
84FF848484FF008484FF840000FFFFFFFFFF840000FF840000FF840000FF8400
00FF840000FFFFFFFFFF840000FF0000000000000000000000FF000000FF0000
00FF000000FF000000FF840000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF840000FF000000000000000000000000000000000000
00000000000000000000840000FF840000FF840000FF840000FF840000FF8400
00FF840000FF840000FF840000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FFFFFF0000000000000000848484FF00FF
FFFF0000000000000000848484FF000000FF000000FF000000FF000000000000
0000000000000000000000000000848484FF00FFFFFF00000000848484FFFFFF
FFFF00000000848484FF00FFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
000000000000000000000000000000000000848484FF00FFFFFF848484FF00FF
FFFF848484FF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFF0000
00FF0000000000000000000000000000000000FFFFFF848484FF00FFFFFFFFFF
FFFF848484FF848484FF848484FF848484FFFFFFFFFF000000FFFFFFFFFFFFFF
FFFF000000FF0000000000000000848484FF848484FF848484FFFFFFFFFF00FF
FFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF000000FF000000000000000000000000FFFFFFFF848484FFFFFF
FFFFFFFFFFFF848484FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000848484FF0000000000000000848484FF00FF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000848484FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF00000000000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000840000FF840000FF840000FF840000FF8400
00FF840000FF840000FF840000FF840000FF840000FF840000FF840000FF8400
00FF840000FF0000000000000000840000FFFFFFFFFF840000FF840000FF8400
00FF840000FF840000FF840000FF840000FF840000FF840000FF840000FF8400
00FF840000FF0000000000000000840000FF840000FF840000FF840000FF8400
00FF840000FF840000FF840000FF840000FF840000FF840000FF840000FF8400
00FF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFFFFFFFFFF848484FF848484FF848484FFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FFFFFFFFFF848484FF0000000000FFFFFF00000000848484FFFFFFFFFFFFFF
FFFF000000FF0000000000000000000000FF0000000000000000000000000000
00FF848484FF0000000000FFFFFF0000000000FFFFFF848484FF848484FF8484
84FF848484FF848484FF00000000000000FF0000000000000000000000000000
00FF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF848484FF000000FF000000FF0000000000000000000000000000
00FF848484FFFFFFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF0000
000000FFFFFF848484FF000000FF000000FF0000000000000000000000000000
00FF848484FFFFFFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FF
FFFF00000000848484FF000000FF000000FF000000FF000000FF000000FF0000
00FF848484FFFFFFFFFF00FFFFFF0000000000FFFFFF0000000000FFFFFF0000
000000FFFFFF848484FF000000FF000000000000000000000000000000000000
0000848484FF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF000000FF000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000840000FF840000FF840000FF840000FF8400
00FF840000FF840000FF840000FF840000FF0000000000000000000000000000
0000000000000000000000000000840000FF840000FF840000FF840000FF8400
00FF840000FF840000FF840000FF840000FF0000000000000000000000000000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00000000000000FF000000000000
0000000000000000000000000000000000FFFFFFFFFF848484FF848484FF8484
84FF848484FF848484FFFFFFFFFF000000FF00000000000000FF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF00000000000000FFFFFF00FF0000
00FF000000000000000000000000000000FFFFFFFFFF848484FF848484FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF00FFFFFF
00FF000000FF0000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFF0000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FF000000FF00000000000000FF000000FF000000FF000000FF0000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FFFFFF00FF000000FF000000000000000000000000000000000000
00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF
00FFFFFF00FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FFFFFF00FFFFFF
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FFFFFF00FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000FF000000FF000000FF000000FF0000
00FF00000000840000FF840000FF000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000FF840000FF840000FF000000000000000000000000000000000000
0000000000FF00000000000000FF000000000000000000000000000000000000
000000000000840000FF840000FF000000FF000000FF000000FF000000FF0000
00FF00000000000000FF00000000000000FF0000000000000000000000000000
000000000000840000FF840000FF000000FFFFFFFFFFFFFFFFFF000000FF0000
0000000000FF00000000000000FF00000000000000FF00000000000000000000
0000000000FF840000FF840000FF000000FFFFFFFFFF000000FF000000000000
00FFFFFFFFFF000000FF00000000000000FF00000000000000FF000000FF0000
00FF00000000840000FF840000FF000000FFFFFFFFFFFFFFFFFF000000FFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF00000000000000FFFFFFFFFF000000FF0000
00000000000000000000840000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFF000000FF000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFF000000FF000000FFFFFF
FFFF000000FF000000FF000000FF000000FF000000FFFFFFFFFF000000FF0000
0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000848484FF848484FF848484FF848484FF848484FF00000000000000000000
0000000000000000000000000000000000000000000000000000848484FF8484
84FFFF0000FFFF0000FFFFFFFFFF00000000008400FF000000FF000000FF0000
00000000000000000000000000000000000000000000848484FFFF0000FFFF00
00FF00000000FFFFFFFF00000000008400FF008400FF008400FF008400FF0000
00FF00000000000000000000000000000000848484FFFF0000FFFFFFFFFF0000
0000FFFFFFFF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF000000FF000000000000000000000000848484FFFF0000FFFF0000FFFFFF
FFFF00000000848484FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFF8484
84FF848484FF0000000000000000000000FFFF0000FFFF0000FF000000000084
00FF008400FF848484FFFFFFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8484
84FFFFFFFFFF848484FF00000000000000FFFF0000FFFF0000FF008400FF0084
00FF008400FF848484FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFF0000
00FF000000FF000000FF000000FF000000FFFF0000FFFF0000FF008400FF0084
00FF008400FF848484FFFFFFFFFF00FFFFFF848400FF848400FF848400FF8484
84FFFFFFFFFF848484FF000000FF000000FFFF0000FFFF0000FFFF0000FF0084
00FF008400FF848484FFFFFFFFFF848400FFFFFFFFFF848484FF008400FF8400
00FFFFFFFFFF848484FF000000FF000000FFFF0000FFFF0000FFFF0000FFFF00
00FFFF0000FF848484FFFFFFFFFF848400FF848484FF008400FFFF0000FF8400
00FFFFFFFFFF848484FF000000FF00000000000000FFFF0000FFFF0000FFFF00
00FFFF0000FF848484FFFFFFFFFF848400FFFF0000FFFF0000FFFF0000FF8400
00FFFFFFFFFF848484FF000000FF00000000000000FFFF0000FFFF0000FFFF00
00FFFF0000FF848484FFFFFFFFFF00FFFFFF840000FF840000FF840000FF8484
84FFFFFFFFFF848484FF000000FF0000000000000000000000FFFF0000FFFF00
00FFFF0000FF848484FFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF848484FF000000FF000000000000000000000000000000FF0000
00FFFF0000FF848484FFFFFFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00FF
FFFFFFFFFFFF848484FF000000FF000000000000000000000000000000000000
0000000000FF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF000000FF000000000000000000000000000000000000
000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF008400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF008400FF008400FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF008400FF008400FF008400FF008400FF008400FF008400FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0084
00FFFFFFFFFFFFFFFFFFFFFFFFFF008400FF008400FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0084
00FFFFFFFFFFFFFFFFFFFFFFFFFF008400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0084
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF008400FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF008400FFFFFFFFFFFFFFFFFFFFFFFFFF008400FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF008400FF008400FFFFFFFFFFFFFFFFFFFFFFFFFF008400FFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF008400FF008400FF008400FF008400FF008400FF008400FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF008400FF008400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF008400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000848484FF848484FF848484FF848484FF848484FF848484FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000848484FFFFFFFFFF848484FF848484FF848484FF848484FF848484FF8484
84FF000000FF0000000000000000840000FF0000000000000000000000000000
0000848484FFFFFFFFFF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000FF0000000000000000840000FF840000FF00000000000000000000
0000848484FFFFFFFFFF848484FFFFFFFFFF848484FF848484FF848484FF8484
84FF848484FF848484FF000000FF840000FF840000FF840000FF000000000000
0000848484FFFFFFFFFF848484FFFFFFFFFF848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF840000FF840000FF840000FF840000FF0000
0000848484FFFFFFFFFF848484FFFFFFFFFF848484FFFFFFFFFF840000FF8400
00FF840000FFFFFFFFFF000000FF840000FF840000FF840000FF000000000000
0000848484FFFFFFFFFF848484FFFFFFFFFF848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF840000FF840000FF00000000000000000000
0000000000FF000000FF848484FFFFFFFFFF848484FFFFFFFFFF840000FF8400
00FF840000FFFFFFFFFF000000FF840000FF0000000000000000000000000000
00000000000000000000848484FFFFFFFFFF848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
00000000000000000000000000FF000000FF848484FFFFFFFFFF840000FF8400
00FF840000FFFFFFFFFF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000848484FF8484
84FF848484FF848484FF848484FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000848484FF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFF848484FF0000000000000000000000000000
000000000000000000000000000000000000848484FF00FFFFFFC6C6C6FF00FF
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFF848484FF848484FF848484FF8484
84FF848484FF848484FF0000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
C6FF00FFFFFF848484FF000000FF00000000848484FFFFFFFFFFC6C6C6FF00FF
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
FFFFC6C6C6FF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
C6FF00FFFFFF848484FF000000FF00000000848484FFFFFFFFFFC6C6C6FF00FF
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
FFFFC6C6C6FF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
C6FF00FFFFFF848484FF000000FF00000000848484FFFFFFFFFFC6C6C6FF00FF
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
FFFFC6C6C6FF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
C6FF00FFFFFF848484FF000000FF00000000848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF000000FF0000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000848484FF8484
84FF848484FF848484FF848484FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000848484FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF0000000000000000000000000000
000000000000000000000000000000000000848484FFFFFFFFFF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFFFFFFFFF848484FF848484FF848484FF8484
84FF848484FF848484FF0000000000000000848484FFFFFFFFFFC6C6C6FF00FF
FFFFC6C6C6FF00FFFFFFC6C6C6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
C6FF00FFFFFF848484FF000000FF848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF00FFFFFF848484FF000000FF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF8484
84FFC6C6C6FF848484FF000000FF848484FFFFFFFFFF00FFFFFFC6C6C6FF00FF
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFF00FFFFFF0000
00FF848484FF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
C6FF000000FF848484FF000000FF00000000848484FFFFFFFFFFC6C6C6FF00FF
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
FFFF000000FF848484FF000000FF0000000000000000848484FFFFFFFFFFC6C6
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFF00FF
FFFF848484FF000000FF000000FF0000000000000000848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF000000FF000000000000000000000000000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF0000000000000000000000000000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF000000FF00000000000000000000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FFFFFFFFFF000000FF000000000000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF000000FF000000FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FFC6C6C6FFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFC6C6C6FFC6C6C6FFC6C6
C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FF000000FF0000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF0000000000000000000000000000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF000000FF00000000000000000000
000000000000FF0000FF840000FF00000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FFFFFFFFFF000000FF000000000000
0000FF0000FF848400FF840000FF00000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF000000FF000000FF000000FFFF00
00FF848400FF840000FF0000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FFC6C6C6FFC6C6C6FFFF0000FF8484
00FF840000FF000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FFFF0000FF848400FF8400
00FF00000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF848400FF840000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF848400FF840000FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF848484FF00FFFFFF840000FFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFC6C6C6FF848484FFFFFFFFFFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF000000FF848484FFFFFFFFFFFFFFFFFFC6C6C6FF000000FF0000
000000000000000000000000000000000000848484FFC6C6C6FFC6C6C6FFC6C6
C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FF000000FF0000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF000000000000000000000000000000000000
0000000000000000000000000000848484FFFFFFFFFF848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF848484FF00000000000000000000
0000000000000000000000000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF0000
0000000000000000000000000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF0000
00FF000000000000000000000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FFFFFF
FFFF000000FF0000000000000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF0000
00FF000000FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6C6FFC6C6
C6FFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6C6
C6FFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000848484FFC6C6C6FF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000000000FF000000FF848484FFC6C6C6FF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF000000000000000000000000000000FF000000FF8484
84FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6
C6FFC6C6C6FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF000000000000000000000000000000000000
0000000000000000000000000000848484FFFFFFFFFF848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF848484FF00000000000000000000
0000000000000000000000000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF0000
000000000000FF0000FF840000FF848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FF0000
00FFFF0000FF848400FF840000FF848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF848484FFFF00
00FF848400FF840000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF8484
00FF840000FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF848400FF8400
00FFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF848400FF840000FFC6C6
C6FFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF848400FF840000FFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFF848484FF00FFFFFF840000FFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000848484FFFFFFFFFF848484FFFFFFFFFF8484
84FFFFFFFFFFFFFFFFFFC6C6C6FF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000848484FFC6C6C6FF848484FFFFFFFFFF8484
84FFFFFFFFFF000000FF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF00000000000000FF000000FF848484FFC6C6C6FF8484
84FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFC6C6C6FF000000FF000000000000000000000000000000FF000000FF8484
84FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6
C6FFC6C6C6FF000000FF00000000000000000000000000000000000000000000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF0000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF000000FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
end
end

703
components/virtualtreeview-new/branches/4.8/demos/ole/Main.pas Normal file
View File

@ -0,0 +1,703 @@
unit Main;
{$MODE Delphi}
{$define UseExternalDragManager}
// Virtual Treeview sample application demonstrating clipboard and drag'n drop operations.
// The treeview uses OLE for these operations but can also issue and accept VCL drag'n drop.
// Written by Mike Lischke.
interface
uses
Windows, LCLIntf, ActiveX, SysUtils, Forms, Dialogs, Graphics,
VirtualTrees, ActnList, ComCtrls, ExtCtrls, StdCtrls, Controls, Classes, Buttons,
LResources;
type
{ TMainForm }
TMainForm = class(TForm)
ActionList1: TActionList;
CutAction: TAction;
CopyAction: TAction;
PasteAction: TAction;
FontDialog: TFontDialog;
Panel3: TPanel;
Label6: TLabel;
Button1: TButton;
Button3: TButton;
Tree2: TVirtualStringTree;
Label1: TLabel;
Tree1: TVirtualStringTree;
Label2: TLabel;
PageControl1: TPageControl;
LogTabSheet: TTabSheet;
RichTextTabSheet: TTabSheet;
LogListBox: TListBox;
//RichEdit1: TRichEdit;
Label3: TLabel;
Label7: TLabel;
Button2: TButton;
TabSheet1: TTabSheet;
Label8: TLabel;
TabSheet2: TTabSheet;
Label4: TLabel;
Label5: TLabel;
Label9: TLabel;
Label10: TLabel;
TreeImages: TImageList;
procedure Button1Click(Sender: TObject);
procedure CutActionExecute(Sender: TObject);
procedure CopyActionExecute(Sender: TObject);
procedure PasteActionExecute(Sender: TObject);
procedure TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var Text: String);
procedure FormCreate(Sender: TObject);
procedure TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure Button2Click(Sender: TObject);
procedure TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: String);
procedure Button3Click(Sender: TObject);
procedure Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
procedure Tree2BeforeItemErase(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
var ItemColor: TColor; var EraseAction: TItemEraseAction);
private
procedure AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode);
procedure AddVCLText(Target: TVirtualStringTree; const Text: String; Mode: TVTNodeAttachMode);
function FindCPFormatDescription(CPFormat: Word): string;
procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: Integer;
Mode: TVTNodeAttachMode);
end;
var
MainForm: TMainForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
TypInfo;
{$R Res\Extra.res} // Contains a little rich text for the rich edit control and a XP manifest.
type
PNodeData = ^TNodeData;
TNodeData = record
Caption: String;
end;
procedure ReleaseStgMedium(_para1:LPSTGMEDIUM);stdcall;external 'ole32.dll' name 'ReleaseStgMedium';
function OleGetClipboard(out ppDataObj:IDataObject):WINOLEAPI;stdcall;external 'ole32.dll' name 'OleGetClipboard';
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Button1Click(Sender: TObject);
begin
Close;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.CutActionExecute(Sender: TObject);
begin
if ActiveControl = Tree1 then
Tree1.CutToClipboard
else
if ActiveControl = Tree2 then
Tree2.CutToClipboard
else;
//if ActiveControl = RichEdit1 then
// RichEdit1.CutToClipboard;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.CopyActionExecute(Sender: TObject);
begin
if ActiveControl = Tree1 then
Tree1.CopyToClipboard
else
if ActiveControl = Tree2 then
Tree2.CopyToClipboard
else;
//if ActiveControl = RichEdit1 then
// RichEdit1.CopyToClipboard;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.PasteActionExecute(Sender: TObject);
var
DataObject: IDataObject;
EnumFormat: IEnumFormatEtc;
Format: TFormatEtc;
Formats: TFormatArray;
Fetched: LongWord;
Tree: TVirtualStringTree;
begin
if ActiveControl is TVirtualStringTree then
begin
Tree := ActiveControl as TVirtualStringTree;
if LogListBox.Items.Count > 0 then
LogListBox.Items.Add('');
if ActiveControl = Tree1 then
LogListBox.Items.Add('----- Tree 1')
else
LogListBox.Items.Add('----- Tree 2');
if Tree.PasteFromClipboard then
LogListBox.Items.Add('Native tree data pasted.')
else
begin
LogListBox.Items.Add('Other data pasted.');
// Some other data was pasted. Enumerate the available formats and try to add the data.
// 1) Get a data object for the data.
OLEGetClipboard(DataObject);
// 2) Enumerate all offered formats and create a format array from it which can be used in InsertData.
if Succeeded(DataObject.EnumFormatEtc(DATADIR_GET, EnumFormat)) then
begin
EnumFormat.Reset;
SetLength(Formats, 0);
while EnumFormat.Next(1, Format, @Fetched) = S_OK do
begin
SetLength(Formats, Length(Formats) + 1);
Formats[High(Formats)] := Format.cfFormat;
end;
InsertData(Tree, DataObject, Formats, DROPEFFECT_COPY, Tree.DefaultPasteMode);
end;
end;
end
else;
//if ActiveControl = RichEdit1 then
// RichEdit1.PasteFromClipboard;
end;
procedure TMainForm.TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: PNodeData;
begin
Data := Sender.GetNodeData(Node);
Data^.Caption := '';
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var Text: String);
var
Data: PNodeData;
begin
if TextType = ttNormal then
begin
Data := Sender.GetNodeData(Node);
Text := Data.Caption;
end
else
Text := '';
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.FormCreate(Sender: TObject);
{
var
Stream: TResourceStream;
}
begin
Tree1.NodeDataSize := SizeOf(TNodeData);
Tree1.RootNodeCount := 30;
Tree2.NodeDataSize := SizeOf(TNodeData);
Tree2.RootNodeCount := 30;
// There is a small RTF text stored in the resource to have something to display in the rich edit control.
{
Stream := TResourceStream.Create(HInstance, 'RTF', 'RCDATA');
try
RichEdit1.Lines.LoadFromStream(Stream);
finally
Stream.Free;
end;
}
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode);
// This method is called when the drop handler gets called with Unicode text as only
// understandable clipboard format. This text is retrieved and splitted in lines.
// Every line is then added as new node.
var
FormatEtc: TFormatEtc;
Medium: TStgMedium;
OLEData,
Head, Tail: PWideChar;
WideStr: WideString;
TargetNode,
Node: PVirtualNode;
Data: PNodeData;
begin
if Mode <> amNowhere then
begin
// fill the structure used to get the Unicode string
with FormatEtc do
begin
cfFormat := CF_UNICODETEXT;
// no specific target device
ptd := nil;
// normal content to render
dwAspect := DVASPECT_CONTENT;
// no specific page of multipage data
lindex := -1;
// pass the data via memory
tymed := TYMED_HGLOBAL;
end;
// Check if we can get the Unicode text data.
if DataObject.QueryGetData(FormatEtc) = S_OK then
begin
// Data is accessible so finally get a pointer to it
if DataObject.GetData(FormatEtc, Medium) = S_OK then
begin
OLEData := GlobalLock(Medium.hGlobal);
if Assigned(OLEData) then
begin
Target.BeginUpdate;
TargetNode := Target.DropTargetNode;
if TargetNode = nil then
TargetNode := Target.FocusedNode;
Head := OLEData;
try
while Head^ <> #0 do
begin
Tail := Head;
while not (Tail^ in [WideChar(#0), WideChar(#13), WideChar(#10), WideChar(#9)]) do
Inc(Tail);
if Head <> Tail then
begin
// add a new node if we got a non-empty caption
Node := Target.InsertNode(TargetNode, Mode);
Target.ValidateNode(Node, False);
Data := Target.GetNodeData(Node);
SetString(WideStr, Head, Tail - Head);
Data.Caption := UTF8Decode(WideStr);
end;
// Skip any tab.
if Tail^ = #9 then
Inc(Tail);
// skip line separators
if Tail^ = #13 then
Inc(Tail);
if Tail^ = #10 then
Inc(Tail);
Head := Tail;
end;
finally
GlobalUnlock(Medium.hGlobal);
Target.EndUpdate;
end;
end;
// never forget to free the storage medium
ReleaseStgMedium(@Medium);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.AddVCLText(Target: TVirtualStringTree; const Text: String; Mode: TVTNodeAttachMode);
// This method is called when the drop handler gets called with a VCL drag source.
// The given text is retrieved and splitted in lines.
var
Head, Tail: PWideChar;
WideStr: WideString;
TargetNode,
Node: PVirtualNode;
Data: PNodeData;
begin
if Mode <> amNowhere then
begin
Target.BeginUpdate;
try
TargetNode := Target.DropTargetNode;
if TargetNode = nil then
TargetNode := Target.FocusedNode;
Head := PWideChar(Text);
while Head^ <> #0 do
begin
Tail := Head;
while not (Tail^ in [WideChar(#0), WideChar(#13), WideChar(#10)]) do
Inc(Tail);
if Head <> Tail then
begin
// add a new node if we got a non-empty caption
Node := Target.InsertNode(TargetNode, Mode);
Target.ValidateNode(Node, False);
Data := Target.GetNodeData(Node);
SetString(WideStr, Head, Tail - Head);
Data.Caption := UTF8Decode(WideStr);
end;
// skip line separators
if Tail^ = #13 then
Inc(Tail);
if Tail^ = #10 then
Inc(Tail);
Head := Tail;
end;
finally
Target.EndUpdate;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TMainForm.FindCPFormatDescription(CPFormat: Word): string;
var
Buffer: array[0..2048] of Char;
begin
// Try the formats support the by Virtual Treeview first.
Result := GetVTClipboardFormatDescription(CPFormat);
// Retrieve additional formats from system.
if Length(Result) = 0 then
begin
if GetClipboardFormatName(CPFormat, @Buffer, 2048) > 0 then
Result := ' - ' + Buffer
else
Result := Format(' - unknown format (%d)', [CPFormat]);
end
else
Result := ' - ' + Result;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
//--------------- local function --------------------------------------------
procedure DetermineEffect;
// Determine the drop effect to use if the source is a Virtual Treeview.
begin
// In the case the source is a Virtual Treeview we know 'move' is the default if dragging within
// the same tree and copy if dragging to another tree. Set Effect accordingly.
if Shift = [] then
begin
// No modifier key, so use standard action.
if Source = Sender then
Effect := DROPEFFECT_MOVE
else
Effect := DROPEFFECT_COPY;
end
else
begin
// A modifier key is pressed, hence use this to determine action.
if (Shift = [ssAlt]) or (Shift = [ssCtrl, ssAlt]) then
Effect := DROPEFFECT_LINK
else
if Shift = [ssCtrl] then
Effect := DROPEFFECT_COPY
else
Effect := DROPEFFECT_MOVE;
end;
end;
//--------------- end local function ----------------------------------------
var
S: string;
Attachmode: TVTNodeAttachMode;
Nodes: TNodeArray;
I: Integer;
begin
Nodes := nil;
if LogListBox.Items.Count > 0 then
LogListBox.Items.Add('');
if Sender = Tree1 then
LogListBox.Items.Add('----- Tree 1')
else
LogListBox.Items.Add('----- Tree 2');
if DataObject = nil then
LogListBox.Items.Add('VCL drop arrived')
else
LogListBox.Items.Add('OLE drop arrived');
S := 'Drop actions allowed:';
if Boolean(DROPEFFECT_COPY and Effect) then
S := S + ' copy';
if Boolean(DROPEFFECT_MOVE and Effect) then
S := S + ' move';
if Boolean(DROPEFFECT_LINK and Effect) then
S := S + ' link';
LogListBox.Items.Add(S);
S := 'Drop mode: ' + GetEnumName(TypeInfo(TDropMode), Ord(Mode));
LogListBox.Items.Add(S);
// Translate the drop position into an node attach mode.
case Mode of
dmAbove:
AttachMode := amInsertBefore;
dmOnNode:
AttachMode := amAddChildLast;
dmBelow:
AttachMode := amInsertAfter;
else
AttachMode := amNowhere;
end;
if DataObject = nil then
begin
// VCL drag'n drop. Handling this requires detailed knowledge about the sender and its data. This is one reason
// why it was a bad decision by Borland to implement something own instead using the system's way.
// In this demo we have two known sources of VCL dd data: Tree2 and LogListBox.
if Source = Tree2 then
begin
// Since we know this is a Virtual Treeview we can ignore the drop event entirely and use VT mechanisms.
DetermineEffect;
Nodes := Tree2.GetSortedSelection(True);
if Effect = DROPEFFECT_COPY then
begin
for I := 0 to High(Nodes) do
Tree2.CopyTo(Nodes[I], Sender.DropTargetNode, AttachMode, False);
end
else
for I := 0 to High(Nodes) do
Tree2.MoveTo(Nodes[I], Sender.DropTargetNode, AttachMode, False);
end
else
begin
// One long string (one node) is added, containing all text currently in the list box.
AddVCLText(Sender as TVirtualStringTree, LogListBox.Items.CommaText, AttachMode);
LogListBox.Items.Add('List box data accepted as string.');
end;
end
else
begin
// OLE drag'n drop. Perform full processing.
LogListBox.Items.Add('There are ' + IntToStr(Length(Formats)) + ' formats available:');
// Determine action in advance even if we don't use the dropped data.
// Note: The Effect parameter is a variable which must be set to the action we
// will actually take, to notify the sender of the drag operation about remaining actions.
// This value determines what the caller will do after the method returns,
// e.g. if DROPEFFECT_MOVE is returned then the source data will be deleted.
if Source is TBaseVirtualTree then
begin
DetermineEffect;
end
else
// Prefer copy if allowed for every other drag source. Alone from Effect you cannot determine the standard action
// of the sender, but we assume if copy is allowed then it is also the standard action
// (e.g. as in TRichEdit).
if Boolean(Effect and DROPEFFECT_COPY) then
Effect := DROPEFFECT_COPY
else
Effect := DROPEFFECT_MOVE;
InsertData(Sender as TVirtualStringTree, DataObject, Formats, Effect, AttachMode);
end;
// scroll last added entry into view
LogListBox.ItemIndex := LogListBox.Items.Count - 1;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Button2Click(Sender: TObject);
begin
LogListBox.Clear;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
Data: PNodeData;
begin
Data := Sender.GetNodeData(Node);
// set a generic caption only if there is not already one (e.g. from drag operations)
if Length(Data.Caption) = 0 then
Data.Caption := Format('Node Index %d', [Node.Index]);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: String);
var
Data: PNodeData;
// Tree1 as well as Tree2 use the soSaveCaptions StringOption which enables automatic caption store action
// when tree data is serialized into memory (e.g. for drag'n drop). Restoring the caption is done by triggering
// this event for each loaded node.
// This mechanism frees us from implementing a SaveNode and LoadNode event since we have only the caption to store.
begin
Data := Sender.GetNodeData(Node);
Data.Caption := Text;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Button3Click(Sender: TObject);
begin
with FontDialog do
begin
Font := Tree1.Font;
if Execute then
begin
Tree1.Font := Font;
Tree2.Font := Font;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
// Tree 2 uses manual drag start to tell which node might be dragged.
begin
Allowed := Odd(Node.Index);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
Accept := True;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Tree2BeforeItemErase(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
var ItemColor: TColor; var EraseAction: TItemEraseAction);
// The second tree uses manual drag and we want to show the lines which are allowed to start a drag operation by
// a colored background.
begin
if Odd(Node.Index) then
begin
ItemColor := $FFEEEE;
EraseAction := eaColor;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray;
Effect: Integer; Mode: TVTNodeAttachMode);
var
FormatAccepted: Boolean;
I: Integer;
begin
// Go through each available format and see if we can make sense of it.
FormatAccepted := False;
for I := 0 to High(Formats) do
begin
case Formats[I] of
// standard clipboard formats
CF_UNICODETEXT:
begin
LogListBox.Items.Add(' - Unicode text');
// As demonstration for non-tree data here an implementation for Unicode text.
// Formats are placed in preferred order in the formats parameter. Hence if
// there is native tree data involved in this drop operation then it has been
// caught earlier in the loop and FormatAccepted is already True.
if not FormatAccepted then
begin
// Unicode text data was dropped (e.g. from RichEdit1) add this line by line
// as new nodes.
AddUnicodeText(DataObject, Sender as TVirtualStringTree, Mode);
LogListBox.Items.Add('+ Unicode accepted');
FormatAccepted := True;
end;
end;
else
if Formats[I] = CF_VIRTUALTREE then
begin
// this is our native tree format
LogListBox.Items.Add(' - native Virtual Treeview data');
if not FormatAccepted then
begin
Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect, Mode);
LogListBox.Items.Add('+ native Virtual Treeview data accepted');
// Indicate that we found a format we accepted so the data is not used twice.
FormatAccepted := True;
end;
end
else
if Formats[I] = CF_VTREFERENCE then
LogListBox.Items.Add(' - Virtual Treeview reference')
else
begin
// Predefined, shell specific, MIME specific or application specific clipboard data.
LogListBox.Items.Add(FindCPFormatDescription(Formats[I]));
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i Main.lrs}
end.

BIN
components/virtualtreeview-new/branches/4.8/demos/ole/Res/Extra.res Normal file
View File

Binary file not shown.

BIN
components/virtualtreeview-new/branches/4.8/demos/ole/Res/Text.rtf Normal file
View File

Binary file not shown.

70
components/virtualtreeview-new/branches/4.8/demos/ole/ole.lpi Normal file
View File

@ -0,0 +1,70 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<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="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="virtualtreeview_package"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="ole.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ole"/>
</Unit0>
<Unit1>
<Filename Value="Main.pas"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

18
components/virtualtreeview-new/branches/4.8/demos/ole/ole.lpr Normal file
View File

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

178
components/virtualtreeview-new/branches/4.8/demos/unicode/fmain.lfm Normal file
View File

@ -0,0 +1,178 @@
object MainForm: TMainForm
Left = 379
Height = 504
Top = 166
Width = 613
Caption = 'Unicode Demo'
ClientHeight = 504
ClientWidth = 613
OnCreate = FormCreate
LCLVersion = '0.9.27'
object MainNotebook: TNotebook
Height = 504
Width = 613
Align = alClient
PageIndex = 0
TabOrder = 0
object WelcomePage: TPage
Caption = 'Welcome Translations'
ClientWidth = 605
ClientHeight = 478
object WelcomeTree: TVirtualStringTree
Left = 3
Height = 444
Top = 31
Width = 599
Align = alClient
BorderSpacing.Around = 3
BorderStyle = bsSingle
DefaultText = 'Node'
Header.Columns = <
item
Text = 'Language'
Width = 200
end
item
Position = 1
Text = 'Translation'
Width = 200
end>
Header.Options = [hoColumnResize, hoDrag, hoVisible]
TabOrder = 0
OnFreeNode = WelcomeTreeFreeNode
OnGetText = WelcomeTreeGetText
end
object WelcomeTopPanel: TPanel
Height = 28
Width = 605
Align = alTop
BevelOuter = bvNone
ClientHeight = 28
ClientWidth = 605
TabOrder = 1
object ChooseWelcomeFontButton: TButton
Left = 4
Height = 25
Top = 2
Width = 120
BorderSpacing.Left = 3
BorderSpacing.Around = 1
Caption = 'Choose Font'
OnClick = ChooseWelcomeFontButtonClick
TabOrder = 0
end
end
end
object LCLTextPage: TPage
Caption = 'LCL Text'
ClientWidth = 605
ClientHeight = 478
object LCLTextTree: TVirtualStringTree
Left = 3
Height = 440
Top = 3
Width = 272
BorderSpacing.Around = 3
BorderStyle = bsSingle
DefaultText = 'Node'
Header.Columns = <>
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
TabOrder = 0
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
OnFreeNode = LCLTextTreeFreeNode
OnGetText = LCLTextTreeGetText
OnNewText = LCLTextTreeNewText
end
object AddEditTextButton: TButton
Left = 476
Height = 25
Top = 2
Width = 120
Caption = 'Add Text'
OnClick = AddEditTextButtonClick
TabOrder = 1
end
object TextEdit: TEdit
Left = 284
Height = 23
Top = 2
Width = 184
TabOrder = 2
end
object TextComboBox: TComboBox
Left = 284
Height = 21
Top = 58
Width = 184
ItemHeight = 13
Items.Strings = (
'Não'
'Coração'
'Sim'
)
TabOrder = 3
end
object AddComboTextButton: TButton
Left = 476
Height = 25
Top = 58
Width = 120
Caption = 'Add Text'
OnClick = AddComboTextButtonClick
TabOrder = 4
end
object TextListBox: TListBox
Left = 284
Height = 112
Top = 98
Width = 184
Items.Strings = (
'Não'
'Coração'
'Sim'
)
ItemHeight = 13
TabOrder = 5
end
object AddListTextButton: TButton
Left = 476
Height = 25
Top = 98
Width = 120
Caption = 'Add Text'
OnClick = AddListTextButtonClick
TabOrder = 6
end
object TextMemo: TMemo
Left = 284
Height = 138
Top = 234
Width = 184
TabOrder = 7
end
object AddMemoTextButton: TButton
Left = 476
Height = 25
Top = 234
Width = 120
Caption = 'Add Text'
OnClick = AddMemoTextButtonClick
TabOrder = 8
end
object ClearLCLTextTreeButton: TButton
Left = 3
Height = 25
Top = 449
Width = 97
Caption = 'Clear'
OnClick = ClearLCLTextTreeButtonClick
TabOrder = 9
end
end
end
object FontDialog1: TFontDialog
left = 136
top = 24
end
end

217
components/virtualtreeview-new/branches/4.8/demos/unicode/fmain.pas Normal file
View File

@ -0,0 +1,217 @@
unit fMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, VirtualTrees, StdCtrls, LCLProc;
type
{ TMainForm }
TMainForm = class(TForm)
AddEditTextButton: TButton;
AddComboTextButton: TButton;
AddListTextButton: TButton;
AddMemoTextButton: TButton;
ClearLCLTextTreeButton: TButton;
ChooseWelcomeFontButton: TButton;
TextMemo: TMemo;
TextListBox: TListBox;
TextComboBox: TComboBox;
TextEdit: TEdit;
FontDialog1: TFontDialog;
MainNotebook: TNotebook;
LCLTextPage: TPage;
LCLTextTree: TVirtualStringTree;
WelcomeTopPanel: TPanel;
WelcomeTree: TVirtualStringTree;
WelcomePage: TPage;
procedure AddComboTextButtonClick(Sender: TObject);
procedure AddEditTextButtonClick(Sender: TObject);
procedure AddListTextButtonClick(Sender: TObject);
procedure AddMemoTextButtonClick(Sender: TObject);
procedure ChooseWelcomeFontButtonClick(Sender: TObject);
procedure ClearLCLTextTreeButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure LCLTextTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure LCLTextTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
procedure LCLTextTreeNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; const NewText: String);
procedure WelcomeTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure WelcomeTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
private
procedure AddLCLText(const AText: String);
{ private declarations }
procedure AddWelcomeString(const WelcomeString: String);
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
uses
strutils;
type
TWelcomeData = record
Language: String;
Translation: String;
end;
PWelcomeData = ^TWelcomeData;
TLCLTextData = record
Text: String;
end;
PLCLTextData = ^TLCLTextData;
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
var
WelcomeList: TStrings;
i: Integer;
begin
LCLTextTree.NodeDataSize := SizeOf(TLCLTextData);
WelcomeTree.NodeDataSize := SizeOf(TWelcomeData);
//Load the welcome list from an UTF-8 encoded file
WelcomeList := TStringList.Create;
try
WelcomeList.LoadFromFile('welcome.txt');
WelcomeTree.BeginUpdate;
for i := 0 to WelcomeList.Count - 1 do
AddWelcomeString(WelcomeList[i]);
WelcomeTree.EndUpdate;
finally
WelcomeList.Destroy;
end;
end;
procedure TMainForm.LCLTextTreeFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
Data: PLCLTextData;
begin
Data := Sender.GetNodeData(Node);
Data^.Text := '';
end;
procedure TMainForm.LCLTextTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
var
Data: PLCLTextData;
begin
Data := Sender.GetNodeData(Node);
CellText := Data^.Text;
end;
procedure TMainForm.LCLTextTreeNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const NewText: String);
var
Data: PLCLTextData;
begin
Data := Sender.GetNodeData(Node);
Data^.Text := NewText;
end;
procedure TMainForm.ChooseWelcomeFontButtonClick(Sender: TObject);
begin
if FontDialog1.Execute then
WelcomeTree.Font := FontDialog1.Font;
end;
procedure TMainForm.ClearLCLTextTreeButtonClick(Sender: TObject);
begin
LCLTextTree.Clear;
end;
procedure TMainForm.AddEditTextButtonClick(Sender: TObject);
begin
AddLCLText(TextEdit.Text);
end;
procedure TMainForm.AddListTextButtonClick(Sender: TObject);
begin
if TextListBox.ItemIndex <> -1 then
AddLCLText(TextListBox.Items[TextListBox.ItemIndex]);
end;
procedure TMainForm.AddMemoTextButtonClick(Sender: TObject);
var
i: Integer;
begin
for i := 0 to TextMemo.Lines.Count - 1 do
AddLCLText(TextMemo.Lines[i]);
end;
procedure TMainForm.AddComboTextButtonClick(Sender: TObject);
begin
AddLCLText(TextComboBox.Text);
end;
procedure TMainForm.WelcomeTreeFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
Data: PWelcomeData;
begin
Data := Sender.GetNodeData(Node);
Data^.Language := '';
Data^.Translation := '';
end;
procedure TMainForm.WelcomeTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
var
Data: PWelcomeData;
begin
Data := Sender.GetNodeData(Node);
case Column of
0: CellText := Data^.Language;
1: CellText := Data^.Translation;
end;
end;
procedure TMainForm.AddLCLText(const AText: String);
var
Data: PLCLTextData;
Node: PVirtualNode;
begin
with LCLTextTree do
begin
Node := AddChild(nil);
Data := GetNodeData(Node);
Data^.Text := AText;
ValidateNode(Node, False);
end;
end;
procedure TMainForm.AddWelcomeString(const WelcomeString: String);
var
Data: PWelcomeData;
Node: PVirtualNode;
begin
with WelcomeTree do
begin
Node := AddChild(nil);
Data := GetNodeData(Node);
Data^.Language := ExtractWord(1, WelcomeString, [Chr(9)]);
Data^.Translation := ExtractWord(2, WelcomeString, [Chr(9)]);
ValidateNode(Node, False);
end;
end;
initialization
{$I fmain.lrs}
end.

70
components/virtualtreeview-new/branches/4.8/demos/unicode/unicode.lpi Normal file
View File

@ -0,0 +1,70 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<Icon Value="0"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<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="2">
<Item1>
<PackageName Value="virtualtreeview_package"/>
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="unicode.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="unicode"/>
</Unit0>
<Unit1>
<Filename Value="fmain.pas"/>
<ComponentName Value="MainForm"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

21
components/virtualtreeview-new/branches/4.8/demos/unicode/unicode.lpr Normal file
View File

@ -0,0 +1,21 @@
program unicode;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ you can add units after this }, fMain, LResources, virtualtreeview_package;
{$IFDEF WINDOWS}{$R unicode.rc}{$ENDIF}
begin
{$I unicode.lrs}
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

5222
components/virtualtreeview-new/branches/4.8/demos/unicode/unicode.lrs Normal file
View File

File diff suppressed because it is too large Load Diff

35
components/virtualtreeview-new/branches/4.8/demos/unicode/welcome.txt Normal file
View File

@ -0,0 +1,35 @@
Arabic مرحباً
Armenian բարի գալուստ
Azeri xoş gəlmişsiniz
Catalan benvinguts
Cherokee ᎤᎵᎮᎵᏍᏗ
Chinese (trad.) 歡迎
Chinese (simp.) 欢迎
Czech vítejte
Danish velkommen
Dutch welkom
English welcome
Esperanto bonveno
Estonian tere tulemast
Finnish tervetuloa
French bienvenue
German willkommen
Greek καλώς ορίσατε
Hebrew ברוכים הבאים
Italian benvenuti
Japanese ようこそ
Latin salve
Norwegian velkommen
Persian خوش آمدید
Polish zapraszamy
Portuguese bem-vindo
Romanian bun venit
Sindhi ڀلي ڪري آيا
Slovak víta vás
Slovenian dobrodošli
Spanish bienvenido
Swahili karibu
Swedish välkommen
Turkish hoş geldiniz
Uyghur خۇش كەپسىز
Zulu sawubona

1561
components/virtualtreeview-new/branches/4.8/demos/vtbasic/Main.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

200
components/virtualtreeview-new/branches/4.8/demos/vtbasic/Main.pas Normal file
View File

@ -0,0 +1,200 @@
{*********************************************************************** }
{ File: Main.pas }
{ }
{ Purpose: }
{ main source file to demonstrate how to get started with VT (1) }
{ <-- Basic VT as a Listbox (no node data used) --> }
{ }
{ Module Record: }
{ }
{ Date AP Details }
{ -------- -- -------------------------------------- }
{ 05-Nov-2002 TC Created (tomc@gripsystems.com) }
{**********************************************************************}
unit Main;
{$mode delphi}
{$H+}
interface
uses
LCLIntf, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, ExtCtrls, StdCtrls, Buttons, LResources;
type
TfrmMain =
class(TForm)
imgMaster: TImageList;
panMain: TPanel;
VT: TVirtualStringTree;
panBase: TPanel;
chkRadioButtons: TCheckBox;
chkChangeHeight: TCheckBox;
chkHotTrack: TCheckBox;
Label1: TLabel;
btnViewCode: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure VTGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
procedure VTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
procedure VTDblClick(Sender: TObject);
procedure chkRadioButtonsClick(Sender: TObject);
procedure VTFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex;
var Allowed: Boolean);
procedure chkChangeHeightClick(Sender: TObject);
procedure chkHotTrackClick(Sender: TObject);
procedure btnViewCodeClick(Sender: TObject);
private
FCaptions : TStringList;
end;
var
frmMain: TfrmMain;
implementation
uses
VTNoData, VTCheckList, VTPropEdit, VTDBExample, VTEditors, ViewCode;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Top := 0;
Left:= 0;
{let's make some data to display - it's going to come from somewhere}
FCaptions := TStringList.Create;
FCaptions.Add( 'Basic VT as a Listbox (no node data used)' );
FCaptions.Add( 'Basic VT as a Tree (no node data used)' );
FCaptions.Add( 'Generic CheckListbox selection Form (no node data used)');
FCaptions.Add( 'Dynamic Property Editor example 1.' );
FCaptions.Add( 'Database example 1.' );
{this is first important value to set, 0 is ok if you want to use AddChild later}
VT .RootNodeCount := FCaptions.Count;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FCaptions.Free;
end;
procedure TfrmMain.VTGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
{--------------------------------------------------------------------------------------------
note zero node data size - you don't *have* to store data in the node. Maybe this is very likely
if you are dealing with a list with no children that can be directly indexed into via Node.Index
---------------------------------------------------------------------------------------------}
begin
NodeDataSize := 0;
end;
procedure TfrmMain.VTInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
begin
Node.CheckType := ctRadioButton; {must enable toCheckSupport in TreeOptions.MiscOptions}
end;
procedure TfrmMain.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
begin
Celltext := FCaptions[Node.Index]; {this is where we say what the text to display}
end;
procedure TfrmMain.VTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
begin
ImageIndex := Node.Index; {this is where we say what image to display}
end;
procedure TfrmMain.VTDblClick(Sender: TObject);
begin
//showform is a utility routine for this app - in vteditors.pas
case VT.FocusedNode.Index of
0: ShowMessage( 'This is it...!' ); // Main.pas
1: ShowForm( TfrmVTNoData, Left, Height ); // VTNoData.pas
2: DoVTCheckListExample; // VTCheckList.pas
3: ShowForm( TfrmVTPropEdit, Left + Width, Top ); // VTPropEdit.pas
4: ShowForm( TfrmVTDBExample, Left + Width, Top ); // VTDBExample.pas
end;
end;
procedure TfrmMain.chkHotTrackClick(Sender: TObject);
begin
with VT.TreeOptions do
begin
if chkHotTrack.checked then
PaintOptions := PaintOptions + [toHotTrack]
else
PaintOptions := PaintOptions - [toHotTrack];
VT.Refresh;
end;
end;
procedure TfrmMain.chkRadioButtonsClick(Sender: TObject);
begin
with VT.TreeOptions do
begin
if chkRadioButtons.checked then
MiscOptions := MiscOptions + [toCheckSupport]
else
MiscOptions := MiscOptions - [toCheckSupport];
VT.Refresh;
end;
end;
procedure TfrmMain.VTFocusChanging(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex;
var Allowed: Boolean);
begin
{example of dynamically changing height of node}
if chkChangeHeight.checked then
begin
Sender.NodeHeight[OldNode] := 20;
Sender.NodeHeight[NewNode] := 40;
end;
end;
procedure TfrmMain.chkChangeHeightClick(Sender: TObject);
begin
{example of resetting dynamically changing node heights}
if not chkChangeHeight.checked then with VT do
begin
NodeHeight[FocusedNode] := 20;
InvalidateNode(FocusedNode);
end;
end;
procedure TfrmMain.btnViewCodeClick(Sender: TObject);
var
sFile : string;
f : TForm;
begin
case VT.FocusedNode.Index of
0: sFile := 'Main' ;
1: sFile := 'VTNoData' ;
2: sFile := 'VTCheckList' ;
3: sFile := 'VTPropEdit' ;
4: sFile := 'VTDBExample' ;
end;
f := ShowForm( TfrmViewCode, Left, Height ); // ViewCode.pas
TfrmViewCode(f).SynEdit1.Lines.LoadFromFile( ExtractFilePath(ParamStr(0)) + sFile + '.pas' );
end;
initialization
{$I Main.lrs}
end.

Some files were not shown because too many files have changed in this diff Show More