* Added advanced demo

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@168 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2007-05-24 23:52:34 +00:00
parent 1456413285
commit 9d6a33dbe9
70 changed files with 68525 additions and 0 deletions

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>

View File

@ -0,0 +1,163 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="virtualtreeview_package"/>
</Item1>
<Item2>
<PackageName Value="Printer4Lazarus"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="15">
<Unit0>
<Filename Value="Advanced.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="WindowsXPStyleDemo.pas"/>
<ComponentName Value="WindowsXPForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="WindowsXPStyleDemo.lrs"/>
<UnitName Value="WindowsXPStyleDemo"/>
</Unit1>
<Unit2>
<Filename Value="AlignDemo.pas"/>
<ComponentName Value="AlignForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="AlignDemo.lrs"/>
<UnitName Value="AlignDemo"/>
</Unit2>
<Unit3>
<Filename Value="DrawTreeDemo.pas"/>
<ComponentName Value="DrawTreeForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="DrawTreeDemo.lrs"/>
<UnitName Value="DrawTreeDemo"/>
</Unit3>
<Unit4>
<Filename Value="Editors.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Editors"/>
</Unit4>
<Unit5>
<Filename Value="GeneralAbilitiesDemo.pas"/>
<ComponentName Value="GeneralForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="GeneralAbilitiesDemo.lrs"/>
<UnitName Value="GeneralAbilitiesDemo"/>
</Unit5>
<Unit6>
<Filename Value="GridDemo.pas"/>
<ComponentName Value="GridForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="GridDemo.lrs"/>
<UnitName Value="GridDemo"/>
</Unit6>
<Unit7>
<Filename Value="HeaderCustomDrawDemo.pas"/>
<ComponentName Value="HeaderOwnerDrawForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="HeaderCustomDrawDemo.lrs"/>
<UnitName Value="HeaderCustomDrawDemo"/>
</Unit7>
<Unit8>
<Filename Value="Main.pas"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="Main.lrs"/>
<UnitName Value="Main"/>
</Unit8>
<Unit9>
<Filename Value="MultilineDemo.pas"/>
<ComponentName Value="NodeForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="MultilineDemo.lrs"/>
<UnitName Value="MultilineDemo"/>
</Unit9>
<Unit10>
<Filename Value="PropertiesDemo.pas"/>
<ComponentName Value="PropertiesForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="PropertiesDemo.lrs"/>
<UnitName Value="PropertiesDemo"/>
</Unit10>
<Unit11>
<Filename Value="SpeedDemo.pas"/>
<ComponentName Value="SpeedForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="SpeedDemo.lrs"/>
<UnitName Value="SpeedDemo"/>
</Unit11>
<Unit12>
<Filename Value="States.pas"/>
<ComponentName Value="StateForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="States.lrs"/>
<UnitName Value="States"/>
</Unit12>
<Unit13>
<Filename Value="VisibilityDemo.pas"/>
<ComponentName Value="VisibilityForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="VisibilityDemo.lrs"/>
<UnitName Value="VisibilityDemo"/>
</Unit13>
<Unit14>
<Filename Value="shlobjext.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="shlobjext"/>
</Unit14>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

View File

@ -0,0 +1,32 @@
program Advanced;
{$R Res\ExtraRes.res}
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;
{.$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TStateForm, StateForm);
Application.Run;
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,625 @@
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
{$ifdef COMPILER_7_UP}
// For some things to work we need code, which is classified as being unsafe for .NET.
{$warn UNSAFE_TYPE off}
{$warn UNSAFE_CAST off}
{$warn UNSAFE_CODE off}
{$endif COMPILER_7_UP}
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: WideString);
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;
{.$R *.DFM}
//----------------------------------------------------------------------------------------------------------------------
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: WideString;
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 WideString;
ArabicStrings: array[0..3] of WideString;
HebrewStrings: array[0..2] of WideString;
//----------------------------------------------------------------------------------------------------------------------
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: WideString);
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
// High color image lists look much better.
ConvertToHighColor(TreeImages);
ConvertToHighColor(HeaderImages);
// 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 + #13 + CommonHeaderHint;
Columns[1].Hint := DefaultHintColumn1 + #13 + CommonHeaderHint;
Columns[2].Hint := DefaultHintColumn2 + #13 + 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 = #13'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 + #13 + CommonHeaderHint + FocusedText + Data.MainColumnText;
Columns[1].Hint := DefaultHintColumn1 + #13 + CommonHeaderHint + FocusedText + Data.GreekText;
Columns[2].Hint := DefaultHintColumn2 + #13 + 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.

View File

@ -0,0 +1,126 @@
object DrawTreeForm: TDrawTreeForm
Left = 544
Height = 477
Top = 320
Width = 710
HorzScrollBar.Page = 709
VertScrollBar.Page = 476
ActiveControl = VDT1
Caption = 'DrawTreeForm'
ClientHeight = 477
ClientWidth = 710
Font.Height = -13
Font.Name = 'Trebuchet MS'
OnCreate = FormCreate
object Label7: TLabel
Height = 61
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).'
Color = clNone
ParentColor = False
WordWrap = True
end
object Label1: TLabel
Left = 4
Height = 14
Top = 385
Width = 199
Anchors = [akLeft, akBottom]
Caption = 'Adjust vertical image alignment of nodes:'
Color = clNone
ParentColor = False
end
object Label3: TLabel
Left = 424
Height = 14
Top = 385
Width = 24
Anchors = [akLeft, akBottom]
Caption = '50%'
Color = clNone
ParentColor = False
end
object VDT1: TVirtualDrawTree
Left = 10
Height = 278
Top = 84
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.Height = 22
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoRestrictDrag, hoShowSortGlyphs, hoVisible]
Header.ParentFont = True
Header.Style = hsPlates
HintAnimation = hatNone
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
Columns = <
item
Options = [coAllowClick, coEnabled, coParentColor, coResizable, coShowDropMark, coVisible]
Width = 217
WideText = 'Image file name'
end
item
Position = 1
Width = 200
WideText = 'Thumbnail'
end
item
Position = 2
Width = 160
WideText = 'Properties'
end>
end
object TrackBar1: TTrackBar
Left = 264
Height = 21
Top = 379
Width = 157
Max = 100
OnChange = TrackBar1Change
Position = 50
ScalePos = trTop
TickStyle = tsNone
Anchors = [akLeft, akBottom]
TabOrder = 1
end
object SystemImages: TImageList
left = 450
top = 404
end
end

View File

@ -0,0 +1,51 @@
LazarusResources.Add('TDrawTreeForm','FORMDATA',[
'TPF0'#13'TDrawTreeForm'#12'DrawTreeForm'#4'Left'#3' '#2#6'Height'#3#221#1#3
+'Top'#3'@'#1#5'Width'#3#198#2#18'HorzScrollBar.Page'#3#197#2#18'VertScrollBa'
+'r.Page'#3#220#1#13'ActiveControl'#7#4'VDT1'#7'Caption'#6#12'DrawTreeForm'#12
+'ClientHeight'#3#221#1#11'ClientWidth'#3#198#2#11'Font.Height'#2#243#9'Font.'
+'Name'#6#12'Trebuchet MS'#8'OnCreate'#7#10'FormCreate'#0#6'TLabel'#6'Label7'
+#6'Height'#2'='#5'Width'#3#198#2#5'Align'#7#5'alTop'#8'AutoSize'#8#7'Caption'
+#6#251'A sample for a draw tree, which shows images of all known types as th'
+'umbnails. By default this tree uses the image loader library GraphicEx to '
+'support many common image formats like png, gif etc. (see www.delphi-gems.c'
+'om for more infos and download).'#5'Color'#7#6'clNone'#11'ParentColor'#8#8
+'WordWrap'#9#0#0#6'TLabel'#6'Label1'#4'Left'#2#4#6'Height'#2#14#3'Top'#3#129
+#1#5'Width'#3#199#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6')Adju'
+'st vertical image alignment of nodes:'#5'Color'#7#6'clNone'#11'ParentColor'
+#8#0#0#6'TLabel'#6'Label3'#4'Left'#3#168#1#6'Height'#2#14#3'Top'#3#129#1#5'W'
+'idth'#2#24#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#3'50%'#5'Colo'
+'r'#7#6'clNone'#11'ParentColor'#8#0#0#16'TVirtualDrawTree'#4'VDT1'#4'Left'#2
+#10#6'Height'#3#22#1#3'Top'#2'T'#5'Width'#3#172#2#7'Anchors'#11#5'akTop'#6'a'
+'kLeft'#7'akRight'#8'akBottom'#0#15'AutoExpandDelay'#3#200#0#15'AutoScrollDe'
+'lay'#3#200#0#24'ClipboardFormats.Strings'#1#6#17'Virtual Tree Data'#0#18'Co'
+'lors.BorderColor'#7#12'clWindowText'#15'Colors.HotColor'#7#7'clBlack'#20'Co'
+'lors.TreeLineColor'#7#9'clBtnFace'#17'DefaultNodeHeight'#2' '#20'Header.Aut'
+'oSizeIndex'#2#255#17'Header.Background'#7#14'clBtnHighlight'#13'Header.Heig'
+'ht'#2#22#14'Header.Options'#11#14'hoColumnResize'#16'hoDblClickResize'#6'ho'
+'Drag'#14'hoRestrictDrag'#16'hoShowSortGlyphs'#9'hoVisible'#0#17'Header.Pare'
+'ntFont'#9#12'Header.Style'#7#8'hsPlates'#13'HintAnimation'#7#7'hatNone'#8'H'
+'intMode'#7#6'hmHint'#6'Images'#7#12'SystemImages'#17'IncrementalSearch'#7#5
+'isAll'#6'Indent'#2#20#8'LineMode'#7#7'lmBands'#14'ParentShowHint'#8#13'Root'
+'NodeCount'#2#10'"ScrollBarOptions.VerticalIncrement'#2' '#8'ShowHint'#9#8'T'
+'abOrder'#2#0#28'TreeOptions.AnimationOptions'#11#16'toAnimatedToggle'#0#23
+'TreeOptions.AutoOptions'#11#16'toAutoDropExpand'#12'toAutoScroll'#20'toAuto'
+'ScrollOnExpand'#22'toAutoTristateTracking'#22'toAutoDeleteMovedNodes'#0#24
+'TreeOptions.PaintOptions'#11#16'toShowBackground'#13'toShowButtons'#14'toSh'
+'owDropmark'#19'toShowHorzGridLines'#10'toShowRoot'#15'toShowTreeLines'#19't'
+'oShowVertGridLines'#12'toThemeAware'#0#28'TreeOptions.SelectionOptions'#11
+#15'toFullRowSelect'#0#14'OnCompareNodes'#7#16'VDT1CompareNodes'#10'OnDrawHi'
+'nt'#7#12'VDT1DrawHint'#10'OnDrawNode'#7#12'VDT1DrawNode'#10'OnFreeNode'#7#12
+'VDT1FreeNode'#13'OnGetHintSize'#7#15'VDT1GetHintSize'#15'OnGetImageIndex'#7
+#17'VDT1GetImageIndex'#14'OnGetNodeWidth'#7#16'VDT1GetNodeWidth'#13'OnHeader'
+'Click'#7#15'VDT1HeaderClick'#14'OnInitChildren'#7#16'VDT1InitChildren'#10'O'
+'nInitNode'#7#12'VDT1InitNode'#13'OnStateChange'#7#15'VDT1StateChange'#7'Col'
+'umns'#14#1#7'Options'#11#12'coAllowClick'#9'coEnabled'#13'coParentColor'#11
+'coResizable'#14'coShowDropMark'#9'coVisible'#0#5'Width'#3#217#0#8'WideText'
+#6#15'Image file name'#0#1#8'Position'#2#1#5'Width'#3#200#0#8'WideText'#6#9
+'Thumbnail'#0#1#8'Position'#2#2#5'Width'#3#160#0#8'WideText'#6#10'Properties'
+#0#0#0#0#9'TTrackBar'#9'TrackBar1'#4'Left'#3#8#1#6'Height'#2#21#3'Top'#3'{'#1
+#5'Width'#3#157#0#3'Max'#2'd'#8'OnChange'#7#15'TrackBar1Change'#8'Position'#2
+'2'#8'ScalePos'#7#5'trTop'#9'TickStyle'#7#6'tsNone'#7'Anchors'#11#6'akLeft'#8
+'akBottom'#0#8'TabOrder'#2#1#0#0#10'TImageList'#12'SystemImages'#4'left'#3
+#194#1#3'top'#3#148#1#0#0#0
]);

View File

@ -0,0 +1,756 @@
unit DrawTreeDemo;
{$MODE Delphi}
{$H+}
// 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.
{$ifdef COMPILER_7_UP}
// For some things to work we need code, which is classified as being unsafe for .NET.
// Additionally, there are a few platform warnings, which also have no meaning at all for this project.
{$warn UNSAFE_TYPE off}
{$warn UNSAFE_CAST off}
{$warn UNSAFE_CODE off}
{$warn SYMBOL_PLATFORM off}
{$warn UNIT_PLATFORM off}
{$endif COMPILER_7_UP}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VirtualTrees, StdCtrls, {$ifdef GraphicEx} GraphicEx, {$else} {JPEG,} {$endif}
ImgList, 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: WideString): Cardinal;
procedure RescaleImage(Source, Target: TBitmap);
end;
var
DrawTreeForm: TDrawTreeForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
FileCtrl, ShellAPI, MaskEdit, ShlObj, ActiveX, States;
{.$R *.DFM}
//----------------------------------------------------------------------------------------------------------------------
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: WideString;
Attributes: Cardinal;
OpenIndex,
CloseIndex: Integer; // image indices into the system image list
Image: TBitmap;
Properties: WideString; // some image properties, preformatted
end;
//----------------- utility functions ----------------------------------------------------------------------------------
function IncludeTrailingBackslash(const S: string): string;
begin
if not IsPathDelimiter(S, Length(S)) then
Result := S + '\'
else
Result := S;
end;
//----------------------------------------------------------------------------------------------------------------------
function ExcludeTrailingBackslash(const S: string): string;
begin
Result := S;
if IsPathDelimiter(Result, Length(Result)) then
SetLength(Result, Length(Result) - 1);
end;
//----------------------------------------------------------------------------------------------------------------------
function HasChildren(const Folder: string): Boolean;
// Determines whether folder contains other file objects.
var
SR: TSearchRec;
begin
Result := FindFirst(IncludeTrailingBackslash(Folder) + '*.*', faReadOnly or faHidden or faSysFile or faArchive, 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
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
Closed := GetIconIndex(Name, SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Open := GetIconIndex(Name, SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
end;
//----------------- TDrawTreeForm --------------------------------------------------------------------------------------
procedure TDrawTreeForm.FormCreate(Sender: TObject);
var
SFI: TSHFileInfo;
I,
Count: Integer;
DriveMap,
Mask: Cardinal;
begin
VDT1.NodeDataSize := SizeOf(TShellObjectData);
// Fill root level of image tree. Determine which drives are mapped.
Count := 0;
DriveMap := GetLogicalDrives;
Mask := 1;
for I := 0 to 25 do
begin
if (DriveMap and Mask) <> 0 then
Inc(Count);
Mask := Mask shl 1;
end;
VDT1.RootNodeCount := Count;
// Determine drive strings which are used in the initialization process.
Count := GetLogicalDriveStrings(0, nil);
SetLength(FDriveStrings, Count);
GetLogicalDriveStrings(Count, PChar(FDriveStrings));
//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: WideString): 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
//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(ExcludeTrailingBackslash(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
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: WideString;
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;
DrawTextW(Canvas.Handle, PWideChar(S), Length(S), R, DT_TOP or DT_LEFT or DT_VCENTER or DT_SINGLELINE, False);
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(IncludeTrailingBackslash(Data.FullPath) + '*.*', faAnyFile, SR) = 0 then
begin
Screen.Cursor := crHourGlass;
try
repeat
if (SR.Name <> '.') and (SR.Name <> '..') then
begin
NewName := IncludeTrailingBackslash(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 := ReadAttributes(NewName);
if (ChildData.Attributes and SFGAO_FOLDER) = 0 then
ChildData.Properties := Format('%n KB, ', [SR.Size / 1024]);
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.

View File

@ -0,0 +1,612 @@
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
Windows, LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ExtDlgs, ImgList, Buttons, ExtCtrls, ComCtrls,
MaskEdit, LCLType;
type
// Describes the type of value a property tree node stores in its data property.
TValueType = (
vtNone,
vtString,
vtPickString,
vtNumber,
vtPickNumber,
vtMemo,
vtDate
);
//----------------------------------------------------------------------------------------------------------------------
//todo
TDateTimePicker = TComboBox;
type
// Node data record for the the document properties treeview.
PPropertyData = ^TPropertyData;
TPropertyData = record
ValueType: TValueType;
Value: WideString; // 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 = 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;
if FEdit is TDateTimePicker then
CanAdvance := CanAdvance and not TDateTimePicker(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: WideString;
begin
Result := True;
Data := FTree.GetNodeData(FNode);
if FEdit is TComboBox then
S := TComboBox(FEdit).Text
else
begin
GetWindowText(FEdit.Handle, Buffer, 1024);
S := Buffer;
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 := TDateTimePicker.Create(nil);
with FEdit as TDateTimePicker do
begin
Visible := False;
Parent := Tree;
//todo
{
CalColors.MonthBackColor := clWindow;
CalColors.TextColor := clBlack;
CalColors.TitleBackColor := clBtnShadow;
CalColors.TitleTextColor := clBlack;
CalColors.TrailingTextColor := clBtnFace;
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);
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
begin
GetWindowText(FEdit.Handle, Buffer, 1024);
S := Buffer;
if S <> Data.Value[FColumn - 1] then
begin
Data.Value[FColumn - 1] := S;
Data.Changed := True;
end;
end;
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 := TDateTimePicker.Create(nil);
with FEdit as TDateTimePicker do
begin
Visible := False;
Parent := Tree;
//todo
{
CalColors.MonthBackColor := clWindow;
CalColors.TextColor := clBlack;
CalColors.TitleBackColor := clBtnShadow;
CalColors.TitleTextColor := clBlack;
CalColors.TrailingTextColor := clBtnFace;
Date := StrToDate(Data.Value[FColumn - 1]);
OnKeyDown := EditKeyDown;
}
end;
end;
else
Result := False;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,567 @@
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
{.$include Compilers.inc}
{$ifdef COMPILER_7_UP}
// For some things to work we need code, which is classified as being unsafe for .NET.
{$warn UNSAFE_TYPE off}
{$warn UNSAFE_CAST off}
{$warn UNSAFE_CODE off}
{$endif COMPILER_7_UP}
uses
LCLIntf, LCLType,Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, VTHeaderPopup, VirtualTrees, ComCtrls, ExtCtrls, ImgList, Menus,
StdActns, ActnList, LResources;
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: WideString);
procedure VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
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
ShellAPI, Main, States;
//----------------------------------------------------------------------------------------------------------------------
const
LevelCount = 5;
type
PNodeData2 = ^TNodeData2;
TNodeData2 = record
Caption,
StaticText,
ForeignText: WideString;
ImageIndex,
Level: Integer;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGeneralForm.FormCreate(Sender: TObject);
var
I: Integer;
begin
// Determine if we are running on Windows XP.
ThemeRadioGroup.Enabled := (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
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.)';
ConvertToHighColor(TreeImages);
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: WideString);
// 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;
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
ForeignText := WideChar($2200);
ForeignText := ForeignText + WideChar($2202) + WideChar($221C) + WideChar($221E) + WideChar($2230) +
WideChar($2233) + WideChar($2257) + WideChar($225D) + WideChar($22B6) + WideChar($22BF);
end;
2:
begin
ForeignText := WideChar($32E5);
ForeignText := ForeignText + WideChar($32E6) + WideChar($32E7) + WideChar($32E8) + WideChar($32E9);
end;
3:
begin
ForeignText := WideChar($03B1);
ForeignText := ForeignText + WideChar($03B2) + WideChar($03B3) + WideChar($03B4) + WideChar($03B5) +
WideChar($03B6) + WideChar($03B7) + WideChar($03B8) + WideChar($03B9);
end;
4:
begin
ForeignText := WideChar($20AC);
ForeignText := 'nichts ist unm�glich ' + ForeignText;
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: WideString);
// 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;
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;
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.

View File

@ -0,0 +1,389 @@
object GridForm: TGridForm
Left = 411
Height = 432
Top = 338
Width = 736
HorzScrollBar.Page = 735
VertScrollBar.Page = 431
ActiveControl = VST5
Caption = 'GridForm'
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
object Label15: TLabel
Left = 524
Height = 153
Top = 8
Width = 195
Anchors = [akTop, akRight]
AutoSize = False
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 .'
Color = clNone
ParentColor = False
WordWrap = True
end
object Label1: TLabel
Left = 526
Height = 109
Top = 168
Width = 195
Anchors = [akTop, akRight]
AutoSize = False
Caption = 'The main column in this sample is reduced to an indicator and is set as a fixed column.'
Color = clNone
ParentColor = False
WordWrap = True
end
object VST5: TVirtualStringTree
Left = 8
Height = 384
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
DragMode = dmAutomatic
EditDelay = 300
Font.Height = -11
Font.Name = 'Microsoft Sans Serif'
Header.AutoSizeIndex = 2
Header.Background = clBtnShadow
Header.Font.Height = -12
Header.Font.Name = 'Microsoft Sans Serif'
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoShowImages, hoVisible]
Header.Style = hsFlatButtons
HintAnimation = hatFade
HintMode = hmTooltip
ParentShowHint = False
RootNodeCount = 100
ScrollBarOptions.AlwaysVisible = True
ShowHint = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoTristateTracking]
TreeOptions.MiscOptions = [toAcceptOLEDrop, 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
Columns = <
item
Options = [coParentBidiMode, coVisible, coFixed]
Width = 20
end
item
Margin = 0
Position = 1
Width = 100
WideText = 'Customer ID'
end
item
Margin = 0
Position = 2
Width = 120
WideText = 'First Name'
end
item
Margin = 0
Position = 3
Width = 120
WideText = 'Last Name'
end
item
Margin = 0
Position = 4
Width = 100
WideText = 'Order date'
end>
end
object GridLineCheckBox: TCheckBox
Left = 586
Height = 13
Top = 373
Width = 97
Anchors = [akRight, akBottom]
Caption = 'Toggle grid lines'
Checked = True
OnClick = GridLineCheckBoxClick
State = cbChecked
TabOrder = 1
end
object TreeImages: TImageList
left = 22
top = 36
Bitmap = {
6C691200000010000000100000009C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023464646464646222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C2C2C2C
2C2C2E2E2E2E2E222C0A222E2E2E2C2D2D2D2D2D2D2C2C2E2E2E2E222C0A222E
2E2E2C2D2D2D2D2D2D2C2D2C2E2E2E222C0A222E2E2E2C2D2D2D2D2D2D2C2C2C
2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D
2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E22
2C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D
2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E
2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D
2C2E2E222C0A222E2E2E2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0AAB0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203420
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023464646464646222C0A222A20632023303030303830222C0A222E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E222C0A222E2C2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D
2C2C2E2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D2C2D2C2E2E2E2E2E2E2E222C
0A222E2C2D2C2C2D2C2A2A2A2A2A2A2E2E2E222C0A222E2C2D2D2D2D2D2A2D2D
2D2D2A2A2E2E222C0A222E2C2D2C2C2C2C2A2D2D2D2D2A2D2A2E222C0A222E2C
2D2D2D2D2D2A2D2C2C2D2A2A2A2A222C0A222E2C2D2C2C2C2C2A2D2D2D2D2D2D
2D2A222C0A222E2C2D2D2D2D2D2A2D2C2C2C2C2C2D2A222C0A222E2C2C2C2C2C
2C2A2D2D2D2D2D2D2D2A222C0A222E2E2E2E2E2E2E2A2D2C2C2C2C2C2D2A222C
0A222E2E2E2E2E2E2E2A2D2D2D2D2D2D2D2A222C0A222E2E2E2E2E2E2E2A2A2A
2A2A2A2A2A2A222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AD80100
002F2A2058504D202A2F0A7374617469632063686172202A677261706869635B
5D203D207B0A22313620313620372031222C0A222E2063204E6F6E65222C0A22
2C20632023303030303030222C0A222D20632023464646463030222C0A222A20
632023383038303830222C0A226120632023383038303030222C0A2262206320
23303030303830222C0A226320632023464646464646222C0A222E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C
0A222E2E2C2C2C2C2C2D2D2C2C2C2C2C2E2E222C0A222E2C2A612A2C2D2C2C2D
2C612A612C2E222C0A222E2C612A2C2E2E2E2E2E2E2C612A2C2E222C0A222E2C
2A612C2C2C2C2C2C2C2C2A612C2E222C0A222E2C612A612A612A612A612A612A
2C2E222C0A222E2C2A612A612A626262626262622C2E222C0A222E2C612A612A
6162636363636362622E222C0A222E2C2A612A612A626363636363626362222C
0A222E2C612A612A61626362626263626262222C0A222E2C2A612A612A626363
636363636362222C0A222E2C612A612A61626362626262626362222C0A222E2E
2C2C2C2C2C626363636363636362222C0A222E2E2E2E2E2E2E62626262626262
6262222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0ABA0100002F2A20
58504D202A2F0A7374617469632063686172202A677261706869635B5D203D20
7B0A22313620313620352031222C0A222E20632023464646463030222C0A222C
2063204E6F6E65222C0A222D20632023383038303830222C0A222A2063202330
3030303030222C0A226120632023464646464646222C0A222E2C2C2D2E2C2C2D
2A2A2A2C2C2C2C2C222C0A222D2E2C2D612C2D2E61612A2A2C2C2C2C222C0A22
2C2D2E2D2E2D2E6161612A612A2C2C2C222C0A222C2E2D2E612D2D2D2D612A61
612A2C2C222C0A222D2D2D612E2E616161612A2A2A2A2A2C222C0A222C2C612D
61612D2A2A61616161612A2C222C0A222D2C2C2D2E6161616161616161612A2C
222C0A222C2C2C2D612A2A2A2A2A2A2A61612A2C222C0A222C2C2C2A61616161
6161616161612A2C222C0A222C2C2C2A612A2A2A2A2A2A2A61612A2C222C0A22
2C2C2C2A616161616161616161612A2C222C0A222C2C2C2A612A2A2A2A2A2A2A
61612A2C222C0A222C2C2C2A616161616161616161612A2C222C0A222C2C2C2A
616161616161616161612A2C222C0A222C2C2C2A2A2A2A2A2A2A2A2A2A2A2A2C
222C0A222C2C2C2C2C2C2C2C2C2C2C2C2C2C2C2C227D0A9C0100002F2A205850
4D202A2F0A7374617469632063686172202A677261706869635B5D203D207B0A
22313620313620332031222C0A222E2063204E6F6E65222C0A222C2063202338
3030303030222C0A222D20632023464646464646222C0A222E2E2E2E2E2E2E2E
2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A22
2E2C2C2D2E2E2E2E2E2E2E2E2C2C2D2E222C0A222E2C2C2C2C2D2E2E2E2E2E2C
2C2D2E2E222C0A222E2E2C2C2C2C2D2E2E2E2C2C2D2E2E2E222C0A222E2E2E2E
2C2C2C2D2E2C2D2E2E2E2E2E222C0A222E2E2E2E2E2C2C2C2C2C2D2E2E2E2E2E
222C0A222E2E2E2E2E2E2C2C2C2D2E2E2E2E2E2E222C0A222E2E2E2E2E2C2C2C
2C2C2D2E2E2E2E2E222C0A222E2E2E2E2C2C2C2D2E2C2C2D2E2E2E2E222C0A22
2E2E2E2C2C2C2D2E2E2E2C2C2D2E2E2E222C0A222E2E2C2C2C2D2E2E2E2E2E2C
2D2E2E2E222C0A222E2E2C2C2C2D2E2E2E2E2E2E2C2D2E2E222C0A222E2E2E2C
2D2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2C2D2E
222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AC90100002F2A205850
4D202A2F0A7374617469632063686172202A677261706869635B5D203D207B0A
22313620313620362031222C0A222E2063204E6F6E65222C0A222C2063202330
3030303830222C0A222D20632023464646464646222C0A222A20632023303030
303030222C0A226120632023383038303830222C0A2262206320234646464630
30222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222C2C2C2C2C2C2C
2C2C2C2C2C2C2C2E2E222C0A222C2D2C2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A
222C2C2C2C2C2C2C2C2C2C2C2C2C2A2E2E222C0A222A2E2E2E2A2D2D2D2D2D2D
2D2D2A2E2E222C0A222A2E2E2E2A2D2D2D2D2D2D2D2D2A2E2E222C0A222A2E2E
2E2A2D2D6161612D2D2D2A2E2E222C0A222A2E2E2E2A2D612E622E612D2D2A2E
2E222C0A222A2E2E2E2A612E622E6261616161612E222C0A222A2E2E2E2A612D
2D2D2D2D2D2D2D612A222C0A222A2E2E2E2A612D622E622E622E62612A222C0A
222A2E2E2E2A612D2E622E622E622E612A222C0A222A2A2A2A2A612D622E622E
622E62612A222C0A222E2E2E2E2E616161616161616161612A222C0A222E2E2E
2E2E2E2A2A2A2A2A2A2A2A2A2A222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E227D0AC90100002F2A2058504D202A2F0A7374617469632063686172202A67
7261706869635B5D203D207B0A22313620313620362031222C0A222E2063204E
6F6E65222C0A222C20632023303030303830222C0A222D206320233030303030
30222C0A222A20632023464646464646222C0A22612063202338303830383022
2C0A226220632023303046464646222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222C2C2C2C2C2C
2C2C2C2E2E2E2E2E2E2E222C0A222C2C2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C
0A222D2A2A2A2A2A2A2A2D2E2D2E2E2E2E2E222C0A222D2A61616161612A2D2E
2D2D2E2E2E2E222C0A222D2A2A2A2A2A2A2A2D2E2D622D2E2E2E222C0A222D2A
61612D2D2D2D2D2D2D62622D2E2E222C0A222D2A2A2A2D626262626262626262
2D2E222C0A222D2D2D2D2D626262626262626262622D222C0A222E2E2E2E2D62
62626262626262622D2E222C0A222E2E2E2E2D2D2D2D2D2D2D62622D2E2E222C
0A222E2E2E2E2E2E2E2E2E2E2D622D2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E
2D2D2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2D2E2E2E2E2E222C0A222E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AAB0100002F2A2058504D202A2F0A73
74617469632063686172202A677261706869635B5D203D207B0A223136203136
20342031222C0A222E2063204E6F6E65222C0A222C2063202330303030303022
2C0A222D20632023303030303830222C0A222A20632023464646464646222C0A
222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2C2C2C2C
2C2C2E2D2D222C0A222E2E2E2E2E2E2C2E2E2E2E2E2E2C2D2D222C0A222E2E2E
2E2E2C2E2C2E2E2E2E2E2E2D2D222C0A222C2C2C2C2C2E2C2E2C2E2E2E2E2E2D
2D222C0A222C2A2A2C2E2C2E2C2E2C2E2E2E2C2D2D222C0A222C2A2C2E2C2A2C
2E2C2E2C2C2C2E2D2D222C0A222C2A2A2C2A2A2A2C2E2C2A2C2E2E2E2D222C0A
222C2A2A2A2A2A2A2A2C2A2A2C2E2E2E2E222C0A222C2A2A2A2A2A2A2A2A2A2A
2C2E2E2E2E222C0A222C2A2C2C2A2C2C2C2C2C2A2C2E2E2E2E222C0A222C2A2A
2A2A2A2A2A2A2A2A2C2E2E2E2E222C0A222C2A2C2C2A2C2C2C2C2C2A2C2E2E2E
2E222C0A222C2A2A2A2A2A2A2A2A2A2A2C2E2E2E2E222C0A222C2C2C2C2C2C2C
2C2C2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
F60100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
69635B5D203D207B0A22313620313620392031222C0A222E2063204E6F6E6522
2C0A222C20632023383038303830222C0A222D20632023303030304646222C0A
222A20632023464646464646222C0A226120632023303038303030222C0A2262
20632023303030303030222C0A226320632023464646463030222C0A22642063
2023303038303830222C0A226520632023303030303830222C0A222E2E2E2E2E
2C2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2C2C2D2D2A2E6162622E2E2E2E22
2C0A222E2E2C2D2D2E2A2E61616161622E2E2E222C0A222E2C2D2A2E2A2C2C2C
2C2C2C2C622E2E222C0A222E2C2D2D2A2E2C2A2A2A632A2C2C2E2E222C0A2262
2D2D2E61612C2A632A2A2A2C2A2C2E222C0A22622D2D6161612C2A2A2A632A62
626262222C0A22622D2D6161612C2A636464642C2A2C62222C0A22622D2D2D61
612C2A642A2C61652A2C62222C0A22622D2D2D2D2D2C2A642C612D652A2C6222
2C0A222E622D2D2D2D2C2A642D2D2D652A2C62222C0A222E622D2D2D2D2C2A63
6565652C2A2C62222C0A222E2E622D2D2D2C2A2A2A632A2A2A2C62222C0A222E
2E2E62622D2C2A632A2A2A632A2C62222C0A222E2E2E2E2E622C2C2C2C2C2C2C
2C2C62222C0A222E2E2E2E2E2E62626262626262626262227D0A9C0100002F2A
2058504D202A2F0A7374617469632063686172202A677261706869635B5D203D
207B0A22313620313620332031222C0A222E2063204E6F6E65222C0A222C2063
2023464646464646222C0A222D20632023303038303030222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E222C0A222E2C2C2C2C2C2C2C2C2C2C2C2C2C2C2E22
2C0A222E2C2C2C2C2C2C2C2D2C2C2C2C2C2C2E222C0A222E2C2C2C2C2C2C2C2D
2D2C2C2C2C2C2E222C0A222E2C2C2C2C2D2D2D2D2D2D2C2C2C2C2E222C0A222E
2C2C2C2D2C2C2C2D2D2C2C2C2C2C2E222C0A222E2C2C2C2D2C2C2C2D2C2C2C2C
2C2C2E222C0A222E2C2C2C2D2C2C2C2C2C2C2C2C2C2C2E222C0A222E2C2C2C2C
2C2C2C2C2C2C2D2C2C2C2E222C0A222E2C2C2C2C2C2C2D2C2C2C2D2C2C2C2E22
2C0A222E2C2C2C2C2C2D2D2C2C2C2D2C2C2C2E222C0A222E2C2C2C2C2D2D2D2D
2D2D2C2C2C2C2E222C0A222E2C2C2C2C2C2D2D2C2C2C2C2C2C2C2E222C0A222E
2C2C2C2C2C2C2D2C2C2C2C2C2C2C2E222C0A222E2C2C2C2C2C2C2C2C2C2C2C2C
2C2C2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0ABA0100002F2A
2058504D202A2F0A7374617469632063686172202A677261706869635B5D203D
207B0A22313620313620352031222C0A222E2063204E6F6E65222C0A222C2063
2023383038303830222C0A222D20632023303030303030222C0A222A20632023
464646464646222C0A226120632023303030303830222C0A222E2E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2C2C2C2C2C2C2D2E2E2E2E222C0A
222E2E2E2E2E2C2A2A2A2A2A2D2E2E2E2E222C0A222E2E2E2E2E2C2A2C2C2C2C
2C2C2D2E2E222C0A22612E2E2E2E2C2A2C2A2A2A2A2A2D2E2E222C0A2261612E
2E2E2C2A2C2A2C2C2C2C2C2C2D222C0A226161612E2E2C2A2C2A2C2A2A2A2A2A
2D222C0A22616161612E2C2A2C2A2C2A6161612A2D222C0A226161612E2E2C2A
2C2A2C2A2A2A2A2A2D222C0A2261612E2E2E2D2D2C2A2C2A6161612A2D222C0A
22612E2E2E2E2E2E2C2A2C2A2A2A2A2A2D222C0A222E2E2E2E2E2E2E2D2D2C2A
6161612A2D222C0A222E2E2E2E2E2E2E2E2E2C2A2A2A2A2A2D222C0A222E2E2E
2E2E2E2E2E2E2D2D2D2D2D2D2D222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AC90100002F2A2058
504D202A2F0A7374617469632063686172202A677261706869635B5D203D207B
0A22313620313620362031222C0A222E2063204E6F6E65222C0A222C20632023
383038303830222C0A222D20632023464646463030222C0A222A206320234330
43304330222C0A226120632023464646464646222C0A22622063202330303030
3030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C
2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2D2A2D2A2D2C2E2E2E2E2E2E2E222C
0A222E2C2D2A2D2A2D2A2D2C2C2C2C2C2C2E222C0A222E2C6161616161616161
616161612C62222C0A222E2C612D2A2D2A2D2A2D2A2D2A2D2C62222C0A222E2C
612A2D2A2D2A2D2A2D2A2D2A2C62222C0A222E2C612D2A2D2A2D2A2D2A2D2A2D
2C62222C0A222E2C612A2D2A2D2A2D2A2D2A2D2A2C62222C0A222E2C612D2A2D
2A2D2A2D2A2D2A2D2C62222C0A222E2C612A2D2A2D2A2D2A2D2A2D2A2C62222C
0A222E2C612D2A2D2A2D2A2D2A2D2A2D2C62222C0A222E2C2C2C2C2C2C2C2C2C
2C2C2C2C2C62222C0A222E2E6262626262626262626262626262222C0A222E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A226161616161616161616161616161
6161227D0AC90100002F2A2058504D202A2F0A7374617469632063686172202A
677261706869635B5D203D207B0A22313620313620362031222C0A222E206320
4E6F6E65222C0A222C20632023383038303830222C0A222D2063202346464646
4646222C0A222A20632023464646463030222C0A226120632023433043304330
222C0A226220632023303030303030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E2E222C0A222E2E2E2C2C2C2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2D2D
2D2D2D2C2E2E2E2E2E2E2E222C0A222E2C2D2A612A612A2D2C2C2C2C2C2C2E22
2C0A222E2C2D612A612A612D2D2D2D2D2D2C62222C0A222E2C2D2A612A612A61
2A612A612A2C62222C0A222C2C2C2C2C2C2C2C2C2C2C2C2C2A2C62222C0A222C
2D2D2D2D2D2D2D2D2D2D2C2C612C62222C0A222C2D2A612A612A612A612A2A62
2C2C62222C0A222E2C2D2A612A612A612A612A61622C62222C0A222E2C2D612A
612A612A612A612A622C62222C0A222E2E2C2D612A612A612A612A2A2C626222
2C0A222E2E2C2C2C2C2C2C2C2C2C2C2C2C2C62222C0A222E2E2E626262626262
62626262626262222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222D
2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D227D0ABA0100002F2A2058504D202A2F0A
7374617469632063686172202A677261706869635B5D203D207B0A2231362031
3620352031222C0A222E2063204E6F6E65222C0A222C20632023383038303830
222C0A222D20632023464646464646222C0A222A20632023303030303030222C
0A226120632023433043304330222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E222C0A222E2C2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D2D
2D2C2A2E2E2E2E2E2E222C0A222E2C2D2D2D2D2D2D2C2D2A2E2E2E2E2E222C0A
222E2C2D2D2D2D2D2D2C2A2A2A2E2E2E2E222C0A222E2C2D2D2D2D2D2D616161
2A2E2E2E2E222C0A222E2C2D2D2D2D2D2D2D61612A2E2E2E2E222C0A222E2C2D
2D2D2D2D2D2D2D612A2E2E2E2E222C0A222E2C2D2D2D2D2D2D2D2D612A2E2E2E
2E222C0A222E2C2D2D2D2D2D2D2D2D612A2E2E2E2E222C0A222E2C2D2D2D2D2D
2D2D2D612A2E2E2E2E222C0A222E2C2D2D2D2D2D2D2D2D612A2E2E2E2E222C0A
222E2C6161616161616161612A2E2E2E2E222C0A222E2A2A2A2A2A2A2A2A2A2A
2A2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222D2D2D
2D2D2D2D2D2D2D2D2D2D2D2D2D227D0AF60100002F2A2058504D202A2F0A7374
617469632063686172202A677261706869635B5D203D207B0A22313620313620
392031222C0A222E2063204E6F6E65222C0A222C20632023383038303830222C
0A222D20632023464646464646222C0A222A20632023303030303030222C0A22
6120632023303030304646222C0A226220632023303030303830222C0A226320
632023303038303830222C0A226420632023433043304330222C0A2265206320
23464646463030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E
2C2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D2D2D2C2A2E2E2E
2E6162222C0A222E2C2D2D2D2D2D2D2C2D2A2E2E616362222C0A222E2C2D2D2D
2D2D2D2C2A2A2A6163622E222C0A222E2C2D2D2D2D2D2D6464646163622E2E22
2C0A222E2C2D2D2D2D2D2D2D646163622E2E2E222C0A222E2C2D2D2D2D2D2D2D
6163622E2E2E2E222C0A222E2C2D2D2D2D2D2D6163622A2E2E2E2E222C0A222E
2C2D2D2D2D2D2C6562642A2E2E2E2E222C0A222E2C2D2D2D2D2D642C2D642A2E
2E2E2E222C0A222E2C2D2D2D2D2A2C2D2D642A2E2E2E2E222C0A222E2C646464
6464646464642A2E2E2E2E222C0A222E2A2A2A2A2A2A2A2A2A2A2A2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222D2D2D2D2D2D2D2D2D
2D2D2D2D2D2D2D227D0ABA0100002F2A2058504D202A2F0A7374617469632063
686172202A677261706869635B5D203D207B0A22313620313620352031222C0A
222E20632023383038303830222C0A222C2063204E6F6E65222C0A222D206320
23464646464646222C0A222A20632023303030303030222C0A22612063202343
3043304330222C0A222E2E2E2E2E2E2E2E2C2C2C2C2C2C2C2C222C0A222E2D2E
2E2E2E2E2E2E2E2C2C2C2C2C2C222C0A222E2D2E2D2E2E2E2E2E2E2E2E2C2C2C
2C222C0A222E2D2E2D2E2D2D2D2D2D2D2E2A2C2C2C222C0A222E2D2E2D2E2D2D
2D2D2D2D2E2D2A2C2C222C0A222E2D2E2D2E2D2D2D2D2D2D2E2A2A2A2C222C0A
222E2D2E2D2E2D2D2D2D2D2D6161612A2C222C0A222E2D2E2D2E2D2D2D2D2D2D
2D61612A2C222C0A222E2D2E2D2E2D2D2D2D2D2D2D2D612A2C222C0A222E2D2E
2D2E2D2D2D2D2D2D2D2D612A2C222C0A222E2D2E2D2E2D2D2D2D2D2D2D2D612A
2C222C0A222E612E2D2E2D2D2D2D2D2D2D2D612A2C222C0A222A2A2E612E2D2D
2D2D2D2D2D2D612A2C222C0A222C2C2A2A2E6161616161616161612A2C222C0A
222C2C2C2C2A2A2A2A2A2A2A2A2A2A2A2C222C0A222D2D2D2D2D2D2D2D2D2D2D
2D2D2D2D2D227D0AF60100002F2A2058504D202A2F0A73746174696320636861
72202A677261706869635B5D203D207B0A22313620313620392031222C0A222E
20632023383038303830222C0A222C2063204E6F6E65222C0A222D2063202346
4646464646222C0A222A20632023303030304646222C0A226120632023303030
303830222C0A226220632023303030303030222C0A2263206320233030383038
30222C0A226420632023433043304330222C0A22652063202346464646303022
2C0A222E2E2E2E2E2E2E2E2C2C2C2C2C2C2C2C222C0A222E2D2E2E2E2E2E2E2E
2E2C2C2C2C2C2C222C0A222E2D2E2D2E2E2E2E2E2E2E2E2C2C2A61222C0A222E
2D2E2D2E2D2D2D2D2D2D2E622A6361222C0A222E2D2E2D2E2D2D2D2D2D2D2E2A
63612C222C0A222E2D2E2D2E2D2D2D2D2D2D2A6361622C222C0A222E2D2E2D2E
2D2D2D2D2D2A636164622C222C0A222E2D2E2D2E2D2D2D2D2A63616464622C22
2C0A222E2D2E2D2E2D2D2D2A63612D2D64622C222C0A222E2D2E2D2E2D2D2E65
612D2D2D64622C222C0A222E2D2E2D2E2D2D642E2D2D2D2D64622C222C0A222E
642E2D2E2D622E2D2D2D2D2D64622C222C0A2262622E642E2D2D2D2D2D2D2D2D
64622C222C0A222C2C62622E646464646464646464622C222C0A222C2C2C2C62
626262626262626262622C222C0A222D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D22
7D0A8D0100002F2A2058504D202A2F0A7374617469632063686172202A677261
706869635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E
65222C0A222C20632023303030303030222C0A222E2E2E2E2E2E2E2E2E2E2E2E
2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2E
2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2E2E2E2E2E2E2E2E2E2E2E2E
222C0A222E2E2C2C2C2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2E2E
2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C0A22
2E2E2C2C2C2C2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2C2C2E2E2E
2E2E2E2E222C0A222E2E2C2C2C2C2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2C
2C2C2C2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2E2E2E2E2E2E2E2E2E2E
222C0A222E2E2C2C2C2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2E2E2E2E
2E2E2E2E2E2E2E2E222C0A222E2E2C2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A22
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
}
end
end

View File

@ -0,0 +1,186 @@
LazarusResources.Add('TGridForm','FORMDATA',[
'TPF0'#9'TGridForm'#8'GridForm'#4'Left'#3#155#1#6'Height'#3#176#1#3'Top'#3'R'
+#1#5'Width'#3#224#2#18'HorzScrollBar.Page'#3#223#2#18'VertScrollBar.Page'#3
+#175#1#13'ActiveControl'#7#4'VST5'#7'Caption'#6#8'GridForm'#11'Font.Height'#2
+#243#9'Font.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10'FormCreate'#0#6'TLabe'
+'l'#7'Label15'#4'Left'#3#12#2#6'Height'#3#153#0#3'Top'#2#8#5'Width'#3#195#0#7
+'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#8#7'Caption'#6#255'This sampl'
+'e demonstrates the grid extensions introduced in Virtual Treeview. The main'
+' difference to normal mode is the way cell content is handled (editing, se'
+'lection etc.). In Grid mode always the entire cell is used. Another point i'
+'s the key handling .'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#0
+#0#6'TLabel'#6'Label1'#4'Left'#3#14#2#6'Height'#2'm'#3'Top'#3#168#0#5'Width'
+#3#195#0#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#8#7'Caption'#6'WThe'
+' main column in this sample is reduced to an indicator and is set as a fixe'
+'d column.'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#0#0#18'TVir'
+'tualStringTree'#4'VST5'#4'Left'#2#8#6'Height'#3#128#1#3'Top'#2#6#5'Width'#3
+#243#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#24'Clipboar'
+'dFormats.Strings'#1#6#3'CSV'#6#11'HTML Format'#6#10'Plain text'#6#16'Rich T'
+'ext Format'#6' Rich Text Format Without Objects'#6#12'Unicode text'#6#17'Vi'
+'rtual Tree Data'#0#18'Colors.BorderColor'#7#12'clWindowText'#15'Colors.HotC'
+'olor'#7#7'clBlack'#17'DefaultNodeHeight'#2#19#8'DragMode'#7#11'dmAutomatic'
+#9'EditDelay'#3','#1#11'Font.Height'#2#245#9'Font.Name'#6#20'Microsoft Sans '
+'Serif'#20'Header.AutoSizeIndex'#2#2#17'Header.Background'#7#11'clBtnShadow'
+#18'Header.Font.Height'#2#244#16'Header.Font.Name'#6#20'Microsoft Sans Serif'
+#14'Header.Options'#11#14'hoColumnResize'#16'hoDblClickResize'#6'hoDrag'#12
+'hoShowImages'#9'hoVisible'#0#12'Header.Style'#7#13'hsFlatButtons'#13'HintAn'
+'imation'#7#7'hatFade'#8'HintMode'#7#9'hmTooltip'#14'ParentShowHint'#8#13'Ro'
+'otNodeCount'#2'd'#30'ScrollBarOptions.AlwaysVisible'#9#8'ShowHint'#9#8'TabO'
+'rder'#2#0#23'TreeOptions.AutoOptions'#11#16'toAutoDropExpand'#12'toAutoScro'
+'ll'#22'toAutoTristateTracking'#0#23'TreeOptions.MiscOptions'#11#15'toAccept'
+'OLEDrop'#10'toEditable'#16'toGridExtensions'#12'toInitOnSave'#18'toToggleOn'
+'DblClick'#14'toWheelPanning'#0#24'TreeOptions.PaintOptions'#11#10'toHotTrac'
+'k'#13'toShowButtons'#14'toShowDropmark'#19'toShowHorzGridLines'#19'toShowVe'
+'rtGridLines'#18'toUseBlendedImages'#0#28'TreeOptions.SelectionOptions'#11#22
+'toDisableDrawSelection'#15'toExtendedFocus'#19'toMiddleClickSelect'#13'toMu'
+'ltiSelect'#18'toRightClickSelect'#22'toCenterScrollIntoView'#0#8'WantTabs'#9
+#16'OnAfterCellPaint'#7#18'VST5AfterCellPaint'#17'OnBeforeCellPaint'#7#19'VS'
+'T5BeforeCellPaint'#17'OnBeforeItemErase'#7#19'VST5BeforeItemErase'#14'OnCre'
+'ateEditor'#7#16'VST5CreateEditor'#15'OnFocusChanging'#7#17'VST5FocusChangin'
+'g'#9'OnGetText'#7#11'VST5GetText'#11'OnPaintText'#7#13'VST5PaintText'#10'On'
+'InitNode'#7#12'VST5InitNode'#13'OnStateChange'#7#15'VST5StateChange'#7'Colu'
+'mns'#14#1#7'Options'#11#16'coParentBidiMode'#9'coVisible'#7'coFixed'#0#5'Wi'
+'dth'#2#20#0#1#6'Margin'#2#0#8'Position'#2#1#5'Width'#2'd'#8'WideText'#6#11
+'Customer ID'#0#1#6'Margin'#2#0#8'Position'#2#2#5'Width'#2'x'#8'WideText'#6
+#10'First Name'#0#1#6'Margin'#2#0#8'Position'#2#3#5'Width'#2'x'#8'WideText'#6
+#9'Last Name'#0#1#6'Margin'#2#0#8'Position'#2#4#5'Width'#2'd'#8'WideText'#6
+#10'Order date'#0#0#0#0#9'TCheckBox'#16'GridLineCheckBox'#4'Left'#3'J'#2#6'H'
+'eight'#2#13#3'Top'#3'u'#1#5'Width'#2'a'#7'Anchors'#11#7'akRight'#8'akBottom'
+#0#7'Caption'#6#17'Toggle grid lines'#7'Checked'#9#7'OnClick'#7#21'GridLineC'
+'heckBoxClick'#5'State'#7#9'cbChecked'#8'TabOrder'#2#1#0#0#10'TImageList'#10
+'TreeImages'#4'left'#2#22#3'top'#2'$'#6'Bitmap'#10#211#31#0#0'li'#18#0#0#0#16
+#0#0#0#16#0#0#0#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 1'
+'6 3 1",'#10'". c None",'#10'", c #000000",'#10'"- c #FFFFFF",'#10'"........'
+'........",'#10'"................",'#10'"...,,,,,,,,.....",'#10'"...,------,'
+',....",'#10'"...,------,-,...",'#10'"...,------,,,,..",'#10'"...,---------,'
+'..",'#10'"...,---------,..",'#10'"...,---------,..",'#10'"...,---------,.."'
+','#10'"...,---------,..",'#10'"...,---------,..",'#10'"...,---------,..",'
+#10'"...,---------,..",'#10'"...,,,,,,,,,,,..",'#10'"................"}'#10
+#171#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 4 1",'#10'". '
+'c None",'#10'", c #000000",'#10'"- c #FFFFFF",'#10'"* c #000080",'#10'"....'
+'............",'#10'"................",'#10'".,,,,,,.........",'#10'".,----,'
+',........",'#10'".,----,-,.......",'#10'".,-,,-,******...",'#10'".,-----*--'
+'--**..",'#10'".,-,,,,*----*-*.",'#10'".,-----*-,,-****",'#10'".,-,,,,*-----'
+'--*",'#10'".,-----*-,,,,,-*",'#10'".,,,,,,*-------*",'#10'".......*-,,,,,-*'
+'",'#10'".......*-------*",'#10'".......*********",'#10'"................"}'
,#10#216#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 7 1",'#10
+'". c None",'#10'", c #000000",'#10'"- c #FFFF00",'#10'"* c #808080",'#10'"a'
+' c #808000",'#10'"b c #000080",'#10'"c c #FFFFFF",'#10'"................",'
+#10'"......,,,,......",'#10'"..,,,,,--,,,,,..",'#10'".,*a*,-,,-,a*a,.",'#10
+'".,a*,......,a*,.",'#10'".,*a,,,,,,,,*a,.",'#10'".,a*a*a*a*a*a*,.",'#10'".,'
+'*a*a*bbbbbbb,.",'#10'".,a*a*abcccccbb.",'#10'".,*a*a*bcccccbcb",'#10'".,a*a'
+'*abcbbbcbbb",'#10'".,*a*a*bcccccccb",'#10'".,a*a*abcbbbbbcb",'#10'"..,,,,,b'
+'cccccccb",'#10'".......bbbbbbbbb",'#10'"................"}'#10#186#1#0#0'/*'
+' XPM */'#10'static char *graphic[] = {'#10'"16 16 5 1",'#10'". c #FFFF00",'
+#10'", c None",'#10'"- c #808080",'#10'"* c #000000",'#10'"a c #FFFFFF",'#10
+'".,,-.,,-***,,,,,",'#10'"-.,-a,-.aa**,,,,",'#10'",-.-.-.aaa*a*,,,",'#10'",.'
+'-.a----a*aa*,,",'#10'"---a..aaaa*****,",'#10'",,a-aa-**aaaaa*,",'#10'"-,,-.'
+'aaaaaaaaa*,",'#10'",,,-a*******aa*,",'#10'",,,*aaaaaaaaaa*,",'#10'",,,*a***'
+'****aa*,",'#10'",,,*aaaaaaaaaa*,",'#10'",,,*a*******aa*,",'#10'",,,*aaaaaaa'
+'aaa*,",'#10'",,,*aaaaaaaaaa*,",'#10'",,,************,",'#10'",,,,,,,,,,,,,,'
+',,"}'#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1"'
+','#10'". c None",'#10'", c #800000",'#10'"- c #FFFFFF",'#10'"..............'
+'..",'#10'"................",'#10'".,,-........,,-.",'#10'".,,,,-.....,,-.."'
+','#10'"..,,,,-...,,-...",'#10'"....,,,-.,-.....",'#10'".....,,,,,-.....",'
+#10'"......,,,-......",'#10'".....,,,,,-.....",'#10'"....,,,-.,,-....",'#10
+'"...,,,-...,,-...",'#10'"..,,,-.....,-...",'#10'"..,,,-......,-..",'#10'"..'
+'.,-...........",'#10'".............,-.",'#10'"................"}'#10#201#1#0
+#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 6 1",'#10'". c None",'
+#10'", c #000080",'#10'"- c #FFFFFF",'#10'"* c #000000",'#10'"a c #808080",'
+#10'"b c #FFFF00",'#10'"................",'#10'",,,,,,,,,,,,,,..",'#10'",-,,'
+',,,,,,,,,,..",'#10'",,,,,,,,,,,,,*..",'#10'"*...*--------*..",'#10'"*...*--'
+'------*..",'#10'"*...*--aaa---*..",'#10'"*...*-a.b.a--*..",'#10'"*...*a.b.b'
+'aaaaa.",'#10'"*...*a--------a*",'#10'"*...*a-b.b.b.ba*",'#10'"*...*a-.b.b.b'
+'.a*",'#10'"*****a-b.b.b.ba*",'#10'".....aaaaaaaaaa*",'#10'"......**********'
+'",'#10'"................"}'#10#201#1#0#0'/* XPM */'#10'static char *graphic'
+'[] = {'#10'"16 16 6 1",'#10'". c None",'#10'", c #000080",'#10'"- c #000000'
+'",'#10'"* c #FFFFFF",'#10'"a c #808080",'#10'"b c #00FFFF",'#10'"..........'
+'......",'#10'"................",'#10'",,,,,,,,,.......",'#10'",,,,,,,,,....'
+'...",'#10'"-*******-.-.....",'#10'"-*aaaaa*-.--....",'#10'"-*******-.-b-...'
+'",'#10'"-*aa-------bb-..",'#10'"-***-bbbbbbbbb-.",'#10'"-----bbbbbbbbbb-",'
+#10'"....-bbbbbbbbb-.",'#10'"....-------bb-..",'#10'"..........-b-...",'#10
+'"..........--....",'#10'"..........-.....",'#10'"................"}'#10#171
+#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 4 1",'#10'". c No'
+'ne",'#10'", c #000000",'#10'"- c #000080",'#10'"* c #FFFFFF",'#10'"........'
+'........",'#10'".......,,,,,,.--",'#10'"......,......,--",'#10'".....,.,...'
+'...--",'#10'",,,,,.,.,.....--",'#10'",**,.,.,.,...,--",'#10'",*,.,*,.,.,,,.'
+'--",'#10'",**,***,.,*,...-",'#10'",*******,**,....",'#10'",**********,...."'
+','#10'",*,,*,,,,,*,....",'#10'",**********,....",'#10'",*,,*,,,,,*,....",'
+#10'",**********,....",'#10'",,,,,,,,,,,,....",'#10'"................"}'#10
+#246#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 9 1",'#10'". '
+'c None",'#10'", c #808080",'#10'"- c #0000FF",'#10'"* c #FFFFFF",'#10'"a c '
+'#008000",'#10'"b c #000000",'#10'"c c #FFFF00",'#10'"d c #008080",'#10'"e c'
+' #000080",'#10'".....,,,,,......",'#10'"...,,--*.abb....",'#10'"..,--.*.aaa'
+'ab...",'#10'".,-*.*,,,,,,,b..",'#10'".,--*.,***c*,,..",'#10'"b--.aa,*c***,*'
+',.",'#10'"b--aaa,***c*bbbb",'#10'"b--aaa,*cddd,*,b",'#10'"b---aa,*d*,ae*,b"'
+','#10'"b-----,*d,a-e*,b",'#10'".b----,*d---e*,b",'#10'".b----,*ceee,*,b",'
+#10'"..b---,***c***,b",'#10'"...bb-,*c***c*,b",'#10'".....b,,,,,,,,,b",'#10
+'"......bbbbbbbbbb"}'#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'
+#10'"16 16 3 1",'#10'". c None",'#10'", c #FFFFFF",'#10'"- c #008000",'#10'"'
+'................",'#10'".,,,,,,,,,,,,,,.",'#10'".,,,,,,,-,,,,,,.",'#10'".,,'
+',,,,,--,,,,,.",'#10'".,,,,------,,,,.",'#10'".,,,-,,,--,,,,,.",'#10'".,,,-,'
+',,-,,,,,,.",'#10'".,,,-,,,,,,,,,,.",'#10'".,,,,,,,,,,-,,,.",'#10'".,,,,,,-,'
+',,-,,,.",'#10'".,,,,,--,,,-,,,.",'#10'".,,,,------,,,,.",'#10'".,,,,,--,,,,'
+',,,.",'#10'".,,,,,,-,,,,,,,.",'#10'".,,,,,,,,,,,,,,.",'#10'"...............'
+'."}'#10#186#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 5 1",'
+#10'". c None",'#10'", c #808080",'#10'"- c #000000",'#10'"* c #FFFFFF",'#10
+'"a c #000080",'#10'"................",'#10'".....,,,,,,-....",'#10'".....,*'
+'****-....",'#10'".....,*,,,,,,-..",'#10'"a....,*,*****-..",'#10'"aa...,*,*,'
+',,,,,-",'#10'"aaa..,*,*,*****-",'#10'"aaaa.,*,*,*aaa*-",'#10'"aaa..,*,*,***'
,'**-",'#10'"aa...--,*,*aaa*-",'#10'"a......,*,*****-",'#10'".......--,*aaa*-'
+'",'#10'".........,*****-",'#10'".........-------",'#10'"................",'
+#10'"................"}'#10#201#1#0#0'/* XPM */'#10'static char *graphic[] ='
+' {'#10'"16 16 6 1",'#10'". c None",'#10'", c #808080",'#10'"- c #FFFF00",'
+#10'"* c #C0C0C0",'#10'"a c #FFFFFF",'#10'"b c #000000",'#10'"..............'
+'..",'#10'"...,,,,,........",'#10'"..,-*-*-,.......",'#10'".,-*-*-*-,,,,,,."'
+','#10'".,aaaaaaaaaaaa,b",'#10'".,a-*-*-*-*-*-,b",'#10'".,a*-*-*-*-*-*,b",'
+#10'".,a-*-*-*-*-*-,b",'#10'".,a*-*-*-*-*-*,b",'#10'".,a-*-*-*-*-*-,b",'#10
+'".,a*-*-*-*-*-*,b",'#10'".,a-*-*-*-*-*-,b",'#10'".,,,,,,,,,,,,,,b",'#10'"..'
+'bbbbbbbbbbbbbb",'#10'"................",'#10'"aaaaaaaaaaaaaaaa"}'#10#201#1#0
+#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 6 1",'#10'". c None",'
+#10'", c #808080",'#10'"- c #FFFFFF",'#10'"* c #FFFF00",'#10'"a c #C0C0C0",'
+#10'"b c #000000",'#10'"................",'#10'"...,,,,,........",'#10'"..,-'
+'----,.......",'#10'".,-*a*a*-,,,,,,.",'#10'".,-a*a*a------,b",'#10'".,-*a*a'
+'*a*a*a*,b",'#10'",,,,,,,,,,,,,*,b",'#10'",----------,,a,b",'#10'",-*a*a*a*a'
+'**b,,b",'#10'".,-*a*a*a*a*ab,b",'#10'".,-a*a*a*a*a*b,b",'#10'"..,-a*a*a*a**'
+',bb",'#10'"..,,,,,,,,,,,,,b",'#10'"...bbbbbbbbbbbbb",'#10'"................'
+'",'#10'"----------------"}'#10#186#1#0#0'/* XPM */'#10'static char *graphic'
+'[] = {'#10'"16 16 5 1",'#10'". c None",'#10'", c #808080",'#10'"- c #FFFFFF'
+'",'#10'"* c #000000",'#10'"a c #C0C0C0",'#10'"................",'#10'".,,,,'
+',,,,.......",'#10'".,------,*......",'#10'".,------,-*.....",'#10'".,------'
+',***....",'#10'".,------aaa*....",'#10'".,-------aa*....",'#10'".,--------a'
+'*....",'#10'".,--------a*....",'#10'".,--------a*....",'#10'".,--------a*..'
+'..",'#10'".,--------a*....",'#10'".,aaaaaaaaa*....",'#10'".***********...."'
+','#10'"................",'#10'"----------------"}'#10#246#1#0#0'/* XPM */'
+#10'static char *graphic[] = {'#10'"16 16 9 1",'#10'". c None",'#10'", c #80'
+'8080",'#10'"- c #FFFFFF",'#10'"* c #000000",'#10'"a c #0000FF",'#10'"b c #0'
+'00080",'#10'"c c #008080",'#10'"d c #C0C0C0",'#10'"e c #FFFF00",'#10'".....'
+'...........",'#10'".,,,,,,,,.......",'#10'".,------,*....ab",'#10'".,------'
+',-*..acb",'#10'".,------,***acb.",'#10'".,------dddacb..",'#10'".,-------da'
+'cb...",'#10'".,-------acb....",'#10'".,------acb*....",'#10'".,-----,ebd*..'
+'..",'#10'".,-----d,-d*....",'#10'".,----*,--d*....",'#10'".,ddddddddd*...."'
+','#10'".***********....",'#10'"................",'#10'"----------------"}'
+#10#186#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 5 1",'#10
+'". c #808080",'#10'", c None",'#10'"- c #FFFFFF",'#10'"* c #000000",'#10'"a'
+' c #C0C0C0",'#10'"........,,,,,,,,",'#10'".-........,,,,,,",'#10'".-.-.....'
+'...,,,,",'#10'".-.-.------.*,,,",'#10'".-.-.------.-*,,",'#10'".-.-.------.'
+'***,",'#10'".-.-.------aaa*,",'#10'".-.-.-------aa*,",'#10'".-.-.--------a*'
+',",'#10'".-.-.--------a*,",'#10'".-.-.--------a*,",'#10'".a.-.--------a*,",'
+#10'"**.a.--------a*,",'#10'",,**.aaaaaaaaa*,",'#10'",,,,***********,",'#10
+'"----------------"}'#10#246#1#0#0'/* XPM */'#10'static char *graphic[] = {'
+#10'"16 16 9 1",'#10'". c #808080",'#10'", c None",'#10'"- c #FFFFFF",'#10'"'
+'* c #0000FF",'#10'"a c #000080",'#10'"b c #000000",'#10'"c c #008080",'#10
+'"d c #C0C0C0",'#10'"e c #FFFF00",'#10'"........,,,,,,,,",'#10'".-........,,'
+',,,,",'#10'".-.-........,,*a",'#10'".-.-.------.b*ca",'#10'".-.-.------.*ca'
+',",'#10'".-.-.------*cab,",'#10'".-.-.-----*cadb,",'#10'".-.-.----*caddb,",'
+#10'".-.-.---*ca--db,",'#10'".-.-.--.ea---db,",'#10'".-.-.--d.----db,",'#10
+'".d.-.-b.-----db,",'#10'"bb.d.--------db,",'#10'",,bb.dddddddddb,",'#10'",,'
+',,bbbbbbbbbbb,",'#10'"----------------"}'#10#141#1#0#0'/* XPM */'#10'static'
+' char *graphic[] = {'#10'"16 16 2 1",'#10'". c None",'#10'", c #000000",'#10
+'"................",'#10'"................",'#10'"..,.............",'#10'"..'
+',,............",'#10'"..,,,...........",'#10'"..,,,,..........",'#10'"..,,,'
+',,.........",'#10'"..,,,,,,........",'#10'"..,,,,,,,.......",'#10'"..,,,,,,'
+'........",'#10'"..,,,,,.........",'#10'"..,,,,..........",'#10'"..,,,......'
+'.....",'#10'"..,,............",'#10'"..,.............",'#10'"..............'
+'.."}'#10#0#0#0
]);

View File

@ -0,0 +1,231 @@
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
Windows, LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ImgList, LResources;
type
TGridForm = class(TForm)
VST5: TVirtualStringTree;
GridLineCheckBox: TCheckBox;
Label15: TLabel;
TreeImages: TImageList;
Label1: TLabel;
procedure VST5BeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; CellRect: 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: WideString);
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: WideString);
var
Data: PGridData;
begin
if Column > 0 then
begin
Data := Sender.GetNodeData(Node);
CellText := 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; CellRect: 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.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

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, Types, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, VirtualTrees, StdCtrls, ExtCtrls, LResources;
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: WideString);
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;
//----------------------------------------------------------------------------------------------------------------------
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 := clInfoBk;
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);
VirtualTrees.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 := pf32Bit;
FBackBitmap2 := TBitmap.Create;
FBackBitmap2.PixelFormat := pf32Bit;
CreateCheckerBackground;
FHeaderBitmap := TBitmap.Create;
//FHeaderBitmap.Handle := LoadImage(HInstance, 'Transcriptions', IMAGE_BITMAP, 0, 0, LR_DEFAULTCOLOR);
FHeaderBitmap.LoadFromResourceName(HINSTANCE,'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: WideString);
begin
CellText := 'Some simple text.';
end;
//----------------------------------------------------------------------------------------------------------------------
initialization
{$i HeaderCustomDrawDemo.lrs}
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,34 @@
object MainForm: TMainForm
Left = 457
Height = 605
Top = 243
Width = 856
HorzScrollBar.Page = 855
VertScrollBar.Page = 604
Caption = 'Virtual Treeview features demo'
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
OnShow = FormShow
Position = poScreenCenter
object Bevel1: TBevel
Height = 2
Width = 856
Align = alTop
Shape = bsTopLine
end
object StatusBar: TStatusBar
Height = 20
Top = 585
Width = 856
Panels = <>
end
object ContainerPanel: TPanel
Height = 583
Top = 2
Width = 856
Align = alClient
BevelOuter = bvNone
TabOrder = 0
end
end

View File

@ -0,0 +1,218 @@
unit Main;
{$MODE Delphi}
{$H+}
// 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
{.$include Compilers.inc}
{$ifdef COMPILER_7_UP}
// For some things to work we need code, which is classified as being unsafe for .NET.
{$warn UNSAFE_TYPE off}
{$warn UNSAFE_CAST off}
{$warn UNSAFE_CODE off}
{$endif COMPILER_7_UP}
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;
Bevel1: TBevel;
MainPanel: TPanel;
Bevel2: TBevel;
Bevel3: TBevel;
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 ConvertToHighColor(ImageList: TImageList);
procedure LoadUnicodeStrings(Name: string; var Strings: array of WideString);
procedure SetStatusbarText(const S: string);
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
SpeedDemo, GeneralAbilitiesDemo, DrawTreeDemo, PropertiesDemo,
GridDemo, VisibilityDemo, AlignDemo, WindowsXPStyleDemo, MultilineDemo, HeaderCustomDrawDemo,
States;
//----------------------------------------------------------------------------------------------------------------------
procedure ConvertToHighColor(ImageList: TImageList);
// To show smooth images we have to convert the image list from 16 colors to high color.
var
IL: TImageList;
begin
// Have to create a temporary copy of the given list, because the list is cleared on handle creation.
//todo
{
IL := TImageList.Create(nil);
IL.Assign(ImageList);
with ImageList do
Handle := ImageList_Create(Width, Height, ILC_COLOR16 or ILC_MASK, Count, AllocBy);
ImageList.Assign(IL);
IL.Free;
}
end;
//----------------------------------------------------------------------------------------------------------------------
procedure LoadUnicodeStrings(Name: string; var Strings: array of WideString);
// Loads the Unicode strings from the resource.
var
Stream: TResourceStream;
Head, Tail: PWideChar;
I: Integer;
begin
Stream := TResourceStream.Create(0, Name, 'Unicode');
try
Head := Stream.Memory;
// Skip byte order mark.
Inc(Head);
Tail := Head;
for I := 0 to High(Strings) do
begin
Head := Tail;
while not (Tail^ in [WideChar(#0), WideChar(#13)]) do
Inc(Tail);
SetString(Strings[I], Head, Tail - Head);
// Skip carriage return and linefeed.
Inc(Tail, 2);
end;
finally
Stream.Free;
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}
end.

View File

@ -0,0 +1,99 @@
object NodeForm: TNodeForm
Left = 573
Height = 542
Top = 332
Width = 773
HorzScrollBar.Page = 772
VertScrollBar.Page = 541
ActiveControl = MLTree
Caption = 'NodeForm'
ClientHeight = 542
ClientWidth = 773
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
object Label8: TLabel
Left = 12
Height = 72
Top = 429
Width = 732
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
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).'
Color = clNone
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
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Options = [hoAutoResize, hoColumnResize, hoDrag]
HintAnimation = hatNone
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
Columns = <
item
Position = 1
Width = 483
end
item
end>
end
end
object AutoAdjustCheckBox: TCheckBox
Left = 12
Height = 13
Top = 408
Width = 234
Anchors = [akLeft, akBottom]
Caption = 'Automatically adjust node height to node text.'
OnClick = AutoAdjustCheckBoxClick
TabOrder = 1
end
end

View File

@ -0,0 +1,44 @@
LazarusResources.Add('TNodeForm','FORMDATA',[
'TPF0'#9'TNodeForm'#8'NodeForm'#4'Left'#3'='#2#6'Height'#3#30#2#3'Top'#3'L'#1
+#5'Width'#3#5#3#18'HorzScrollBar.Page'#3#4#3#18'VertScrollBar.Page'#3#29#2#13
+'ActiveControl'#7#6'MLTree'#7'Caption'#6#8'NodeForm'#12'ClientHeight'#3#30#2
+#11'ClientWidth'#3#5#3#11'Font.Height'#2#243#9'Font.Name'#6#13'MS Sans Serif'
+#8'OnCreate'#7#10'FormCreate'#0#6'TLabel'#6'Label8'#4'Left'#2#12#6'Height'#2
+'H'#3'Top'#3#173#1#5'Width'#3#220#2#7'Anchors'#11#6'akLeft'#7'akRight'#8'akB'
+'ottom'#0#8'AutoSize'#8#7'Caption'#12#199#1#0#0'Since Virtual Treeview uses '
+'Unicode for text display it is not easy to provide multiline support on Win'
+'dows 9x/Me systems. Under Windows NT (4.0, 2000, XP) there is support by th'
+'e operation system and so full word breaking is possible there. Otherwise y'
+'ou have to insert line breaks manually to have multiline captions. Of cours'
+'e there is no difference in handling between multiline and single line node'
+'s (except for the vertical alignment of the latter).'#5'Color'#7#6'clNone'
+#11'ParentColor'#8#13'ShowAccelChar'#8#8'WordWrap'#9#0#0#6'TPanel'#6'Panel1'
+#4'Left'#2#12#6'Height'#3#137#1#3'Top'#2#4#5'Width'#3#220#2#7'Anchors'#11#5
+'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#12'ClientHeight'#3#137#1#11'Clien'
+'tWidth'#3#220#2#5'Color'#7#14'clAppWorkspace'#11'ParentColor'#8#8'TabOrder'
+#2#0#0#18'TVirtualStringTree'#6'MLTree'#4'Left'#2'`'#6'Height'#3'u'#1#3'Top'
+#2#8#5'Width'#3'%'#2#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'
+#0#24'ClipboardFormats.Strings'#1#6#3'CSV'#6#11'HTML Format'#6#10'Plain text'
+#6#16'Rich Text Format'#6' Rich Text Format Without Objects'#6#12'Unicode te'
+'xt'#6#17'Virtual Tree Data'#0'#Colors.SelectionRectangleBlendColor'#4#195
+#208#160#0#17'DefaultNodeHeight'#3#130#0#18'Header.Font.Height'#2#245#16'Hea'
+'der.Font.Name'#6#13'MS Sans Serif'#14'Header.Options'#11#12'hoAutoResize'#14
+'hoColumnResize'#6'hoDrag'#0#13'HintAnimation'#7#7'hatNone'#8'HintMode'#7#9
+'hmTooltip'#8'LineMode'#7#7'lmBands'#13'NodeAlignment'#7#9'naFromTop'#12'Nod'
+'eDataSize'#2#4#14'ParentShowHint'#8#13'RootNodeCount'#2#30#20'SelectionCurv'
+'eRadius'#2#10#8'ShowHint'#9#8'TabOrder'#2#0#10'TextMargin'#2#5#23'TreeOptio'
+'ns.AutoOptions'#11#16'toAutoDropExpand'#12'toAutoScroll'#20'toAutoScrollOnE'
+'xpand'#17'toAutoSpanColumns'#22'toAutoTristateTracking'#22'toAutoDeleteMove'
+'dNodes'#0#23'TreeOptions.MiscOptions'#11#10'toEditable'#12'toInitOnSave'#12
+'toReportMode'#18'toToggleOnDblClick'#14'toWheelPanning'#0#24'TreeOptions.Pa'
+'intOptions'#11#15'toHideFocusRect'#14'toShowDropmark'#15'toShowTreeLines'#12
+'toThemeAware'#18'toUseBlendedImages'#0#28'TreeOptions.SelectionOptions'#11
+#13'toMultiSelect'#0#9'OnEditing'#7#13'MLTreeEditing'#9'OnGetText'#7#13'MLTr'
+'eeGetText'#11'OnPaintText'#7#15'MLTreePaintText'#10'OnInitNode'#7#14'MLTree'
+'InitNode'#13'OnMeasureItem'#7#17'MLTreeMeasureItem'#13'OnStateChange'#7#17
+'MLTreeStateChange'#7'Columns'#14#1#8'Position'#2#1#5'Width'#3#227#1#0#1#0#0
+#0#0#0#9'TCheckBox'#18'AutoAdjustCheckBox'#4'Left'#2#12#6'Height'#2#13#3'Top'
+#3#152#1#5'Width'#3#234#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6
+'.Automatically adjust node height to node text.'#7'OnClick'#7#23'AutoAdjust'
+'CheckBoxClick'#8'TabOrder'#2#1#0#0#0
]);

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, ImgList, 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: WideString);
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 WideString;
//----------------------------------------------------------------------------------------------------------------------
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('LoremIpsum', DemoText);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TNodeForm.MLTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: WideString);
// 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.

View File

@ -0,0 +1,375 @@
object PropertiesForm: TPropertiesForm
Left = 397
Height = 419
Top = 294
Width = 637
HorzScrollBar.Page = 636
VertScrollBar.Page = 418
ActiveControl = VST3
Caption = 'PropertiesForm'
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
object Label9: TLabel
Left = 420
Height = 81
Top = 12
Width = 198
Anchors = [akTop, akRight]
AutoSize = False
Caption = 'This tree demonstrates a typical property page as it can be found in the property dialog for Word and other documents.'
Color = clNone
ParentColor = False
WordWrap = True
end
object Label10: TLabel
Left = 420
Height = 93
Top = 100
Width = 198
Anchors = [akTop, akRight]
AutoSize = False
Caption = 'What makes this demonstration special is the sample implementation for node editors. However, neither of them is Unicode aware.'
Color = clNone
ParentColor = False
WordWrap = True
end
object VST3: TVirtualStringTree
Left = 10
Height = 369
Top = 6
Width = 399
Anchors = [akTop, akLeft, akRight, akBottom]
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
DefaultNodeHeight = 20
Header.AutoSizeIndex = 1
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 18
Header.Options = [hoAutoResize, hoColumnResize, hoVisible, hoAutoSpring]
HintAnimation = hatFade
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 = [toAcceptOLEDrop, 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
Columns = <
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAutoSpring]
Width = 203
WideText = 'Properties'
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAutoSpring]
Position = 1
Width = 196
WideText = 'Values'
end>
end
object RadioGroup1: TRadioGroup
Left = 416
Height = 69
Top = 306
Width = 202
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
ItemIndex = 0
Items.Strings = (
'forward'
'backward'
)
OnClick = RadioGroup1Click
TabOrder = 1
end
object TreeImages: TImageList
left = 422
top = 224
Bitmap = {
6C691200000010000000100000009C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023383030303030222C0A22
2D20632023464646464646222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2C2C2D2E2E2E2E2E
2E2E2E2C2C2D2E222C0A222E2C2C2C2C2D2E2E2E2E2E2C2C2D2E2E222C0A222E
2E2C2C2C2C2D2E2E2E2C2C2D2E2E2E222C0A222E2E2E2E2C2C2C2D2E2C2D2E2E
2E2E2E222C0A222E2E2E2E2E2C2C2C2C2C2D2E2E2E2E2E222C0A222E2E2E2E2E
2E2C2C2C2D2E2E2E2E2E2E222C0A222E2E2E2E2E2C2C2C2C2C2D2E2E2E2E2E22
2C0A222E2E2E2E2C2C2C2D2E2C2C2D2E2E2E2E222C0A222E2E2E2C2C2C2D2E2E
2E2C2C2D2E2E2E222C0A222E2E2C2C2C2D2E2E2E2E2E2C2D2E2E2E222C0A222E
2E2C2C2C2D2E2E2E2E2E2E2C2D2E2E222C0A222E2E2E2C2D2E2E2E2E2E2E2E2E
2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2C2D2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0A9C0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203320
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023464646464646222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C2C2C2C
2C2C2E2E2E2E2E222C0A222E2E2E2C2D2D2D2D2D2D2C2C2E2E2E2E222C0A222E
2E2E2C2D2D2D2D2D2D2C2D2C2E2E2E222C0A222E2E2E2C2D2D2D2D2D2D2C2C2C
2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D
2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E22
2C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D
2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E
2E2E2C2D2D2D2D2D2D2D2D2D2C2E2E222C0A222E2E2E2C2D2D2D2D2D2D2D2D2D
2C2E2E222C0A222E2E2E2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E227D0AAB0100002F2A2058504D202A2F0A73746174
69632063686172202A677261706869635B5D203D207B0A223136203136203420
31222C0A222E2063204E6F6E65222C0A222C20632023303030303030222C0A22
2D20632023464646464646222C0A222A20632023303030303830222C0A222E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E222C0A222E2C2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D
2C2C2E2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D2C2D2C2E2E2E2E2E2E2E222C
0A222E2C2D2C2C2D2C2A2A2A2A2A2A2E2E2E222C0A222E2C2D2D2D2D2D2A2D2D
2D2D2A2A2E2E222C0A222E2C2D2C2C2C2C2A2D2D2D2D2A2D2A2E222C0A222E2C
2D2D2D2D2D2A2D2C2C2D2A2A2A2A222C0A222E2C2D2C2C2C2C2A2D2D2D2D2D2D
2D2A222C0A222E2C2D2D2D2D2D2A2D2C2C2C2C2C2D2A222C0A222E2C2C2C2C2C
2C2A2D2D2D2D2D2D2D2A222C0A222E2E2E2E2E2E2E2A2D2C2C2C2C2C2D2A222C
0A222E2E2E2E2E2E2E2A2D2D2D2D2D2D2D2A222C0A222E2E2E2E2E2E2E2A2A2A
2A2A2A2A2A2A222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AD80100
002F2A2058504D202A2F0A7374617469632063686172202A677261706869635B
5D203D207B0A22313620313620372031222C0A222E2063204E6F6E65222C0A22
2C20632023303030303030222C0A222D20632023464646463030222C0A222A20
632023383038303830222C0A226120632023383038303030222C0A2262206320
23303030303830222C0A226320632023464646464646222C0A222E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C
0A222E2E2C2C2C2C2C2D2D2C2C2C2C2C2E2E222C0A222E2C2A612A2C2D2C2C2D
2C612A612C2E222C0A222E2C612A2C2E2E2E2E2E2E2C612A2C2E222C0A222E2C
2A612C2C2C2C2C2C2C2C2A612C2E222C0A222E2C612A612A612A612A612A612A
2C2E222C0A222E2C2A612A612A626262626262622C2E222C0A222E2C612A612A
6162636363636362622E222C0A222E2C2A612A612A626363636363626362222C
0A222E2C612A612A61626362626263626262222C0A222E2C2A612A612A626363
636363636362222C0A222E2C612A612A61626362626262626362222C0A222E2E
2C2C2C2C2C626363636363636362222C0A222E2E2E2E2E2E2E62626262626262
6262222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0ABA0100002F2A20
58504D202A2F0A7374617469632063686172202A677261706869635B5D203D20
7B0A22313620313620352031222C0A222E20632023464646463030222C0A222C
2063204E6F6E65222C0A222D20632023383038303830222C0A222A2063202330
3030303030222C0A226120632023464646464646222C0A222E2C2C2D2E2C2C2D
2A2A2A2C2C2C2C2C222C0A222D2E2C2D612C2D2E61612A2A2C2C2C2C222C0A22
2C2D2E2D2E2D2E6161612A612A2C2C2C222C0A222C2E2D2E612D2D2D2D612A61
612A2C2C222C0A222D2D2D612E2E616161612A2A2A2A2A2C222C0A222C2C612D
61612D2A2A61616161612A2C222C0A222D2C2C2D2E6161616161616161612A2C
222C0A222C2C2C2D612A2A2A2A2A2A2A61612A2C222C0A222C2C2C2A61616161
6161616161612A2C222C0A222C2C2C2A612A2A2A2A2A2A2A61612A2C222C0A22
2C2C2C2A616161616161616161612A2C222C0A222C2C2C2A612A2A2A2A2A2A2A
61612A2C222C0A222C2C2C2A616161616161616161612A2C222C0A222C2C2C2A
616161616161616161612A2C222C0A222C2C2C2A2A2A2A2A2A2A2A2A2A2A2A2C
222C0A222C2C2C2C2C2C2C2C2C2C2C2C2C2C2C2C227D0AC90100002F2A205850
4D202A2F0A7374617469632063686172202A677261706869635B5D203D207B0A
22313620313620362031222C0A222E2063204E6F6E65222C0A222C2063202330
3030303830222C0A222D20632023464646464646222C0A222A20632023303030
303030222C0A226120632023383038303830222C0A2262206320234646464630
30222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222C2C2C2C2C2C2C
2C2C2C2C2C2C2C2E2E222C0A222C2D2C2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A
222C2C2C2C2C2C2C2C2C2C2C2C2C2A2E2E222C0A222A2E2E2E2A2D2D2D2D2D2D
2D2D2A2E2E222C0A222A2E2E2E2A2D2D2D2D2D2D2D2D2A2E2E222C0A222A2E2E
2E2A2D2D6161612D2D2D2A2E2E222C0A222A2E2E2E2A2D612E622E612D2D2A2E
2E222C0A222A2E2E2E2A612E622E6261616161612E222C0A222A2E2E2E2A612D
2D2D2D2D2D2D2D612A222C0A222A2E2E2E2A612D622E622E622E62612A222C0A
222A2E2E2E2A612D2E622E622E622E612A222C0A222A2A2A2A2A612D622E622E
622E62612A222C0A222E2E2E2E2E616161616161616161612A222C0A222E2E2E
2E2E2E2A2A2A2A2A2A2A2A2A2A222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E227D0AC90100002F2A2058504D202A2F0A7374617469632063686172202A67
7261706869635B5D203D207B0A22313620313620362031222C0A222E2063204E
6F6E65222C0A222C20632023303030303830222C0A222D206320233030303030
30222C0A222A20632023464646464646222C0A22612063202338303830383022
2C0A226220632023303046464646222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222C2C2C2C2C2C
2C2C2C2E2E2E2E2E2E2E222C0A222C2C2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C
0A222D2A2A2A2A2A2A2A2D2E2D2E2E2E2E2E222C0A222D2A61616161612A2D2E
2D2D2E2E2E2E222C0A222D2A2A2A2A2A2A2A2D2E2D622D2E2E2E222C0A222D2A
61612D2D2D2D2D2D2D62622D2E2E222C0A222D2A2A2A2D626262626262626262
2D2E222C0A222D2D2D2D2D626262626262626262622D222C0A222E2E2E2E2D62
62626262626262622D2E222C0A222E2E2E2E2D2D2D2D2D2D2D62622D2E2E222C
0A222E2E2E2E2E2E2E2E2E2E2D622D2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E
2D2D2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2D2E2E2E2E2E222C0A222E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AAB0100002F2A2058504D202A2F0A73
74617469632063686172202A677261706869635B5D203D207B0A223136203136
20342031222C0A222E2063204E6F6E65222C0A222C2063202330303030303022
2C0A222D20632023303030303830222C0A222A20632023464646464646222C0A
222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2C2C2C2C
2C2C2E2D2D222C0A222E2E2E2E2E2E2C2E2E2E2E2E2E2C2D2D222C0A222E2E2E
2E2E2C2E2C2E2E2E2E2E2E2D2D222C0A222C2C2C2C2C2E2C2E2C2E2E2E2E2E2D
2D222C0A222C2A2A2C2E2C2E2C2E2C2E2E2E2C2D2D222C0A222C2A2C2E2C2A2C
2E2C2E2C2C2C2E2D2D222C0A222C2A2A2C2A2A2A2C2E2C2A2C2E2E2E2D222C0A
222C2A2A2A2A2A2A2A2C2A2A2C2E2E2E2E222C0A222C2A2A2A2A2A2A2A2A2A2A
2C2E2E2E2E222C0A222C2A2C2C2A2C2C2C2C2C2A2C2E2E2E2E222C0A222C2A2A
2A2A2A2A2A2A2A2A2C2E2E2E2E222C0A222C2A2C2C2A2C2C2C2C2C2A2C2E2E2E
2E222C0A222C2A2A2A2A2A2A2A2A2A2A2C2E2E2E2E222C0A222C2C2C2C2C2C2C
2C2C2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
F60100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
69635B5D203D207B0A22313620313620392031222C0A222E2063204E6F6E6522
2C0A222C20632023383038303830222C0A222D20632023303030304646222C0A
222A20632023464646464646222C0A226120632023303038303030222C0A2262
20632023303030303030222C0A226320632023464646463030222C0A22642063
2023303038303830222C0A226520632023303030303830222C0A222E2E2E2E2E
2C2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2C2C2D2D2A2E6162622E2E2E2E22
2C0A222E2E2C2D2D2E2A2E61616161622E2E2E222C0A222E2C2D2A2E2A2C2C2C
2C2C2C2C622E2E222C0A222E2C2D2D2A2E2C2A2A2A632A2C2C2E2E222C0A2262
2D2D2E61612C2A632A2A2A2C2A2C2E222C0A22622D2D6161612C2A2A2A632A62
626262222C0A22622D2D6161612C2A636464642C2A2C62222C0A22622D2D2D61
612C2A642A2C61652A2C62222C0A22622D2D2D2D2D2C2A642C612D652A2C6222
2C0A222E622D2D2D2D2C2A642D2D2D652A2C62222C0A222E622D2D2D2D2C2A63
6565652C2A2C62222C0A222E2E622D2D2D2C2A2A2A632A2A2A2C62222C0A222E
2E2E62622D2C2A632A2A2A632A2C62222C0A222E2E2E2E2E622C2C2C2C2C2C2C
2C2C62222C0A222E2E2E2E2E2E62626262626262626262227D0A9C0100002F2A
2058504D202A2F0A7374617469632063686172202A677261706869635B5D203D
207B0A22313620313620332031222C0A222E2063204E6F6E65222C0A222C2063
2023464646464646222C0A222D20632023303038303030222C0A222E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E222C0A222E2C2C2C2C2C2C2C2C2C2C2C2C2C2C2E22
2C0A222E2C2C2C2C2C2C2C2D2C2C2C2C2C2C2E222C0A222E2C2C2C2C2C2C2C2D
2D2C2C2C2C2C2E222C0A222E2C2C2C2C2D2D2D2D2D2D2C2C2C2C2E222C0A222E
2C2C2C2D2C2C2C2D2D2C2C2C2C2C2E222C0A222E2C2C2C2D2C2C2C2D2C2C2C2C
2C2C2E222C0A222E2C2C2C2D2C2C2C2C2C2C2C2C2C2C2E222C0A222E2C2C2C2C
2C2C2C2C2C2C2D2C2C2C2E222C0A222E2C2C2C2C2C2C2D2C2C2C2D2C2C2C2E22
2C0A222E2C2C2C2C2C2D2D2C2C2C2D2C2C2C2E222C0A222E2C2C2C2C2D2D2D2D
2D2D2C2C2C2C2E222C0A222E2C2C2C2C2C2D2D2C2C2C2C2C2C2C2E222C0A222E
2C2C2C2C2C2C2D2C2C2C2C2C2C2C2E222C0A222E2C2C2C2C2C2C2C2C2C2C2C2C
2C2C2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0ABA0100002F2A
2058504D202A2F0A7374617469632063686172202A677261706869635B5D203D
207B0A22313620313620352031222C0A222E2063204E6F6E65222C0A222C2063
2023383038303830222C0A222D20632023303030303030222C0A222A20632023
464646464646222C0A226120632023303030303830222C0A222E2E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2C2C2C2C2C2C2D2E2E2E2E222C0A
222E2E2E2E2E2C2A2A2A2A2A2D2E2E2E2E222C0A222E2E2E2E2E2C2A2C2C2C2C
2C2C2D2E2E222C0A22612E2E2E2E2C2A2C2A2A2A2A2A2D2E2E222C0A2261612E
2E2E2C2A2C2A2C2C2C2C2C2C2D222C0A226161612E2E2C2A2C2A2C2A2A2A2A2A
2D222C0A22616161612E2C2A2C2A2C2A6161612A2D222C0A226161612E2E2C2A
2C2A2C2A2A2A2A2A2D222C0A2261612E2E2E2D2D2C2A2C2A6161612A2D222C0A
22612E2E2E2E2E2E2C2A2C2A2A2A2A2A2D222C0A222E2E2E2E2E2E2E2D2D2C2A
6161612A2D222C0A222E2E2E2E2E2E2E2E2E2C2A2A2A2A2A2D222C0A222E2E2E
2E2E2E2E2E2E2D2D2D2D2D2D2D222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AC90100002F2A2058
504D202A2F0A7374617469632063686172202A677261706869635B5D203D207B
0A22313620313620362031222C0A222E2063204E6F6E65222C0A222C20632023
383038303830222C0A222D20632023464646463030222C0A222A206320234330
43304330222C0A226120632023464646464646222C0A22622063202330303030
3030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C
2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2D2A2D2A2D2C2E2E2E2E2E2E2E222C
0A222E2C2D2A2D2A2D2A2D2C2C2C2C2C2C2E222C0A222E2C6161616161616161
616161612C62222C0A222E2C612D2A2D2A2D2A2D2A2D2A2D2C62222C0A222E2C
612A2D2A2D2A2D2A2D2A2D2A2C62222C0A222E2C612D2A2D2A2D2A2D2A2D2A2D
2C62222C0A222E2C612A2D2A2D2A2D2A2D2A2D2A2C62222C0A222E2C612D2A2D
2A2D2A2D2A2D2A2D2C62222C0A222E2C612A2D2A2D2A2D2A2D2A2D2A2C62222C
0A222E2C612D2A2D2A2D2A2D2A2D2A2D2C62222C0A222E2C2C2C2C2C2C2C2C2C
2C2C2C2C2C62222C0A222E2E6262626262626262626262626262222C0A222E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E227D0AC90100002F2A2058504D202A2F0A7374617469632063686172202A
677261706869635B5D203D207B0A22313620313620362031222C0A222E206320
4E6F6E65222C0A222C20632023383038303830222C0A222D2063202346464646
4646222C0A222A20632023464646463030222C0A226120632023433043304330
222C0A226220632023303030303030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E2E222C0A222E2E2E2C2C2C2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2D2D
2D2D2D2C2E2E2E2E2E2E2E222C0A222E2C2D2A612A612A2D2C2C2C2C2C2C2E22
2C0A222E2C2D612A612A612D2D2D2D2D2D2C62222C0A222E2C2D2A612A612A61
2A612A612A2C62222C0A222C2C2C2C2C2C2C2C2C2C2C2C2C2A2C62222C0A222C
2D2D2D2D2D2D2D2D2D2D2C2C612C62222C0A222C2D2A612A612A612A612A2A62
2C2C62222C0A222E2C2D2A612A612A612A612A61622C62222C0A222E2C2D612A
612A612A612A612A622C62222C0A222E2E2C2D612A612A612A612A2A2C626222
2C0A222E2E2C2C2C2C2C2C2C2C2C2C2C2C2C62222C0A222E2E2E626262626262
62626262626262222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0ABA0100002F2A2058504D202A2F0A
7374617469632063686172202A677261706869635B5D203D207B0A2231362031
3620352031222C0A222E2063204E6F6E65222C0A222C20632023383038303830
222C0A222D20632023464646464646222C0A222A20632023303030303030222C
0A226120632023433043304330222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E222C0A222E2C2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D2D
2D2C2A2E2E2E2E2E2E222C0A222E2C2D2D2D2D2D2D2C2D2A2E2E2E2E2E222C0A
222E2C2D2D2D2D2D2D2C2A2A2A2E2E2E2E222C0A222E2C2D2D2D2D2D2D616161
2A2E2E2E2E222C0A222E2C2D2D2D2D2D2D2D61612A2E2E2E2E222C0A222E2C2D
2D2D2D2D2D2D2D612A2E2E2E2E222C0A222E2C2D2D2D2D2D2D2D2D612A2E2E2E
2E222C0A222E2C2D2D2D2D2D2D2D2D612A2E2E2E2E222C0A222E2C2D2D2D2D2D
2D2D2D612A2E2E2E2E222C0A222E2C2D2D2D2D2D2D2D2D612A2E2E2E2E222C0A
222E2C6161616161616161612A2E2E2E2E222C0A222E2A2A2A2A2A2A2A2A2A2A
2A2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E227D0AF60100002F2A2058504D202A2F0A7374
617469632063686172202A677261706869635B5D203D207B0A22313620313620
392031222C0A222E2063204E6F6E65222C0A222C20632023383038303830222C
0A222D20632023464646464646222C0A222A20632023303030303030222C0A22
6120632023303030304646222C0A226220632023303030303830222C0A226320
632023303038303830222C0A226420632023433043304330222C0A2265206320
23464646463030222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E
2C2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2C2D2D2D2D2D2D2C2A2E2E2E
2E6162222C0A222E2C2D2D2D2D2D2D2C2D2A2E2E616362222C0A222E2C2D2D2D
2D2D2D2C2A2A2A6163622E222C0A222E2C2D2D2D2D2D2D6464646163622E2E22
2C0A222E2C2D2D2D2D2D2D2D646163622E2E2E222C0A222E2C2D2D2D2D2D2D2D
6163622E2E2E2E222C0A222E2C2D2D2D2D2D2D6163622A2E2E2E2E222C0A222E
2C2D2D2D2D2D2C6562642A2E2E2E2E222C0A222E2C2D2D2D2D2D642C2D642A2E
2E2E2E222C0A222E2C2D2D2D2D2A2C2D2D642A2E2E2E2E222C0A222E2C646464
6464646464642A2E2E2E2E222C0A222E2A2A2A2A2A2A2A2A2A2A2A2E2E2E2E22
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
2E2E2E2E2E2E2E227D0ABA0100002F2A2058504D202A2F0A7374617469632063
686172202A677261706869635B5D203D207B0A22313620313620352031222C0A
222E20632023383038303830222C0A222C2063204E6F6E65222C0A222D206320
23464646464646222C0A222A20632023303030303030222C0A22612063202343
3043304330222C0A222E2E2E2E2E2E2E2E2C2C2C2C2C2C2C2C222C0A222E2D2E
2E2E2E2E2E2E2E2C2C2C2C2C2C222C0A222E2D2E2D2E2E2E2E2E2E2E2E2C2C2C
2C222C0A222E2D2E2D2E2D2D2D2D2D2D2E2A2C2C2C222C0A222E2D2E2D2E2D2D
2D2D2D2D2E2D2A2C2C222C0A222E2D2E2D2E2D2D2D2D2D2D2E2A2A2A2C222C0A
222E2D2E2D2E2D2D2D2D2D2D6161612A2C222C0A222E2D2E2D2E2D2D2D2D2D2D
2D61612A2C222C0A222E2D2E2D2E2D2D2D2D2D2D2D2D612A2C222C0A222E2D2E
2D2E2D2D2D2D2D2D2D2D612A2C222C0A222E2D2E2D2E2D2D2D2D2D2D2D2D612A
2C222C0A222E612E2D2E2D2D2D2D2D2D2D2D612A2C222C0A222A2A2E612E2D2D
2D2D2D2D2D2D612A2C222C0A222C2C2A2A2E6161616161616161612A2C222C0A
222C2C2C2C2A2A2A2A2A2A2A2A2A2A2A2C222C0A222C2C2C2C2C2C2C2C2C2C2C
2C2C2C2C2C227D0AF60100002F2A2058504D202A2F0A73746174696320636861
72202A677261706869635B5D203D207B0A22313620313620392031222C0A222E
20632023383038303830222C0A222C2063204E6F6E65222C0A222D2063202346
4646464646222C0A222A20632023303030304646222C0A226120632023303030
303830222C0A226220632023303030303030222C0A2263206320233030383038
30222C0A226420632023433043304330222C0A22652063202346464646303022
2C0A222E2E2E2E2E2E2E2E2C2C2C2C2C2C2C2C222C0A222E2D2E2E2E2E2E2E2E
2E2C2C2C2C2C2C222C0A222E2D2E2D2E2E2E2E2E2E2E2E2C2C2A61222C0A222E
2D2E2D2E2D2D2D2D2D2D2E622A6361222C0A222E2D2E2D2E2D2D2D2D2D2D2E2A
63612C222C0A222E2D2E2D2E2D2D2D2D2D2D2A6361622C222C0A222E2D2E2D2E
2D2D2D2D2D2A636164622C222C0A222E2D2E2D2E2D2D2D2D2A63616464622C22
2C0A222E2D2E2D2E2D2D2D2A63612D2D64622C222C0A222E2D2E2D2E2D2D2E65
612D2D2D64622C222C0A222E2D2E2D2E2D2D642E2D2D2D2D64622C222C0A222E
642E2D2E2D622E2D2D2D2D2D64622C222C0A2262622E642E2D2D2D2D2D2D2D2D
64622C222C0A222C2C62622E646464646464646464622C222C0A222C2C2C2C62
626262626262626262622C222C0A222C2C2C2C2C2C2C2C2C2C2C2C2C2C2C2C22
7D0A8D0100002F2A2058504D202A2F0A7374617469632063686172202A677261
706869635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E
65222C0A222C20632023303030303030222C0A222E2E2E2E2E2E2E2E2E2E2E2E
2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2E
2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2E2E2E2E2E2E2E2E2E2E2E2E
222C0A222E2E2C2C2C2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2E2E
2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C0A22
2E2E2C2C2C2C2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2C2C2E2E2E
2E2E2E2E222C0A222E2E2C2C2C2C2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2C
2C2C2C2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2E2E2E2E2E2E2E2E2E2E
222C0A222E2E2C2C2C2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2E2E2E2E
2E2E2E2E2E2E2E2E222C0A222E2E2C2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A22
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
}
end
end

View File

@ -0,0 +1,187 @@
LazarusResources.Add('TPropertiesForm','FORMDATA',[
'TPF0'#15'TPropertiesForm'#14'PropertiesForm'#4'Left'#3#141#1#6'Height'#3#163
+#1#3'Top'#3'&'#1#5'Width'#3'}'#2#18'HorzScrollBar.Page'#3'|'#2#18'VertScroll'
+'Bar.Page'#3#162#1#13'ActiveControl'#7#4'VST3'#7'Caption'#6#14'PropertiesFor'
+'m'#11'Font.Height'#2#243#9'Font.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10
+'FormCreate'#0#6'TLabel'#6'Label9'#4'Left'#3#164#1#6'Height'#2'Q'#3'Top'#2#12
+#5'Width'#3#198#0#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#8#7'Captio'
+'n'#6'vThis tree demonstrates a typical property page as it can be found in '
+'the property dialog for Word and other documents.'#5'Color'#7#6'clNone'#11
+'ParentColor'#8#8'WordWrap'#9#0#0#6'TLabel'#7'Label10'#4'Left'#3#164#1#6'Hei'
+'ght'#2']'#3'Top'#2'd'#5'Width'#3#198#0#7'Anchors'#11#5'akTop'#7'akRight'#0#8
+'AutoSize'#8#7'Caption'#6'What makes this demonstration special is the samp'
+'le implementation for node editors. However, neither of them is Unicode awa'
+'re.'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#0#0#18'TVirtualSt'
+'ringTree'#4'VST3'#4'Left'#2#10#6'Height'#3'q'#1#3'Top'#2#6#5'Width'#3#143#1
+#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#18'Colors.BorderC'
+'olor'#7#12'clWindowText'#15'Colors.HotColor'#7#7'clBlack'#17'DefaultNodeHei'
+'ght'#2#20#20'Header.AutoSizeIndex'#2#1#18'Header.Font.Height'#2#245#16'Head'
+'er.Font.Name'#6#13'MS Sans Serif'#13'Header.Height'#2#18#14'Header.Options'
+#11#12'hoAutoResize'#14'hoColumnResize'#9'hoVisible'#12'hoAutoSpring'#0#13'H'
+'intAnimation'#7#7'hatFade'#8'HintMode'#7#6'hmHint'#6'Images'#7#10'TreeImage'
+'s'#17'IncrementalSearch'#7#5'isAll'#24'IncrementalSearchTimeout'#3#244#1#6
+'Indent'#2#19#14'ParentShowHint'#8#13'RootNodeCount'#2#2#8'ShowHint'#9#8'Tab'
+'Order'#2#0#28'TreeOptions.AnimationOptions'#11#16'toAnimatedToggle'#0#23'Tr'
+'eeOptions.AutoOptions'#11#16'toAutoDropExpand'#22'toAutoTristateTracking'#22
+'toAutoDeleteMovedNodes'#0#23'TreeOptions.MiscOptions'#11#15'toAcceptOLEDrop'
+#10'toEditable'#16'toGridExtensions'#12'toInitOnSave'#18'toToggleOnDblClick'
+#14'toWheelPanning'#0#28'TreeOptions.SelectionOptions'#11#15'toExtendedFocus'
+#15'toFullRowSelect'#22'toCenterScrollIntoView'#0#25'TreeOptions.StringOptio'
+'ns'#11#22'toAutoAcceptEditChange'#0#8'OnChange'#7#10'VST3Change'#14'OnCreat'
+'eEditor'#7#16'VST3CreateEditor'#9'OnEditing'#7#11'VST3Editing'#9'OnGetText'
+#7#11'VST3GetText'#11'OnPaintText'#7#13'VST3PaintText'#15'OnGetImageIndex'#7
+#17'VST3GetImageIndex'#9'OnGetHint'#7#11'VST3GetHint'#19'OnIncrementalSearch'
+#7#21'VST3IncrementalSearch'#14'OnInitChildren'#7#16'VST3InitChildren'#10'On'
+'InitNode'#7#12'VST3InitNode'#13'OnStateChange'#7#15'VST3StateChange'#7'Colu'
+'mns'#14#1#7'Options'#11#12'coAllowClick'#11'coDraggable'#9'coEnabled'#16'co'
+'ParentBidiMode'#13'coParentColor'#11'coResizable'#14'coShowDropMark'#9'coVi'
+'sible'#12'coAutoSpring'#0#5'Width'#3#203#0#8'WideText'#6#10'Properties'#0#1
+#7'Options'#11#12'coAllowClick'#11'coDraggable'#9'coEnabled'#16'coParentBidi'
+'Mode'#13'coParentColor'#11'coResizable'#14'coShowDropMark'#9'coVisible'#12
+'coAutoSpring'#0#8'Position'#2#1#5'Width'#3#196#0#8'WideText'#6#6'Values'#0#0
+#0#0#11'TRadioGroup'#11'RadioGroup1'#4'Left'#3#160#1#6'Height'#2'E'#3'Top'#3
+'2'#1#5'Width'#3#202#0#7'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoFill'#9#7
+'Caption'#6#31' Incremental search direction: '#28'ChildSizing.LeftRightSpac'
+'ing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizon'
+'tal'#7#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'cr'
+'sHomogenousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChild'
+'s'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layou'
+'t'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.ControlsPerLine'#2#1#9
+'ItemIndex'#2#0#13'Items.Strings'#1#6#7'forward'#6#8'backward'#0#7'OnClick'#7
+#16'RadioGroup1Click'#8'TabOrder'#2#1#0#0#10'TImageList'#10'TreeImages'#4'le'
+'ft'#3#166#1#3'top'#3#224#0#6'Bitmap'#10#211#31#0#0'li'#18#0#0#0#16#0#0#0#16
+#0#0#0#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'
+#10'". c None",'#10'", c #800000",'#10'"- c #FFFFFF",'#10'"................"'
+','#10'"................",'#10'".,,-........,,-.",'#10'".,,,,-.....,,-..",'
+#10'"..,,,,-...,,-...",'#10'"....,,,-.,-.....",'#10'".....,,,,,-.....",'#10
+'"......,,,-......",'#10'".....,,,,,-.....",'#10'"....,,,-.,,-....",'#10'"..'
+'.,,,-...,,-...",'#10'"..,,,-.....,-...",'#10'"..,,,-......,-..",'#10'"...,-'
+'...........",'#10'".............,-.",'#10'"................"}'#10#156#1#0#0
+'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1",'#10'". c None",'
+#10'", c #000000",'#10'"- c #FFFFFF",'#10'"................",'#10'".........'
+'.......",'#10'"...,,,,,,,,.....",'#10'"...,------,,....",'#10'"...,------,-'
+',...",'#10'"...,------,,,,..",'#10'"...,---------,..",'#10'"...,---------,.'
+'.",'#10'"...,---------,..",'#10'"...,---------,..",'#10'"...,---------,..",'
+#10'"...,---------,..",'#10'"...,---------,..",'#10'"...,---------,..",'#10
,'"...,,,,,,,,,,,..",'#10'"................"}'#10#171#1#0#0'/* XPM */'#10'sta'
+'tic char *graphic[] = {'#10'"16 16 4 1",'#10'". c None",'#10'", c #000000",'
+#10'"- c #FFFFFF",'#10'"* c #000080",'#10'"................",'#10'".........'
+'.......",'#10'".,,,,,,.........",'#10'".,----,,........",'#10'".,----,-,...'
+'....",'#10'".,-,,-,******...",'#10'".,-----*----**..",'#10'".,-,,,,*----*-*'
+'.",'#10'".,-----*-,,-****",'#10'".,-,,,,*-------*",'#10'".,-----*-,,,,,-*",'
+#10'".,,,,,,*-------*",'#10'".......*-,,,,,-*",'#10'".......*-------*",'#10
+'".......*********",'#10'"................"}'#10#216#1#0#0'/* XPM */'#10'sta'
+'tic char *graphic[] = {'#10'"16 16 7 1",'#10'". c None",'#10'", c #000000",'
+#10'"- c #FFFF00",'#10'"* c #808080",'#10'"a c #808000",'#10'"b c #000080",'
+#10'"c c #FFFFFF",'#10'"................",'#10'"......,,,,......",'#10'"..,,'
+',,,--,,,,,..",'#10'".,*a*,-,,-,a*a,.",'#10'".,a*,......,a*,.",'#10'".,*a,,,'
+',,,,,*a,.",'#10'".,a*a*a*a*a*a*,.",'#10'".,*a*a*bbbbbbb,.",'#10'".,a*a*abcc'
+'cccbb.",'#10'".,*a*a*bcccccbcb",'#10'".,a*a*abcbbbcbbb",'#10'".,*a*a*bccccc'
+'ccb",'#10'".,a*a*abcbbbbbcb",'#10'"..,,,,,bcccccccb",'#10'".......bbbbbbbbb'
+'",'#10'"................"}'#10#186#1#0#0'/* XPM */'#10'static char *graphic'
+'[] = {'#10'"16 16 5 1",'#10'". c #FFFF00",'#10'", c None",'#10'"- c #808080'
+'",'#10'"* c #000000",'#10'"a c #FFFFFF",'#10'".,,-.,,-***,,,,,",'#10'"-.,-a'
+',-.aa**,,,,",'#10'",-.-.-.aaa*a*,,,",'#10'",.-.a----a*aa*,,",'#10'"---a..aa'
+'aa*****,",'#10'",,a-aa-**aaaaa*,",'#10'"-,,-.aaaaaaaaa*,",'#10'",,,-a******'
+'*aa*,",'#10'",,,*aaaaaaaaaa*,",'#10'",,,*a*******aa*,",'#10'",,,*aaaaaaaaaa'
+'*,",'#10'",,,*a*******aa*,",'#10'",,,*aaaaaaaaaa*,",'#10'",,,*aaaaaaaaaa*,"'
+','#10'",,,************,",'#10'",,,,,,,,,,,,,,,,"}'#10#201#1#0#0'/* XPM */'
+#10'static char *graphic[] = {'#10'"16 16 6 1",'#10'". c None",'#10'", c #00'
+'0080",'#10'"- c #FFFFFF",'#10'"* c #000000",'#10'"a c #808080",'#10'"b c #F'
+'FFF00",'#10'"................",'#10'",,,,,,,,,,,,,,..",'#10'",-,,,,,,,,,,,,'
+'..",'#10'",,,,,,,,,,,,,*..",'#10'"*...*--------*..",'#10'"*...*--------*.."'
+','#10'"*...*--aaa---*..",'#10'"*...*-a.b.a--*..",'#10'"*...*a.b.baaaaa.",'
+#10'"*...*a--------a*",'#10'"*...*a-b.b.b.ba*",'#10'"*...*a-.b.b.b.a*",'#10
+'"*****a-b.b.b.ba*",'#10'".....aaaaaaaaaa*",'#10'"......**********",'#10'"..'
+'.............."}'#10#201#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10
+'"16 16 6 1",'#10'". c None",'#10'", c #000080",'#10'"- c #000000",'#10'"* c'
+' #FFFFFF",'#10'"a c #808080",'#10'"b c #00FFFF",'#10'"................",'#10
+'"................",'#10'",,,,,,,,,.......",'#10'",,,,,,,,,.......",'#10'"-*'
+'******-.-.....",'#10'"-*aaaaa*-.--....",'#10'"-*******-.-b-...",'#10'"-*aa-'
+'------bb-..",'#10'"-***-bbbbbbbbb-.",'#10'"-----bbbbbbbbbb-",'#10'"....-bbb'
+'bbbbbb-.",'#10'"....-------bb-..",'#10'"..........-b-...",'#10'"..........-'
+'-....",'#10'"..........-.....",'#10'"................"}'#10#171#1#0#0'/* XP'
+'M */'#10'static char *graphic[] = {'#10'"16 16 4 1",'#10'". c None",'#10'",'
+' c #000000",'#10'"- c #000080",'#10'"* c #FFFFFF",'#10'"................",'
+#10'".......,,,,,,.--",'#10'"......,......,--",'#10'".....,.,......--",'#10
+'",,,,,.,.,.....--",'#10'",**,.,.,.,...,--",'#10'",*,.,*,.,.,,,.--",'#10'",*'
+'*,***,.,*,...-",'#10'",*******,**,....",'#10'",**********,....",'#10'",*,,*'
+',,,,,*,....",'#10'",**********,....",'#10'",*,,*,,,,,*,....",'#10'",*******'
+'***,....",'#10'",,,,,,,,,,,,....",'#10'"................"}'#10#246#1#0#0'/*'
+' XPM */'#10'static char *graphic[] = {'#10'"16 16 9 1",'#10'". c None",'#10
+'", c #808080",'#10'"- c #0000FF",'#10'"* c #FFFFFF",'#10'"a c #008000",'#10
+'"b c #000000",'#10'"c c #FFFF00",'#10'"d c #008080",'#10'"e c #000080",'#10
+'".....,,,,,......",'#10'"...,,--*.abb....",'#10'"..,--.*.aaaab...",'#10'".,'
+'-*.*,,,,,,,b..",'#10'".,--*.,***c*,,..",'#10'"b--.aa,*c***,*,.",'#10'"b--aa'
+'a,***c*bbbb",'#10'"b--aaa,*cddd,*,b",'#10'"b---aa,*d*,ae*,b",'#10'"b-----,*'
+'d,a-e*,b",'#10'".b----,*d---e*,b",'#10'".b----,*ceee,*,b",'#10'"..b---,***c'
+'***,b",'#10'"...bb-,*c***c*,b",'#10'".....b,,,,,,,,,b",'#10'"......bbbbbbbb'
+'bb"}'#10#156#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 3 1"'
+','#10'". c None",'#10'", c #FFFFFF",'#10'"- c #008000",'#10'"..............'
+'..",'#10'".,,,,,,,,,,,,,,.",'#10'".,,,,,,,-,,,,,,.",'#10'".,,,,,,,--,,,,,."'
+','#10'".,,,,------,,,,.",'#10'".,,,-,,,--,,,,,.",'#10'".,,,-,,,-,,,,,,.",'
+#10'".,,,-,,,,,,,,,,.",'#10'".,,,,,,,,,,-,,,.",'#10'".,,,,,,-,,,-,,,.",'#10
+'".,,,,,--,,,-,,,.",'#10'".,,,,------,,,,.",'#10'".,,,,,--,,,,,,,.",'#10'".,'
+',,,,,-,,,,,,,.",'#10'".,,,,,,,,,,,,,,.",'#10'"................"}'#10#186#1#0
+#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 5 1",'#10'". c None",'
+#10'", c #808080",'#10'"- c #000000",'#10'"* c #FFFFFF",'#10'"a c #000080",'
+#10'"................",'#10'".....,,,,,,-....",'#10'".....,*****-....",'#10
+'".....,*,,,,,,-..",'#10'"a....,*,*****-..",'#10'"aa...,*,*,,,,,,-",'#10'"aa'
,'a..,*,*,*****-",'#10'"aaaa.,*,*,*aaa*-",'#10'"aaa..,*,*,*****-",'#10'"aa...'
+'--,*,*aaa*-",'#10'"a......,*,*****-",'#10'".......--,*aaa*-",'#10'"........'
+'.,*****-",'#10'".........-------",'#10'"................",'#10'"...........'
+'....."}'#10#201#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 6'
+' 1",'#10'". c None",'#10'", c #808080",'#10'"- c #FFFF00",'#10'"* c #C0C0C0'
+'",'#10'"a c #FFFFFF",'#10'"b c #000000",'#10'"................",'#10'"...,,'
+',,,........",'#10'"..,-*-*-,.......",'#10'".,-*-*-*-,,,,,,.",'#10'".,aaaaaa'
+'aaaaaa,b",'#10'".,a-*-*-*-*-*-,b",'#10'".,a*-*-*-*-*-*,b",'#10'".,a-*-*-*-*'
+'-*-,b",'#10'".,a*-*-*-*-*-*,b",'#10'".,a-*-*-*-*-*-,b",'#10'".,a*-*-*-*-*-*'
+',b",'#10'".,a-*-*-*-*-*-,b",'#10'".,,,,,,,,,,,,,,b",'#10'"..bbbbbbbbbbbbbb"'
+','#10'"................",'#10'"................"}'#10#201#1#0#0'/* XPM */'
+#10'static char *graphic[] = {'#10'"16 16 6 1",'#10'". c None",'#10'", c #80'
+'8080",'#10'"- c #FFFFFF",'#10'"* c #FFFF00",'#10'"a c #C0C0C0",'#10'"b c #0'
+'00000",'#10'"................",'#10'"...,,,,,........",'#10'"..,-----,.....'
+'..",'#10'".,-*a*a*-,,,,,,.",'#10'".,-a*a*a------,b",'#10'".,-*a*a*a*a*a*,b"'
+','#10'",,,,,,,,,,,,,*,b",'#10'",----------,,a,b",'#10'",-*a*a*a*a**b,,b",'
+#10'".,-*a*a*a*a*ab,b",'#10'".,-a*a*a*a*a*b,b",'#10'"..,-a*a*a*a**,bb",'#10
+'"..,,,,,,,,,,,,,b",'#10'"...bbbbbbbbbbbbb",'#10'"................",'#10'"..'
+'.............."}'#10#186#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10
+'"16 16 5 1",'#10'". c None",'#10'", c #808080",'#10'"- c #FFFFFF",'#10'"* c'
+' #000000",'#10'"a c #C0C0C0",'#10'"................",'#10'".,,,,,,,,.......'
+'",'#10'".,------,*......",'#10'".,------,-*.....",'#10'".,------,***....",'
+#10'".,------aaa*....",'#10'".,-------aa*....",'#10'".,--------a*....",'#10
+'".,--------a*....",'#10'".,--------a*....",'#10'".,--------a*....",'#10'".,'
+'--------a*....",'#10'".,aaaaaaaaa*....",'#10'".***********....",'#10'".....'
+'...........",'#10'"................"}'#10#246#1#0#0'/* XPM */'#10'static ch'
+'ar *graphic[] = {'#10'"16 16 9 1",'#10'". c None",'#10'", c #808080",'#10'"'
+'- c #FFFFFF",'#10'"* c #000000",'#10'"a c #0000FF",'#10'"b c #000080",'#10
+'"c c #008080",'#10'"d c #C0C0C0",'#10'"e c #FFFF00",'#10'"................"'
+','#10'".,,,,,,,,.......",'#10'".,------,*....ab",'#10'".,------,-*..acb",'
+#10'".,------,***acb.",'#10'".,------dddacb..",'#10'".,-------dacb...",'#10
+'".,-------acb....",'#10'".,------acb*....",'#10'".,-----,ebd*....",'#10'".,'
+'-----d,-d*....",'#10'".,----*,--d*....",'#10'".,ddddddddd*....",'#10'".****'
+'*******....",'#10'"................",'#10'"................"}'#10#186#1#0#0
+'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 5 1",'#10'". c #808080"'
+','#10'", c None",'#10'"- c #FFFFFF",'#10'"* c #000000",'#10'"a c #C0C0C0",'
+#10'"........,,,,,,,,",'#10'".-........,,,,,,",'#10'".-.-........,,,,",'#10
+'".-.-.------.*,,,",'#10'".-.-.------.-*,,",'#10'".-.-.------.***,",'#10'".-'
+'.-.------aaa*,",'#10'".-.-.-------aa*,",'#10'".-.-.--------a*,",'#10'".-.-.'
+'--------a*,",'#10'".-.-.--------a*,",'#10'".a.-.--------a*,",'#10'"**.a.---'
+'-----a*,",'#10'",,**.aaaaaaaaa*,",'#10'",,,,***********,",'#10'",,,,,,,,,,,'
+',,,,,"}'#10#246#1#0#0'/* XPM */'#10'static char *graphic[] = {'#10'"16 16 9'
+' 1",'#10'". c #808080",'#10'", c None",'#10'"- c #FFFFFF",'#10'"* c #0000FF'
+'",'#10'"a c #000080",'#10'"b c #000000",'#10'"c c #008080",'#10'"d c #C0C0C'
+'0",'#10'"e c #FFFF00",'#10'"........,,,,,,,,",'#10'".-........,,,,,,",'#10
+'".-.-........,,*a",'#10'".-.-.------.b*ca",'#10'".-.-.------.*ca,",'#10'".-'
+'.-.------*cab,",'#10'".-.-.-----*cadb,",'#10'".-.-.----*caddb,",'#10'".-.-.'
+'---*ca--db,",'#10'".-.-.--.ea---db,",'#10'".-.-.--d.----db,",'#10'".d.-.-b.'
+'-----db,",'#10'"bb.d.--------db,",'#10'",,bb.dddddddddb,",'#10'",,,,bbbbbbb'
+'bbbb,",'#10'",,,,,,,,,,,,,,,,"}'#10#141#1#0#0'/* XPM */'#10'static char *gr'
+'aphic[] = {'#10'"16 16 2 1",'#10'". c None",'#10'", c #000000",'#10'"......'
+'..........",'#10'"................",'#10'"..,.............",'#10'"..,,.....'
+'.......",'#10'"..,,,...........",'#10'"..,,,,..........",'#10'"..,,,,,.....'
+'....",'#10'"..,,,,,,........",'#10'"..,,,,,,,.......",'#10'"..,,,,,,.......'
+'.",'#10'"..,,,,,.........",'#10'"..,,,,..........",'#10'"..,,,...........",'
+#10'"..,,............",'#10'"..,.............",'#10'"................"}'#10#0
+#0#0
]);

View File

@ -0,0 +1,329 @@
unit PropertiesDemo;
{$MODE Delphi}
{$H+}
// 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, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ImgList, ExtCtrls, LResources;
const
// Helper message to decouple node change handling from edit handling.
WM_STARTEDITING = WM_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: WideString);
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: WideString);
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: WideString;
var Result: Integer);
procedure RadioGroup1Click(Sender: TObject);
procedure VST3StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
private
procedure WMStartEditing(var Message: TMessage); 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);
// The VCL (D7 and lower) still uses 16 color image lists. We create a high color version explicitely because it
// looks so much nicer.
ConvertToHighColor(TreeImages);
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: WideString);
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: WideString);
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] + #13 + '(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: WideString;
var Result: Integer);
var
S,
PropText: string;
begin
// Note: This code requires a proper Unicode/WideString comparation routine which I did not want to link here for
// size and clarity reasons. For now strings are (implicitely) converted to ANSI to make the comparation work.
// Search is not case sensitive.
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
// Note: Unicode will be converted to ANSI here, but for demonstration purposes we accept that for now.
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: TMessage);
// 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.

Binary file not shown.

After

Width:  |  Height:  |  Size: 45 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 125 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

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"

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 46 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 54 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 183 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.8 KiB

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,202 @@
unit SpeedDemo;
{$MODE Delphi}
{$H+}
// 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, {jpeg,} 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: WideString);
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: WideString);
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.

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

View File

@ -0,0 +1,124 @@
LazarusResources.Add('TStateForm','FORMDATA',[
'TPF0'#10'TStateForm'#9'StateForm'#4'Left'#3#147#1#6'Height'#3'M'#2#3'Top'#3
+#147#0#5'Width'#3#222#1#18'HorzScrollBar.Page'#3#221#1#18'VertScrollBar.Page'
+#3'L'#2#13'ActiveControl'#7#14'EnableCheckBox'#11'BorderStyle'#7#12'bsToolWi'
+'ndow'#7'Caption'#6#31'Watch Virtual Treeview at work:'#12'ClientHeight'#3'M'
+#2#11'ClientWidth'#3#222#1#11'Font.Height'#2#242#9'Font.Name'#6#12'Arial Nar'
+'row'#0#9'TCheckBox'#14'EnableCheckBox'#4'Left'#2#9#6'Height'#2#13#3'Top'#2
+#14#5'Width'#2'x'#7'Caption'#6#21'Enable state tracking'#7'OnClick'#7#19'Ena'
+'bleCheckBoxClick'#8'TabOrder'#2#0#0#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#18
+#6'Height'#2'`'#3'Top'#2')'#5'Width'#3#228#0#7'Caption'#6#10' Changes: '#12
+'ClientHeight'#2'N'#11'ClientWidth'#3#224#0#8'TabOrder'#2#1#0#9'TCheckBox'#9
+'CheckBox1'#4'Left'#2#9#6'Height'#2#13#3'Top'#2#1#5'Width'#2'b'#7'Caption'#6
+#14'Change pending'#7'Enabled'#8#8'TabOrder'#2#0#0#0#9'TCheckBox'#9'CheckBox'
+'3'#4'Left'#2#9#6'Height'#2#13#3'Top'#2#19#5'Width'#2''#7'Caption'#6#22'Tog'
+'gle focus selection'#7'Enabled'#8#8'TabOrder'#2#1#0#0#9'TCheckBox'#9'CheckB'
+'ox4'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'%'#5'Width'#2'U'#7'Caption'#6#13'C'
+'lear pending'#7'Enabled'#8#8'TabOrder'#2#2#0#0#9'TCheckBox'#10'CheckBox32'#4
+'Left'#2#9#6'Height'#2#13#3'Top'#2'6'#5'Width'#3#143#0#7'Caption'#6#24'Struc'
+'ture change pending'#7'Enabled'#8#8'TabOrder'#2#3#0#0#0#9'TGroupBox'#9'Grou'
+'pBox2'#4'Left'#2#16#6'Height'#3#169#0#3'Top'#3#245#0#5'Width'#3#228#0#7'Cap'
+'tion'#6#16' Mouse actions: '#12'ClientHeight'#3#151#0#11'ClientWidth'#3#224
+#0#8'TabOrder'#2#2#0#9'TCheckBox'#9'CheckBox8'#4'Left'#2#6#6'Height'#2#13#3
+'Top'#2's'#5'Width'#3#131#0#7'Caption'#6#22'Draw selection pending'#7'Enable'
+'d'#8#8'TabOrder'#2#0#0#0#9'TCheckBox'#9'CheckBox9'#4'Left'#2#6#6'Height'#2
+#13#3'Top'#3#131#0#5'Width'#2'Z'#7'Caption'#6#14'Draw selecting'#7'Enabled'#8
+#8'TabOrder'#2#1#0#0#9'TCheckBox'#10'CheckBox19'#4'Left'#2#6#6'Height'#2#13#3
+'Top'#2#3#5'Width'#3#134#0#7'Caption'#6#22'Left mouse button down'#7'Enabled'
+#8#8'TabOrder'#2#2#0#0#9'TCheckBox'#10'CheckBox20'#4'Left'#2#6#6'Height'#2#13
+#3'Top'#2#21#5'Width'#2'~'#7'Caption'#6#19'Mouse check pending'#7'Enabled'#8
+#8'TabOrder'#2#3#0#0#9'TCheckBox'#10'CheckBox21'#4'Left'#2#6#6'Height'#2#13#3
+'Top'#2''''#5'Width'#3#147#0#7'Caption'#6#24'Middle mouse button down'#7'Ena'
+'bled'#8#8'TabOrder'#2#4#0#0#9'TCheckBox'#10'CheckBox27'#4'Left'#2#6#6'Heigh'
+'t'#2#13#3'Top'#2';'#5'Width'#3#141#0#7'Caption'#6#23'Right mouse button dow'
+'n'#7'Enabled'#8#8'TabOrder'#2#5#0#0#9'TCheckBox'#10'CheckBox43'#4'Left'#2#6
+#6'Height'#2#13#3'Top'#2'M'#5'Width'#2'|'#7'Caption'#6#19'Mouse wheel pannin'
+'g'#7'Enabled'#8#8'TabOrder'#2#6#0#0#9'TCheckBox'#10'CheckBox44'#4'Left'#2#6
+#6'Height'#2#13#3'Top'#2'_'#5'Width'#2'|'#7'Caption'#6#21'Mouse wheel scroll'
+'ing'#7'Enabled'#8#8'TabOrder'#2#7#0#0#0#9'TGroupBox'#9'GroupBox3'#4'Left'#3
+#2#1#6'Height'#2'r'#3'Top'#3'9'#1#5'Width'#3#210#0#7'Caption'#6#19' Keyboard'
+' actions: '#12'ClientHeight'#2'`'#11'ClientWidth'#3#206#0#8'TabOrder'#2#3#0
+#9'TCheckBox'#10'CheckBox10'#4'Left'#2#9#6'Height'#2#13#3'Top'#2#17#5'Width'
+#2'4'#7'Caption'#6#7'Editing'#7'Enabled'#8#8'TabOrder'#2#0#0#0#9'TCheckBox'
+#10'CheckBox11'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'#'#5'Width'#2'O'#7'Capti'
+'on'#6#12'Edit pending'#7'Enabled'#8#8'TabOrder'#2#1#0#0#9'TCheckBox'#10'Che'
+'ckBox15'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'H'#5'Width'#3#164#0#7'Caption'
+#6#30'Incremental search in progress'#7'Enabled'#8#8'TabOrder'#2#2#0#0#9'TCh'
+'eckBox'#10'CheckBox16'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'6'#5'Width'#3#151
+#0#7'Caption'#6#26'Incremental search pending'#7'Enabled'#8#8'TabOrder'#2#3#0
+#0#9'TCheckBox'#10'CheckBox18'#4'Left'#2#9#6'Height'#2#13#3'Top'#2#255#5'Wid'
+'th'#2'p'#7'Caption'#6#17'Key check pending'#7'Enabled'#8#8'TabOrder'#2#4#0#0
+#0#9'TGroupBox'#9'GroupBox4'#4'Left'#3#2#1#6'Height'#3#168#0#3'Top'#2')'#5'W'
+'idth'#3#210#0#7'Caption'#6'$ Clipboard and drag''n drop actions: '#12'Clien'
+'tHeight'#3#150#0#11'ClientWidth'#3#206#0#8'TabOrder'#2#4#0#9'TCheckBox'#9'C'
+'heckBox5'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'\'#5'Width'#2'g'#7'Caption'#6
+#18'Clipboard flushing'#7'Enabled'#8#8'TabOrder'#2#0#0#0#9'TCheckBox'#9'Chec'
+'kBox6'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'n'#5'Width'#3#131#0#7'Caption'#6
+#22'Clipboard copy pending'#7'Enabled'#8#8'TabOrder'#2#1#0#0#9'TCheckBox'#9
+'CheckBox7'#4'Left'#2#9#6'Height'#2#13#3'Top'#3#128#0#5'Width'#2'{'#7'Captio'
+'n'#6#21'Clipboard cut pending'#7'Enabled'#8#8'TabOrder'#2#2#0#0#9'TCheckBox'
+#10'CheckBox24'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'J'#5'Width'#3#151#0#7'Ca'
+'ption'#6#27'OLE drag''n drop in progress'#7'Enabled'#8#8'TabOrder'#2#3#0#0#9
+'TCheckBox'#10'CheckBox25'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'8'#5'Width'#3
+#138#0#7'Caption'#6#23'OLE drag''n drop pending'#7'Enabled'#8#8'TabOrder'#2#4
+#0#0#9'TCheckBox'#10'CheckBox37'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'%'#5'Wi'
+'dth'#3#157#0#7'Caption'#6#28'VCL dd with app. drag object'#7'Enabled'#8#8'T'
,'abOrder'#2#5#0#0#9'TCheckBox'#10'CheckBox41'#4'Left'#2#9#6'Height'#2#13#3'T'
+'op'#2#1#5'Width'#3#150#0#7'Caption'#6#27'VCL drag''n drop in progress'#7'En'
+'abled'#8#8'TabOrder'#2#6#0#0#9'TCheckBox'#10'CheckBox42'#4'Left'#2#9#6'Heig'
+'ht'#2#13#3'Top'#2#19#5'Width'#3#137#0#7'Caption'#6#23'VCL drag''n drop pend'
+'ing'#7'Enabled'#8#8'TabOrder'#2#7#0#0#0#9'TGroupBox'#9'GroupBox5'#4'Left'#2
+#16#6'Height'#2'`'#3'Top'#3#141#0#5'Width'#3#228#0#7'Caption'#6#13' Tree cac'
+'he: '#12'ClientHeight'#2'N'#11'ClientWidth'#3#224#0#8'TabOrder'#2#5#0#9'TCh'
+'eckBox'#10'CheckBox31'#4'Left'#2#11#6'Height'#2#13#3'Top'#2#3#5'Width'#3#184
+#0#7'Caption'#6'"Tree cache validation stop request'#7'Enabled'#8#8'TabOrder'
+#2#0#0#0#9'TCheckBox'#10'CheckBox36'#4'Left'#2#11#6'Height'#2#13#3'Top'#2'3'
+#5'Width'#2'd'#7'Caption'#6#16'Tree cache valid'#7'Enabled'#8#8'TabOrder'#2#1
+#0#0#9'TCheckBox'#10'CheckBox39'#4'Left'#2#11#6'Height'#2#13#3'Top'#2#19#5'W'
+'idth'#3#160#0#7'Caption'#6#29'Tree cache is being validated'#7'Enabled'#8#8
+'TabOrder'#2#2#0#0#9'TCheckBox'#10'CheckBox40'#4'Left'#2#11#6'Height'#2#13#3
+'Top'#2'#'#5'Width'#3#158#0#7'Caption'#6#28'Tree cache invalid or unused'#7
+'Enabled'#8#8'TabOrder'#2#3#0#0#0#9'TGroupBox'#9'GroupBox6'#4'Left'#3#2#1#6
+'Height'#2'i'#3'Top'#3#209#0#5'Width'#3#210#0#7'Caption'#6#25' Collapse/Expa'
+'nd/Scroll: '#12'ClientHeight'#2'W'#11'ClientWidth'#3#206#0#8'TabOrder'#2#6#0
+#9'TCheckBox'#9'CheckBox2'#4'Left'#2#9#6'Height'#2#13#3'Top'#2#7#5'Width'#3
+#132#0#7'Caption'#6#25'Full collapse in progress'#7'Enabled'#8#8'TabOrder'#2
+#0#0#0#9'TCheckBox'#10'CheckBox12'#4'Left'#2#9#6'Height'#2#13#3'Top'#2#25#5
+'Width'#3#128#0#7'Caption'#6#23'Full expand in progress'#7'Enabled'#8#8'TabO'
+'rder'#2#1#0#0#9'TCheckBox'#10'CheckBox28'#4'Left'#2#9#6'Height'#2#13#3'Top'
+#2'+'#5'Width'#2'<'#7'Caption'#6#9'Scrolling'#7'Enabled'#8#8'TabOrder'#2#2#0
+#0#9'TCheckBox'#10'CheckBox29'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'>'#5'Widt'
+'h'#2'n'#7'Caption'#6#19'Auto scroll pending'#7'Enabled'#8#8'TabOrder'#2#3#0
+#0#0#9'TGroupBox'#9'GroupBox7'#4'Left'#3#2#1#6'Height'#3#141#0#3'Top'#3#176#1
+#5'Width'#3#210#0#7'Caption'#6#15' Miscellanous: '#12'ClientHeight'#2'{'#11
+'ClientWidth'#3#206#0#8'TabOrder'#2#7#0#9'TCheckBox'#10'CheckBox13'#4'Left'#2
+#9#6'Height'#2#13#3'Top'#2#26#5'Width'#3#161#0#7'Caption'#6#28'Last hint win'
+'dow was from VT'#7'Enabled'#8#8'TabOrder'#2#0#0#0#9'TCheckBox'#10'CheckBox1'
+'4'#4'Left'#2#9#6'Height'#2#13#3'Top'#2'?'#5'Width'#2'M'#7'Caption'#6#12'In '
+'animation'#7'Enabled'#8#8'TabOrder'#2#1#0#0#9'TCheckBox'#10'CheckBox17'#4'L'
+'eft'#2#9#6'Height'#2#13#3'Top'#2'Q'#5'Width'#2':'#7'Caption'#6#9'Iterating'
+#7'Enabled'#8#8'TabOrder'#2#2#0#0#9'TCheckBox'#10'CheckBox23'#4'Left'#2#9#6
+'Height'#2#13#3'Top'#2','#5'Width'#3#133#0#7'Caption'#6#22'Need root count u'
+'pdate'#7'Enabled'#8#8'TabOrder'#2#3#0#0#9'TCheckBox'#10'CheckBox33'#4'Left'
+#2#9#6'Height'#2#13#3'Top'#2#8#5'Width'#3#143#0#7'Caption'#6#23'Synchronous '
+'mode active'#7'Enabled'#8#8'TabOrder'#2#4#0#0#9'TCheckBox'#10'CheckBox46'#4
+'Left'#2#9#6'Height'#2#13#3'Top'#2'c'#5'Width'#2'r'#7'Caption'#6#16'Popup me'
+'nu shown'#7'Enabled'#8#8'TabOrder'#2#5#0#0#0#9'TGroupBox'#9'GroupBox8'#4'Le'
+'ft'#2#18#6'Height'#3#150#0#3'Top'#3#166#1#5'Width'#3#228#0#7'Caption'#6#25
+' Window related actions: '#12'ClientHeight'#3#132#0#11'ClientWidth'#3#224#0
+#8'TabOrder'#2#8#0#9'TCheckBox'#10'CheckBox22'#4'Left'#2#9#6'Height'#2#13#3
+'Top'#2'r'#5'Width'#3#141#0#7'Caption'#6#25'Default node height scale'#7'Ena'
+'bled'#8#8'TabOrder'#2#0#0#0#9'TCheckBox'#10'CheckBox26'#4'Left'#2#9#6'Heigh'
+'t'#2#13#3'Top'#2':'#5'Width'#2'R'#7'Caption'#6#13'Tree painting'#7'Enabled'
+#8#8'TabOrder'#2#1#0#0#9'TCheckBox'#10'CheckBox30'#4'Left'#2#9#6'Height'#2#13
+#3'Top'#2'&'#5'Width'#2'a'#7'Caption'#6#15'Window resizing'#7'Enabled'#8#8'T'
+'abOrder'#2#2#0#0#9'TCheckBox'#10'CheckBox34'#4'Left'#2#9#6'Height'#2#13#3'T'
+'op'#2'J'#5'Width'#3#136#0#7'Caption'#6#25'Tumb tracking (scrollbar)'#7'Enab'
+'led'#8#8'TabOrder'#2#3#0#0#9'TCheckBox'#10'CheckBox35'#4'Left'#2#9#6'Height'
+#2#13#3'Top'#2'Z'#5'Width'#2'_'#7'Caption'#6#14'Updates locked'#7'Enabled'#8
+#8'TabOrder'#2#4#0#0#9'TCheckBox'#10'CheckBox38'#4'Left'#2#9#6'Height'#2#13#3
+'Top'#2#2#5'Width'#3#186#0#7'Caption'#6#31'Windows XP Theme support in use'#7
+'Enabled'#8#8'TabOrder'#2#5#0#0#9'TCheckBox'#10'CheckBox45'#4'Left'#2#9#6'He'
+'ight'#2#13#3'Top'#2#20#5'Width'#3#179#0#7'Caption'#6' Treewindow is under c'
+'onstruction'#7'Enabled'#8#8'TabOrder'#2#6#0#0#0#0
]);

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.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

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, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ComCtrls, ExtCtrls, ImgList, 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: WideString);
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: WideString);
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: WideString;
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 Integer(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: WideString);
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: WideString);
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.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,296 @@
unit WindowsXPStyleDemo;
{$MODE Delphi}
// Virtual Treeview sample form demonstrating following features:
// - Windows XP style treeview.
// Written by Mike Lischke.
interface
{$ifdef COMPILER_7_UP}
// For some things to work we need code, which is classified as being unsafe for .NET.
{$warn UNSAFE_TYPE off}
{$warn UNSAFE_CAST off}
{$warn UNSAFE_CODE off}
{$endif COMPILER_7_UP}
uses
{$ifdef VER140}
Variants,
{$endif}
LCLIntf, Windows, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, ComCtrls, ToolWin, Menus, StdCtrls,
LResources, Printers, PrintersDlgs, ExtCtrls;
type
{ TWindowsXPForm }
TWindowsXPForm = class(TForm)
XPTree: TVirtualStringTree;
LargeImages: TImageList;
SmallImages: TImageList;
CoolBar1: TPanel;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
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: WideString);
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: WideString);
procedure Label4Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
procedure XPTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
end;
var
WindowsXPForm: TWindowsXPForm;
//----------------------------------------------------------------------------------------------------------------------
implementation
uses
Main, ShellAPI, States;
type
PEntry = ^TEntry;
TEntry = record
Caption: WideString;
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);
ConvertToHighColor(LargeImages);
ConvertToHighColor(SmallImages);
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: WideString);
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: WideString);
begin
// Show only a dummy hint. It is just to demonstrate how to do it.
HintText := 'Size larger than 536 MB' + #13 +
'Folders: addins, AppPatch, Config, Connection Wizard, ...' + #13 +
'Files: 1280.bmp, 1280x1024.bmp, 2001 94 mars.bmp, ac3api.ini, ...';
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.Label4Click(Sender: TObject);
begin
ShellExecute(0, 'open', 'http://groups.yahoo.com/group/VirtualExplorerTree', nil, nil, SW_SHOW);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWindowsXPForm.ToolButton9Click(Sender: TObject);
begin
//todo
//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.

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.