opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-26 11:17:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

Update VirtualTreeview component to current master from https://github.com/Virtual-TreeView/Virtual-TreeView

Browse Source
This commit is contained in:
Ansgar Becker
2018-12-11 21:26:53 +01:00
parent ac63d5f613
commit 7ad1a5bee4
27 changed files with 45851 additions and 38857 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
components/virtualtreeview/Design/StrEditD4.dfm
View File

Binary file not shown.

70
components/virtualtreeview/Design/StrEditD4.pas
View File

@ -1,70 +0,0 @@
unit StrEditD4;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, dsgnintf;
type
TStrEditDlg = class(TForm)
Bevel1: TBevel;
btnOk: TButton;
btnCancel: TButton;
Editor: TRichEdit;
StatusBar: TStatusBar;
procedure EditorChange(Sender: TObject);
procedure EditorKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
FModified: Boolean;
public
{ Public declarations }
end;
TStringListProperty = class(TClassProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure Edit; override;
end;
implementation
{$R *.DFM}
procedure TStrEditDlg.EditorChange(Sender: TObject);
begin
if Sender = Editor then
FModified := True;
StatusBar.SimpleText := Format ('%d lines.', [Editor.Lines.Count]);
end;
procedure TStrEditDlg.EditorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_ESCAPE then
ModalResult := mrCancel;
end;
{ TStringListProperty }
procedure TStringListProperty.Edit;
begin
with TStrEditDlg.Create(Application) do
try
Editor.Lines := TStrings(GetOrdValue);
EditorChange (nil);
FModified := False;
ActiveControl := Editor;
if ShowModal = mrOk then
SetOrdValue(LongInt(Editor.Lines));
finally
Free;
end;
end;
function TStringListProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paDialog] - [paSubProperties];
end;
end.

0
components/virtualtreeview/Resources/VirtualTreesD.dcr → components/virtualtreeview/Design/VirtualTrees.dcr
View File

90
components/virtualtreeview/Design/VirtualTreesReg.pas
View File

@ -12,7 +12,7 @@ interface
uses
Windows, Classes, DesignIntf, DesignEditors, VCLEditors, PropertyCategories,
ColnEdit, VirtualTrees, VTHeaderPopup;
ColnEdit, VirtualTrees, VirtualTrees.HeaderPopup;
type
TVirtualTreeEditor = class (TDefaultEditor)
@ -65,15 +65,6 @@ type
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
end;
TCheckImageKindProperty = class(TEnumProperty, ICustomPropertyDrawing, ICustomPropertyListDrawing)
public
procedure ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);
procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
end;
resourcestring
sVTHeaderCategoryName = 'Header';
sVTPaintingCategoryName = 'Custom painting';
@ -296,84 +287,6 @@ begin
// Nothing to do here.
end;
//----------------- TCheckImageKindProperty ----------------------------------------------------------------------------
const
cCheckImageKindComboItemBorder = 0;
cCheckImageKindComboItemSpacing = 2;
cCheckImageKindComboBitmapHeight = 16;
cCheckImageKindComboBitmapWidth = 16;
//----------------------------------------------------------------------------------------------------------------------
procedure TCheckImageKindProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
begin
DefaultPropertyDrawName(Self, ACanvas, ARect);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCheckImageKindProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
begin
if GetVisualValue <> '' then
ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected)
else
DefaultPropertyDrawValue(Self, ACanvas, ARect);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCheckImageKindProperty.ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
var
RighPosition: Integer;
OldPenColor: TColor;
CheckKind: TCheckImageKind;
ImageList: TCustomImageList;
RemainingRect: TRect;
begin
RighPosition := ARect.Left + cCheckImageKindComboBitmapWidth;
with ACanvas do
try
OldPenColor := Pen.Color;
Pen.Color := Brush.Color;
Rectangle(ARect.Left, ARect.Top, RighPosition, ARect.Bottom);
CheckKind := TCheckImageKind(GetEnumValue(GetPropInfo^.PropType^, Value));
ImageList := TVirtualTreeCast.GetCheckImageListFor(CheckKind);
if ImageList <> nil then
begin
ImageList_DrawEx(ImageList.Handle, ckCheckCheckedNormal, ACanvas.Handle, ARect.Left + cCheckImageKindComboItemBorder,
ARect.Top + cCheckImageKindComboItemBorder, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT);
end;
Pen.Color := OldPenColor;
finally
RemainingRect := Rect(RighPosition, ARect.Top, ARect.Right, ARect.Bottom);
DefaultPropertyListDrawValue(Value, ACanvas, RemainingRect, ASelected);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCheckImageKindProperty.ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);
begin
AHeight := cCheckImageKindComboBitmapHeight;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCheckImageKindProperty.ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
begin
AWidth := AWidth + cCheckImageKindComboBitmapWidth;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure Register;
@ -383,7 +296,6 @@ begin
RegisterComponentEditor(TVirtualStringTree, TVirtualTreeEditor);
RegisterComponentEditor(TVirtualDrawTree, TVirtualTreeEditor);
RegisterPropertyEditor(TypeInfo(TClipboardFormats), nil, '', TClipboardFormatsProperty);
RegisterPropertyEditor(TypeInfo(TCheckImageKind), nil, '', TCheckImageKindProperty);
// Categories:
RegisterPropertiesInCategory(sActionCategoryName, TBaseVirtualTree, ['ChangeDelay', 'EditDelay']);

BIN
components/virtualtreeview/Resources/VirtualTrees.res
View File

Binary file not shown.

BIN
components/virtualtreeview/Resources/VirtualTreeview-Icon.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 57 KiB

BIN
components/virtualtreeview/Resources/VirtualTreeview-Icon.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 14 KiB

44
components/virtualtreeview/Source/VTAccessibility.pas → components/virtualtreeview/Source/VirtualTrees.Accessibility.pas
View File

@ -1,4 +1,4 @@
unit VTAccessibility;
unit VirtualTrees.Accessibility;
// This unit implements iAccessible interfaces for the VirtualTree visual components
// and the currently focused node.
@ -9,7 +9,7 @@ interface
uses
Winapi.Windows, System.Classes, Winapi.ActiveX, System.Types, Winapi.oleacc,
VirtualTrees, VTAccessibilityFactory, Vcl.Controls;
VirtualTrees, VirtualTrees.AccessibilityFactory, Vcl.Controls;
type
TVirtualTreeAccessibility = class(TInterfacedObject, IDispatch, IAccessible)
@ -99,6 +99,12 @@ implementation
uses
System.SysUtils, Vcl.Forms, System.Variants, System.Math;
type
/// For getting access to protected members of this class
THackVirtualStringTree = class(TVirtualStringTree)
end;
{ TVirtualTreeAccessibility }
//----------------------------------------------------------------------------------------------------------------------
constructor TVirtualTreeAccessibility.Create(AVirtualTree: TVirtualStringTree);
@ -392,9 +398,39 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeAccessibility.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult;
// since we're not supporting more than one item, this is not supported currently.
var
lIndexToSelect: Cardinal;
i: Integer;
lNode: PVirtualNode;
begin
Result := DISP_E_MEMBERNOTFOUND;
lIndexToSelect := varChild;
if lIndexToSelect >= Self.FVirtualTree.TotalCount then
Exit(E_INVALIDARG);
lNode := FVirtualTree.GetFirst();
for i := 0 to Integer(lIndexToSelect) - 1 do
lNode := FVirtualTree.GetNext(lNode);
Result := E_NOTIMPL;
if (flagsSelect and SELFLAG_TAKEFOCUS) <> 0then begin
FVirtualTree.FocusedNode := lNode;
Result := S_OK;
end;//if SELFLAG_TAKEFOCUS
if (flagsSelect and SELFLAG_TAKESELECTION) <> 0 then begin
FVirtualTree.ClearSelection();
FVirtualTree.Selected[lNode] := True;
Result := S_OK;
end;//if SELFLAG_TAKEFOCUS
if (flagsSelect and SELFLAG_ADDSELECTION) <> 0 then begin
FVirtualTree.Selected[lNode] := True;
Result := S_OK;
end;
if (flagsSelect and SELFLAG_REMOVESELECTION) <> 0 then begin
FVirtualTree.Selected[lNode] := False;
Result := S_OK;
end;
if (flagsSelect and SELFLAG_EXTENDSELECTION) <> 0 then begin
THackVirtualStringTree(FVirtualTree).HandleClickSelection(FVirtualTree.FocusedNode, lNode, [ssShift], False);
Result := S_OK;
end;
end;
//----------------------------------------------------------------------------------------------------------------------

2
components/virtualtreeview/Source/VTAccessibilityFactory.pas → components/virtualtreeview/Source/VirtualTrees.AccessibilityFactory.pas
View File

@ -1,4 +1,4 @@
unit VTAccessibilityFactory;
unit VirtualTrees.AccessibilityFactory;
// The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you may not use this file except in compliance

47
components/virtualtreeview/Source/VirtualTrees.Actions.pas
View File

@ -5,6 +5,7 @@ interface
uses
System.Classes,
System.Actions,
Vcl.Controls,
Vcl.ActnList,
VirtualTrees;
@ -20,7 +21,7 @@ type
fFilter: TVirtualNodeStates; // Apply only of nodes which match these states
procedure SetControl(Value: TBaseVirtualTree); // Setter for the property "Control"
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure DoAfterExecute; // Fires the event "OnAfterExecute"
procedure DoAfterExecute; virtual;// Fires the event "OnAfterExecute"
property SelectedOnly: Boolean read GetSelectedOnly write SetSelectedOnly default False;
public
function HandlesTarget(Target: TObject): Boolean; override;
@ -28,6 +29,7 @@ type
procedure ExecuteTarget(Target: TObject); override;
published
constructor Create(AOwner: TComponent); override;
function Update: Boolean; override;
property Control: TBaseVirtualTree read fTree write SetControl;
property OnAfterExecute: TNotifyEvent read fOnAfterExecute write fOnAfterExecute; // Executed after the action was performed
property Caption;
@ -45,9 +47,11 @@ type
TVirtualTreePerItemAction = class(TVirtualTreeAction)
strict private
fOnBeforeExecute: TNotifyEvent;
fOldCursor: TCursor;
strict protected
fToExecute: TVTGetNodeProc; // method which is executed per item to perform this action
procedure DoBeforeExecute;
procedure DoBeforeExecute();
procedure DoAfterExecute(); override;// Fires the event "OnAfterExecute"
public
constructor Create(AOwner: TComponent); override;
procedure ExecuteTarget(Target: TObject); override;
@ -63,6 +67,7 @@ type
constructor Create(AOwner: TComponent); override;
published
property SelectedOnly;
property OnUpdate;
end;
// A standard action which unchecks nodes in a virtual treeview
@ -109,7 +114,8 @@ procedure Register;
implementation
uses
Controls, Forms;
WinApi.Windows,
Vcl.Forms;
procedure Register;
begin
@ -151,6 +157,15 @@ begin
Result := (Target is TBaseVirtualTree);
end;
function TVirtualTreeAction.Update(): Boolean;
begin
Result := inherited;
// If an OnUpdate event handler is assigned, TBasicAction.Update() will return True and so TBasicAction.UpdateTarget() will not be called.
// We would then end up with Control == nil. So trigger update of action manually.
if Result and Assigned(OnUpdate) then
SendAppMessage(CM_ACTIONUPDATE, 0, LPARAM(Self))
end;
procedure TVirtualTreeAction.UpdateTarget(Target: TObject);
begin
if fTreeAutoDetect and (Target is TBaseVirtualTree) then
@ -190,31 +205,36 @@ begin
inherited;
fToExecute := nil;
fOnBeforeExecute := nil;
fOldCursor := crNone;
end;
procedure TVirtualTreePerItemAction.DoAfterExecute;
begin
inherited;
if fOldCursor <> crNone then
Screen.Cursor := fOldCursor;
end;
procedure TVirtualTreePerItemAction.DoBeforeExecute;
begin
if Screen.Cursor <> crHourGlass then begin
fOldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
end;//if
if Assigned(fOnBeforeExecute) then
fOnBeforeExecute(Self);
end;
procedure TVirtualTreePerItemAction.ExecuteTarget(Target: TObject);
var
lOldCursor: TCursor;
begin
if Assigned(Self.Control) then
Target := Self.Control;
DoBeforeExecute();
lOldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
Control.BeginUpdate();
try
Control.IterateSubtree(nil, Self.fToExecute, nil, fFilter);
Control.IterateSubtree(nil, Self.fToExecute, nil, fFilter, true);
finally
Control.EndUpdate;
Screen.Cursor := lOldCursor;
Control.EndUpdate();
DoAfterExecute();
end;
Inherited ExecuteTarget(Target);
end;
{ TVirtualTreeCheckAll }
@ -227,6 +247,7 @@ begin
fDesiredCheckState := csCheckedNormal;
fToExecute := procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean)
begin
if not Control.CheckState[Node].IsDisabled then
Control.CheckState[Node] := fDesiredCheckState;
end;
end;

47
components/virtualtreeview/Source/VirtualTrees.Classes.pas
View File

@ -63,18 +63,6 @@ type
property AsString: string read GetAsString;
end;
TCriticalSection = class(TObject)
protected
FSection: TRTLCriticalSection;
public
constructor Create;
destructor Destroy; override;
procedure Enter;
procedure Leave;
end;
implementation
@ -221,40 +209,5 @@ begin
Inc(FPosition);
end;
//----------------- TCriticalSection -----------------------------------------------------------------------------------
constructor TCriticalSection.Create;
begin
inherited Create;
InitializeCriticalSection(FSection);
end;
//----------------------------------------------------------------------------------------------------------------------
destructor TCriticalSection.Destroy;
begin
DeleteCriticalSection(FSection);
inherited Destroy;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCriticalSection.Enter;
begin
EnterCriticalSection(FSection);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCriticalSection.Leave;
begin
LeaveCriticalSection(FSection);
end;
end.

97
components/virtualtreeview/Source/VirtualTrees.ClipBoard.pas
View File

@ -25,6 +25,9 @@ unit VirtualTrees.ClipBoard;
interface
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
uses
Winapi.Windows,
Winapi.ActiveX,
@ -71,8 +74,8 @@ function RegisterVTClipboardFormat(const Description: string; TreeClass: TVirtua
//----------------- TClipboardFormats ----------------------------------------------------------------------------------
type
PClipboardFormatListEntry = ^TClipboardFormatListEntry;
TClipboardFormatListEntry = record
TClipboardFormatListEntry = class
public
Description: string; // The string used to register the format with Winapi.Windows.
TreeClass: TVirtualTreeClass; // The tree class which supports rendering this format.
Priority: Cardinal; // Number which determines the order of formats used in IDataObject.
@ -80,9 +83,9 @@ type
end;
TClipboardFormatList = class
private
class var
FList : TList;
strict private
class function GetList(): TList; static;
class property List: TList read GetList;
protected
class procedure Sort;
public
@ -90,7 +93,7 @@ type
class procedure Clear;
class procedure EnumerateFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray; const AllowedFormats: TClipboardFormats = nil); overload;
class procedure EnumerateFormats(TreeClass: TVirtualTreeClass; const Formats: TStrings); overload;
class function FindFormat(const FormatString: string): PClipboardFormatListEntry; overload;
class function FindFormat(const FormatString: string): TClipboardFormatListEntry; overload;
class function FindFormat(const FormatString: string; var Fmt: Word): TVirtualTreeClass; overload;
class function FindFormat(Fmt: Word; var Description: string): TVirtualTreeClass; overload;
end;
@ -101,6 +104,8 @@ implementation
uses
System.SysUtils;
var
_List: TList = nil; //Note - not using class constructors as they are not supported on C++ Builder. See also issue #
procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; const List: TStrings);
@ -198,23 +203,23 @@ class procedure TClipboardFormatList.Sort;
var
I, J: Integer;
P, T: PClipboardFormatListEntry;
P, T: TClipboardFormatListEntry;
begin
repeat
I := L;
J := R;
P := FList[(L + R) shr 1];
P := _List[(L + R) shr 1];
repeat
while PClipboardFormatListEntry(FList[I]).Priority < P.Priority do
while TClipboardFormatListEntry(_List[I]).Priority < P.Priority do
Inc(I);
while PClipboardFormatListEntry(FList[J]).Priority > P.Priority do
while TClipboardFormatListEntry(_List[J]).Priority > P.Priority do
Dec(J);
if I <= J then
begin
T := FList[I];
FList[I] := FList[J];
FList[J] := T;
T := List[I];
_List[I] := _List[J];
_List[J] := T;
Inc(I);
Dec(J);
end;
@ -227,8 +232,8 @@ class procedure TClipboardFormatList.Sort;
//--------------- end local function ----------------------------------------
begin
if FList.Count > 1 then
QuickSort(0, FList.Count - 1);
if List.Count > 1 then
QuickSort(0, List.Count - 1);
end;
//----------------------------------------------------------------------------------------------------------------------
@ -239,15 +244,15 @@ class procedure TClipboardFormatList.Add(const FormatString: string; AClass: TVi
// values mean less priority.
var
Entry: PClipboardFormatListEntry;
Entry: TClipboardFormatListEntry;
begin
New(Entry);
Entry := TClipboardFormatListEntry.Create;
Entry.Description := FormatString;
Entry.TreeClass := AClass;
Entry.Priority := Priority;
Entry.FormatEtc := AFormatEtc;
FList.Add(Entry);
List.Add(Entry);
Sort;
end;
@ -260,9 +265,11 @@ var
I: Integer;
begin
for I := 0 to FList.Count - 1 do
Dispose(PClipboardFormatListEntry(FList[I]));
FList.Clear;
if Assigned(_List) then begin
for I := 0 to _List.Count - 1 do
TClipboardFormatListEntry(List[I]).Free;
_List.Clear;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
@ -274,14 +281,14 @@ class procedure TClipboardFormatList.EnumerateFormats(TreeClass: TVirtualTreeCla
var
I, Count: Integer;
Entry: PClipboardFormatListEntry;
Entry: TClipboardFormatListEntry;
begin
SetLength(Formats, FList.Count);
SetLength(Formats, List.Count);
Count := 0;
for I := 0 to FList.Count - 1 do
for I := 0 to List.Count - 1 do
begin
Entry := FList[I];
Entry := List[I];
// Does the tree class support this clipboard format?
if TreeClass.InheritsFrom(Entry.TreeClass) then
begin
@ -306,12 +313,12 @@ class procedure TClipboardFormatList.EnumerateFormats(TreeClass: TVirtualTreeCla
var
I: Integer;
Entry: PClipboardFormatListEntry;
Entry: TClipboardFormatListEntry;
begin
for I := 0 to FList.Count - 1 do
for I := 0 to List.Count - 1 do
begin
Entry := FList[I];
Entry := List[I];
if TreeClass.InheritsFrom(Entry.TreeClass) then
Formats.Add(Entry.Description);
end;
@ -319,17 +326,17 @@ end;
//----------------------------------------------------------------------------------------------------------------------
class function TClipboardFormatList.FindFormat(const FormatString: string): PClipboardFormatListEntry;
class function TClipboardFormatList.FindFormat(const FormatString: string): TClipboardFormatListEntry;
var
I: Integer;
Entry: PClipboardFormatListEntry;
Entry: TClipboardFormatListEntry;
begin
Result := nil;
for I := FList.Count - 1 downto 0 do
for I := List.Count - 1 downto 0 do
begin
Entry := FList[I];
Entry := List[I];
if CompareText(Entry.Description, FormatString) = 0 then
begin
Result := Entry;
@ -344,13 +351,13 @@ class function TClipboardFormatList.FindFormat(const FormatString: string; var F
var
I: Integer;
Entry: PClipboardFormatListEntry;
Entry: TClipboardFormatListEntry;
begin
Result := nil;
for I := FList.Count - 1 downto 0 do
for I := List.Count - 1 downto 0 do
begin
Entry := FList[I];
Entry := List[I];
if CompareText(Entry.Description, FormatString) = 0 then
begin
Result := Entry.TreeClass;
@ -366,13 +373,13 @@ class function TClipboardFormatList.FindFormat(Fmt: Word; var Description: strin
var
I: Integer;
Entry: PClipboardFormatListEntry;
Entry: TClipboardFormatListEntry;
begin
Result := nil;
for I := FList.Count - 1 downto 0 do
for I := List.Count - 1 downto 0 do
begin
Entry := FList[I];
Entry := List[I];
if Entry.FormatEtc.cfFormat = Fmt then
begin
Result := Entry.TreeClass;
@ -383,10 +390,18 @@ begin
end;
//Note - not using class constructors as they are not supported on C++ Builder.
class function TClipboardFormatList.GetList: TList;
begin
if not Assigned(_List) then
_List := TList.Create;
Exit(_List);
end;
initialization
TClipboardFormatList.FList := TList.Create;
finalization
TClipboardFormatList.Clear;
TClipboardFormatList.FList.Free;
FreeAndNil(_List);
end.

56
components/virtualtreeview/Source/VirtualTrees.Export.pas
View File

@ -6,9 +6,9 @@
interface
uses Winapi.Windows, System.SysUtils, Vcl.Graphics, System.Classes, Vcl.Forms,
Vcl.Controls, System.StrUtils, System.Generics.Collections,
VirtualTrees, VirtualTrees.Classes;
uses Winapi.Windows,
VirtualTrees,
VirtualTrees.Classes;
function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Caption: string = ''): String;
function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType): RawByteString;
@ -19,7 +19,14 @@ procedure ContentToCustom(Tree: TCustomVirtualStringTree; Source: TVSTTextSource
implementation
uses
UITypes;
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
System.Classes,
System.SysUtils,
System.StrUtils,
System.Generics.Collections,
System.UITypes;
type
TCustomVirtualStringTreeCracker = class(TCustomVirtualStringTree)
@ -30,7 +37,8 @@ const
WideLF = Char(#10);
function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Caption: string): String;
// Renders the current tree content (depending on Source) as HTML text encoded in UTF-8.
// If Caption is not empty then it is used to create and fill the header for the table built here.
@ -82,7 +90,7 @@ var
begin
if Length(Name) = 0 then
if Length(Name) = 0 then
Buffer.Add(' style="')
else
begin
Buffer.Add('.');
@ -102,9 +110,11 @@ var
Buffer.Add('color: ');
WriteColorAsHex(Font.Color);
WriteColorAsHex(Font.Color);
Buffer.Add(';');
if Length(Name) = 0 then
if Length(Name) = 0 then
Buffer.Add('"')
else
Buffer.Add('}');
end;
//--------------- end local functions ---------------------------------------
@ -298,11 +308,13 @@ begin
Run := Save;
while Assigned(Run) and not CrackTree.OperationCanceled do
begin
begin
if (not CrackTree.CanExportNode(Run)) then
begin
Run := GetNextNode(Run);
Continue;
end;
if Assigned(CrackTree.OnBeforeNodeExport) then
CrackTree.OnBeforeNodeExport(CrackTree, etHTML, Run);
Level := CrackTree.GetNodeLevel(Run);
Buffer.Add(' <tr class="default">');
Buffer.AddNewLine;
@ -671,12 +683,13 @@ begin
Run := Save;
while Assigned(Run) and not CrackTree.OperationCanceled do
begin
begin
if ((not CrackTree.CanExportNode(Run)) or
if (not CrackTree.CanExportNode(Run)) then
begin
Run := GetNextNode(Run);
Continue;
end;
if Assigned(CrackTree.OnBeforeNodeExport) then
CrackTree.OnBeforeNodeExport(CrackTree, etRTF, Run);
I := 0;
while not RenderColumns or (I < Length(Columns)) do
begin
@ -741,7 +754,8 @@ begin
begin
TextPlusFont(lGetCellTextEventArgs.CellText, CrackTree.Canvas.Font);
end;
end;
if not lGetCellTextEventArgs.StaticText.IsEmpty and (toShowStaticText in TStringTreeOptions(CrackTree.TreeOptions).StringOptions) then
begin
CrackTree.DoPaintText(Run, CrackTree.Canvas, Index, ttStatic);
TextPlusFont(' ' + lGetCellTextEventArgs.StaticText, CrackTree.Canvas.Font);
end;//if static text
@ -791,7 +805,8 @@ begin
end;
end;
function ContentToUnicodeString(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType; const Separator: string): string;
// Renders the current tree content (depending on Source) as Unicode text.
// If an entry contains the separator char then it is wrapped with double quotation marks.
@ -939,7 +954,7 @@ function ContentToClipboard(Tree: TCustomVirtualStringTree; Format: Word; Source
//--------------- local function --------------------------------------------
//--------------- local function --------------------------------------------
procedure MakeFragment(var HTML: Utf8String);
// Helper routine to build a properly-formatted HTML fragment.
@ -960,7 +975,7 @@ function ContentToClipboard(Tree: TCustomVirtualStringTree; Format: Word; Source
Length(EndFragment) + 4 * NumberLengthAndCR;
var
Description: Utf8String;
StartHTMLIndex,
EndHTMLIndex,
StartFragmentIndex,
@ -992,6 +1007,7 @@ var
DataSize: Cardinal;
S: AnsiString;
WS: string;
lUtf8String: Utf8string;
P: Pointer;
CrackTree: TCustomVirtualStringTreeCracker;
begin
@ -1028,12 +1044,12 @@ begin
end
else if Format = CF_HTML then
begin
else if Format = CF_HTML then
lUtf8String := ContentToHTML(CrackTree, Source);
// Build a valid HTML clipboard fragment.
WS := ContentToHTML(CrackTree, Source);
// Build a valid HTML clipboard fragment.
MakeFragment(WS);
S := S + #0;
MakeFragment(lUtf8String);
lUtf8String := lUtf8String + #0;
Data := PAnsiChar(lUtf8String);
DataSize := Length(lUtf8String);
end;
end;

54
components/virtualtreeview/Source/VirtualTrees.HeaderPopup.dtx Normal file
View File

@ -0,0 +1,54 @@
@@TVirtualTreeCast
Necessary to make the header accessible.
@@TVTHeaderPopupOption.poAllowHideAll
Allows to hide all columns, including the last one.
@@TVTHeaderPopupOption.poOriginalOrder
Show menu items in original column order as they were added to the tree.
@@VTHeaderPopup.pas
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/
Alternatively, you may redistribute this library, use and/or modify it under the terms of the
GNU Lesser General Public License as published by the Free Software Foundation;
either version 2.1 of the License, or (at your option) any later version.
You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/.
Software distributed under the License is distributed on an "AS IS"
basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
License for the specific language governing rights and limitations
under the License.
The Original Code is VTHeaderPopup.pas.
The Initial Developer of the Original Code is Ralf Junker <delphi@zeitungsjunge.de>. All Rights Reserved.
Modified 14 Sep 2003 by Mike Lischke <public@delphi-gems.com>.
- Renamed event type name to be consistent with other event types (e.g. used in VT).
- Added event for hiding/showing columns.
- DoXXX method are now virtual.
- Conditional code rearrangement to get back Ctrl+Shift+Up/Down navigation back.
Modified 31 Mar 2003 by Mike Lischke <public@delphi-gems.com>.
Added a check for the PopupComponent property before casting it hardly to a Virtual Treeview. People might
(accidentally) misuse the header popup.
Modified 20 Oct 2002 by Borut Maricic <borut.maricic@pobox.com>.
Added the possibility to use Troy Wolbrink's Unicode aware popup menu. Define the compiler symbol TNT to enable it.
You can get Troy's Unicode controls collection from http://home.ccci.org/wolbrink/tnt/delphi_unicode_controls.htm).
Modified 24 Feb 2002 by Ralf Junker <delphi@zeitungsjunge.de>.
Fixed a bug where the OnAddHeaderPopupItem would interfere with poAllowHideAll options.
All column indexes now consistently use TColumnIndex (instead of Integer).
Modified 23 Feb 2002 by Ralf Junker <delphi@zeitungsjunge.de>.
Added option to show menu items in the same order as the columns or in original order.
Added option to prevent the user to hide all columns.
Modified 17 Feb 2002 by Jim Kueneman <jimdk@mindspring.com>.
Added the event to filter the items as they are added to the menu.

108
components/virtualtreeview/Source/VTHeaderPopup.pas → components/virtualtreeview/Source/VirtualTrees.HeaderPopup.pas
View File

@ -1,4 +1,4 @@
unit VTHeaderPopup;
unit VirtualTrees.HeaderPopup;
//----------------------------------------------------------------------------------------------------------------------
//
@ -66,7 +66,9 @@ unit VTHeaderPopup;
interface
uses
Vcl.Menus, VirtualTrees;
System.Classes,
Vcl.Menus,
VirtualTrees;
type
TVTHeaderPopupOption = (
@ -76,34 +78,27 @@ type
);
TVTHeaderPopupOptions = set of TVTHeaderPopupOption;
TAddPopupItemType = (
apNormal,
apDisabled,
apHidden
);
TAddHeaderPopupItemEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex;
var Cmd: TAddPopupItemType) of object;
TColumnChangeEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean) of object;
TVTMenuItem = TMenuItem;
TVTHeaderPopupMenu = class(TPopupMenu)
strict private
FOptions: TVTHeaderPopupOptions;
FOnAddHeaderPopupItem: TAddHeaderPopupItemEvent;
FOnHeaderAddPopupItem: TVTHeaderAddPopupItemEvent;
FOnColumnChange: TColumnChangeEvent;
procedure ResizeColumnToFit(Sender: TObject);
procedure ResizeToFit(Sender: TObject);
strict protected
procedure DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType); virtual;
procedure DoColumnChange(Column: TColumnIndex; Visible: Boolean); virtual;
procedure OnMenuItemClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
procedure Popup(x, y: Integer); override;
published
property Options: TVTHeaderPopupOptions read FOptions write FOptions default [];
property Options: TVTHeaderPopupOptions read FOptions write FOptions default [poResizeToFitItem];
property OnAddHeaderPopupItem: TAddHeaderPopupItemEvent read FOnAddHeaderPopupItem write FOnAddHeaderPopupItem;
property OnAddHeaderPopupItem: TVTHeaderAddPopupItemEvent read FOnHeaderAddPopupItem write FOnHeaderAddPopupItem;
property OnColumnChange: TColumnChangeEvent read FOnColumnChange write FOnColumnChange;
end;
@ -112,19 +107,32 @@ type
implementation
uses
Winapi.Windows, System.Classes;
Winapi.Windows, System.Types;
const
cResizeToFitMenuItemName = 'VT_ResizeToFitMenuItem';
resourcestring
sResizeColumnToFit = 'Size &Column to Fit';
sResizeToFit = 'Size &All Columns to Fit';
type
TVTMenuItem = class(TMenuItem)
public
constructor Create(AOwner: TComponent; const ACaption: string; AClickHandler: TNotifyEvent = nil); reintroduce;
end;
//----------------- TVTHeaderPopupMenu ---------------------------------------------------------------------------------
constructor TVTHeaderPopupMenu.Create(AOwner: TComponent);
begin
inherited;
FOptions := [poResizeToFitItem];
end;
procedure TVTHeaderPopupMenu.DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType);
begin
Cmd := apNormal;
if Assigned(FOnAddHeaderPopupItem) then
FOnAddHeaderPopupItem((PopupComponent as TBaseVirtualTree), Column, Cmd);
if Assigned(FOnHeaderAddPopupItem) then
FOnHeaderAddPopupItem((PopupComponent as TBaseVirtualTree), Column, Cmd);
end;
//----------------------------------------------------------------------------------------------------------------------
@ -142,29 +150,19 @@ procedure TVTHeaderPopupMenu.OnMenuItemClick(Sender: TObject);
begin
if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then begin
if TVTMenuItem(Sender).Name = cResizeToFitMenuItemName then begin
TBaseVirtualTree(PopupComponent).Header.AutoFitColumns();
end
else begin
with TVTMenuItem(Sender),
TBaseVirtualTree(PopupComponent).Header.Columns.Items[Tag] do
with TBaseVirtualTree(PopupComponent).Header.Columns.Items[TVTMenuItem(Sender).Tag] do
begin
if Checked then
if TVTMenuItem(Sender).Checked then
Options := Options - [coVisible]
else
Options := Options + [coVisible];
DoColumnChange(TVTMenuItem(Sender).Tag, not Checked);
end;
end;//else
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTHeaderPopupMenu.Popup(x, y: Integer);
resourcestring
sResizeToFit = '&Resize All Columns To Fit';
var
ColPos: TColumnPosition;
ColIdx: TColumnIndex;
@ -175,17 +173,22 @@ var
VisibleCounter: Cardinal;
VisibleItem: TVTMenuItem;
i: Integer;
begin
if Assigned(PopupComponent) and (PopupComponent is TBaseVirtualTree) then
begin
// Delete existing menu items.
while Items.Count > 0 do
Items[0].Free;
for i := Items.Count -1 downto 0 do begin
if Items[i] is TVTMenuItem then
Items[i].Free;
end;//for i
if poResizeToFitItem in Self.Options then begin
NewMenuItem := NewItem(sResizeToFit, 0, False, True, OnMenuItemClick, 0, cResizeToFitMenuItemName);
Items.Add(NewMenuItem);
Items.Add(NewLine());
if poResizeToFitItem in Self.Options then
begin
Items.Add(TVTMenuItem.Create(Self, sResizeColumnToFit, ResizeColumnToFit));
Items.Add(TVTMenuItem.Create(Self, sResizeToFit, ResizeToFit));
Items.Add(TVTMenuItem.Create(Self, cLineCaption));
end;//poResizeToFitItem
// Add column menu items.
@ -212,13 +215,12 @@ begin
DoAddHeaderPopupItem(ColIdx, Cmd);
if Cmd <> apHidden then
begin
NewMenuItem := TVTMenuItem.Create(Self);
NewMenuItem := TVTMenuItem.Create(Self, Text, OnMenuItemClick);
NewMenuItem.Tag := ColIdx;
NewMenuItem.Caption := Text;
NewMenuItem.Hint := Hint;
NewMenuItem.ImageIndex := ImageIndex;
NewMenuItem.Checked := coVisible in Options;
NewMenuItem.OnClick := OnMenuItemClick;
if Cmd = apDisabled then
NewMenuItem.Enabled := False
else
@ -238,7 +240,33 @@ begin
inherited;
end;
procedure TVTHeaderPopupMenu.ResizeColumnToFit(Sender: TObject);
var
P: TPoint;
Column: TColumnIndex;
begin
P := Point(PopupPoint.X, PopupPoint.Y + TBaseVirtualTree(PopupComponent).Header.Height);
P := TBaseVirtualTree(PopupComponent).ScreenToClient(P);
Column := TBaseVirtualTree(PopupComponent).Header.Columns.ColumnFromPosition(P);
if Column <> InvalidColumn then
TBaseVirtualTree(PopupComponent).Header.AutoFitColumns(True, smaUseColumnOption, Column, Column);
end;
procedure TVTHeaderPopupMenu.ResizeToFit(Sender: TObject);
begin
TBaseVirtualTree(PopupComponent).Header.AutoFitColumns();
end;
//----------------------------------------------------------------------------------------------------------------------
{ TVTMenuItem }
constructor TVTMenuItem.Create(AOwner: TComponent; const ACaption: string; AClickHandler: TNotifyEvent);
begin
Inherited Create(AOwner);
Caption := ACaption;
OnClick := AClickHandler;
end;
end.

19
components/virtualtreeview/Source/VirtualTrees.StyleHooks.pas
View File

@ -447,10 +447,16 @@ begin
PaintScrollBars;
end;
procedure TVclStyleScrollBarsHook.PaintScrollBars;
procedure TVclStyleScrollBarsHook.PaintScrollBars();
begin
if FVertScrollBarWindow.HandleAllocated then begin
FVertScrollBarWindow.Repaint;
RedrawWindow(FVertScrollBarWindow.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698
end;
if FHorzScrollBarWindow.HandleAllocated then begin
FHorzScrollBarWindow.Repaint;
RedrawWindow(FHorzScrollBarWindow.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698
end;
end;
function TVclStyleScrollBarsHook.PointInTreeHeader(const P: TPoint): Boolean;
@ -573,7 +579,8 @@ end;
procedure TVclStyleScrollBarsHook.WMKeyDown(var Msg: TMessage);
begin
CallDefaultProc(TMessage(Msg));
PaintScrollBars;
CalcScrollBarsRect;
UpdateScrollBarWindow;
Handled := True;
end;
@ -587,7 +594,8 @@ end;
procedure TVclStyleScrollBarsHook.WMLButtonDown(var Msg: TWMMouse);
begin
CallDefaultProc(TMessage(Msg));
PaintScrollBars;
CalcScrollBarsRect;
UpdateScrollBarWindow;
Handled := True;
end;
@ -1140,9 +1148,12 @@ begin
end;
initialization
TCustomStyleEngine.RegisterStyleHook(TVirtualStringTree, TVclStyleScrollBarsHook);
TCustomStyleEngine.RegisterStyleHook(TVirtualDrawTree, TVclStyleScrollBarsHook);
finalization
TCustomStyleEngine.UnRegisterStyleHook(TVirtualStringTree, TVclStyleScrollBarsHook);
TCustomStyleEngine.UnRegisterStyleHook(TVirtualDrawTree, TVclStyleScrollBarsHook);
end.

194
components/virtualtreeview/Source/VirtualTrees.Utils.pas
View File

@ -30,9 +30,11 @@ interface
uses
Winapi.Windows,
Winapi.ActiveX,
System.Types,
Vcl.Graphics,
Vcl.ImgList;
Vcl.ImgList,
Vcl.Controls;
type
@ -47,12 +49,11 @@ type
procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer);
function GetRGBColor(Value: TColor): DWORD;
procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
function HasMMX: Boolean;
procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer);
procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); inline;
procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer);
procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer); inline;
// Clip a given canvas to ClipRect while transforming the given rect to device coordinates.
procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0);
@ -63,7 +64,6 @@ procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas
// Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of
// the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely.
// For higher speed (and multiple entries to be shorted) specify this value explicitely.
// Note: It is assumed that the string really needs shortage. Check this in advance.
function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string;
// Wrap the given string S so that it fits into a space of given width.
@ -80,12 +80,23 @@ function OrderRect(const R: TRect): TRect;
// (used in DragMove of the drag manager and DragTo of the header columns).
procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect);
// Attaches a bitmap as drag image to an IDataObject, see issue #405
// Usage: Set property DragImageKind to diNoImage, in your event handler OnCreateDataObject
// call VirtualTrees.Utils.ApplyDragImage() with your `IDataObject` and your bitmap.
procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap);
/// Returns Tree if the mouse cursor is currently visible and False in case it is suppressed.
/// Useful when doing hot-tracking on touchscreens, see issue #766
function IsMouseCursorVisible(): Boolean;
procedure ScaleImageList(const ImgList: TImageList; M, D: Integer);
implementation
uses
Winapi.CommCtrl,
Winapi.ShlObj,
System.SysUtils,
System.StrUtils,
System.Math;
@ -93,6 +104,36 @@ uses
const
WideLF = Char(#10);
procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap);
var
DragSourceHelper: IDragSourceHelper;
DragInfo: SHDRAGIMAGE;
lDragSourceHelper2: IDragSourceHelper2;// Needed to get Windows Vista+ style drag hints.
lNullPoint: TPoint;
begin
if Assigned(pDataObject) and Succeeded(CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER,
IID_IDragSourceHelper, DragSourceHelper)) then
begin
if Supports(DragSourceHelper, IDragSourceHelper2, lDragSourceHelper2) then
lDragSourceHelper2.SetFlags(DSH_ALLOWDROPDESCRIPTIONTEXT);// Show description texts
if not Succeeded(DragSourceHelper.InitializeFromWindow(0, lNullPoint, pDataObject)) then begin // First let the system try to initialze the DragSourceHelper, this works fine e.g. for file system objects
// Create drag image
if not Assigned(pBitmap) then
Exit();
DragInfo.crColorKey := clBlack;
DragInfo.sizeDragImage.cx := pBitmap.Width;
DragInfo.sizeDragImage.cy := pBitmap.Height;
DragInfo.ptOffset.X := pBitmap.Width div 8;
DragInfo.ptOffset.Y := pBitmap.Height div 10;
DragInfo.hbmpDragImage := CopyImage(pBitmap.Handle, IMAGE_BITMAP, pBitmap.Width, pBitmap.Height, LR_COPYRETURNORG);
if not Succeeded(DragSourceHelper.InitializeFromBitmap(@DragInfo, pDataObject)) then
DeleteObject(DragInfo.hbmpDragImage);
end;//if not InitializeFromWindow
end;
end;
function OrderRect(const R: TRect): TRect;
@ -126,13 +167,14 @@ procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer);
// Set the brush origin of a given canvas.
var
P: TPoint;
//var
// P: TPoint;
begin
P := Point(X, Y);
LPtoDP(Canvas.Handle, P, 1);
SetBrushOrgEx(Canvas.Handle, P.X, P.Y, nil);
//P := Point(X, Y);
//LPtoDP(Canvas.Handle, P, 1);// No longer used, see issue #608
//SetBrushOrgEx(Canvas.Handle, P.X, P.Y, nil);
SetBrushOrgEx(Canvas.Handle, X, Y, nil);
end;
//----------------------------------------------------------------------------------------------------------------------
@ -208,13 +250,12 @@ begin
EllipsisWidth := Size.cx;
end;
if Width <= EllipsisWidth then
Result := ''
else
begin
// Do a binary search for the optimal string length which fits into the given width.
L := 0;
H := Len - 1;
N := 0;
W := Width;
H := Len;
while L < H do
begin
N := (L + H + 1) shr 1;
@ -225,6 +266,13 @@ begin
else
H := N - 1;
end;
if W <= Width then
L := N;
if L >= Len then
Result := S
else if Width <= EllipsisWidth then
Result := ''
else
Result := Copy(S, 1, L) + '...';
end;
end;
@ -1116,47 +1164,6 @@ begin
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function HasMMX: Boolean;
// Helper method to determine whether the current processor supports MMX.
{$ifdef CPUX64}
begin
// We use SSE2 in the "MMX-functions"
Result := True;
end;
{$else}
asm
PUSH EBX
XOR EAX, EAX // Result := False
PUSHFD // determine if the processor supports the CPUID command
POP EDX
MOV ECX, EDX
XOR EDX, $200000
PUSH EDX
POPFD
PUSHFD
POP EDX
XOR ECX, EDX
JZ @1 // no CPUID support so we can't even get to the feature information
PUSH EDX
POPFD
MOV EAX, 1
DW $A20F // CPUID, EAX contains now version info and EDX feature information
MOV EBX, EAX // free EAX to get the result value
XOR EAX, EAX // Result := False
CMP EBX, $50
JB @1 // if processor family is < 5 then it is not a Pentium class processor
TEST EDX, $800000
JZ @1 // if the MMX bit is not set then we don't have MMX
INC EAX // Result := True
@1:
POP EBX
end;
{$endif CPUX64}
//----------------------------------------------------------------------------------------------------------------------
@ -1279,5 +1286,82 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function IsMouseCursorVisible(): Boolean;
var
CI: TCursorInfo;
begin
CI.cbSize := SizeOf(CI);
Result := GetCursorInfo(CI) and (CI.flags = CURSOR_SHOWING);
// 0 Hidden
// CURSOR_SHOWING (1) Visible
// CURSOR_SUPPRESSED (2) Touch/Pen Input (Windows 8+)
// https://msdn.microsoft.com/en-us/library/windows/desktop/ms648381(v=vs.85).aspx
end;
//----------------------------------------------------------------------------------------------------------------------
procedure ScaleImageList(const ImgList: TImageList; M, D: Integer);
var
ii : integer;
mb, ib, sib, smb : TBitmap;
TmpImgList : TImageList;
begin
if M <= D then Exit;
//clear images
TmpImgList := TImageList.Create(nil);
try
TmpImgList.Assign(ImgList);
ImgList.Clear;
ImgList.SetSize(MulDiv(ImgList.Width, M, D), MulDiv(ImgList.Height, M, D));
//add images back to original ImageList stretched (if DPI scaling > 150%) or centered (if DPI scaling <= 150%)
for ii := 0 to -1 + TmpImgList.Count do
begin
ib := TBitmap.Create;
mb := TBitmap.Create;
try
ib.SetSize(TmpImgList.Width, TmpImgList.Height);
ib.Canvas.FillRect(ib.Canvas.ClipRect);
mb.SetSize(TmpImgList.Width, TmpImgList.Height);
mb.Canvas.FillRect(mb.Canvas.ClipRect);
ImageList_DrawEx(TmpImgList.Handle, ii, ib.Canvas.Handle, 0, 0, ib.Width, ib.Height, CLR_NONE, CLR_NONE, ILD_NORMAL);
ImageList_DrawEx(TmpImgList.Handle, ii, mb.Canvas.Handle, 0, 0, mb.Width, mb.Height, CLR_NONE, CLR_NONE, ILD_MASK);
sib := TBitmap.Create; //stretched (or centered) image
smb := TBitmap.Create; //stretched (or centered) mask
try
sib.SetSize(ImgList.Width, ImgList.Height);
sib.Canvas.FillRect(sib.Canvas.ClipRect);
smb.SetSize(ImgList.Width, ImgList.Height);
smb.Canvas.FillRect(smb.Canvas.ClipRect);
if M * 100 / D >= 150 then //stretch if >= 150%
begin
sib.Canvas.StretchDraw(Rect(0, 0, sib.Width, sib.Width), ib);
smb.Canvas.StretchDraw(Rect(0, 0, smb.Width, smb.Width), mb);
end
else //center if < 150%
begin
sib.Canvas.Draw((sib.Width - ib.Width) DIV 2, (sib.Height - ib.Height) DIV 2, ib);
smb.Canvas.Draw((smb.Width - mb.Width) DIV 2, (smb.Height - mb.Height) DIV 2, mb);
end;
ImgList.Add(sib, smb);
finally
sib.Free;
smb.Free;
end;
finally
ib.Free;
mb.Free;
end;
end;
finally
TmpImgList.Free;
end;
end;
end.

130
components/virtualtreeview/Source/VirtualTrees.WorkerThread.pas
View File

@ -12,29 +12,29 @@ type
private
FCurrentTree: TBaseVirtualTree;
FWaiterList: TThreadList;
FRefCount: Cardinal;
FRefCount: Integer;
class procedure EnsureCreated();
class procedure Dispose();
procedure WaitForValidationTermination(Tree: TBaseVirtualTree);
protected
procedure CancelValidation(Tree: TBaseVirtualTree);
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
constructor Create();
destructor Destroy; override;
procedure AddTree(Tree: TBaseVirtualTree);
procedure RemoveTree(Tree: TBaseVirtualTree);
/// For lifeteime management of the TWorkerThread
class procedure AddThreadReference;
class procedure ReleaseThreadReference();
class procedure AddTree(Tree: TBaseVirtualTree);
class procedure RemoveTree(Tree: TBaseVirtualTree);
property CurrentTree: TBaseVirtualTree read FCurrentTree;
end;
procedure AddThreadReference;
procedure ReleaseThreadReference(Tree: TBaseVirtualTree);
var
WorkerThread: TWorkerThread;
WorkEvent: THandle;
implementation
@ -47,9 +47,12 @@ type
TBaseVirtualTreeCracker = class(TBaseVirtualTree)
end;
var
WorkerThread: TWorkerThread = nil;
WorkEvent: THandle;
//----------------- TWorkerThread --------------------------------------------------------------------------------------
procedure AddThreadReference;
class procedure TWorkerThread.EnsureCreated();
begin
if not Assigned(WorkerThread) then
begin
@ -59,42 +62,45 @@ begin
RaiseLastOSError;
// Create worker thread, initialize it and send it to its wait loop.
WorkerThread := TWorkerThread.Create(False);
WorkerThread := TWorkerThread.Create();
end;
Inc(WorkerThread.FRefCount);
end;
class procedure TWorkerThread.Dispose();
begin
WorkerThread.Terminate();
SetEvent(WorkEvent);
WorkerThread := nil; //Will be freed usinf TThreaf.FreeOnTerminate
CloseHandle(WorkEvent);
end;
class procedure TWorkerThread.AddThreadReference;
begin
TWorkerThread.EnsureCreated();
InterlockedIncrement(WorkerThread.FRefCount);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure ReleaseThreadReference(Tree: TBaseVirtualTree);
class procedure TWorkerThread.ReleaseThreadReference();
begin
if Assigned(WorkerThread) then
begin
Dec(WorkerThread.FRefCount);
// Make sure there is no reference remaining to the releasing tree.
TBaseVirtualTreeCracker(Tree).InterruptValidation;
InterlockedDecrement(WorkerThread.FRefCount);
if WorkerThread.FRefCount = 0 then
begin
with WorkerThread do
begin
Terminate;
SetEvent(WorkEvent);
end;
FreeAndNil(WorkerThread);
CloseHandle(WorkEvent);
end;
WorkerThread.Dispose();
end;
end;
//----------------------------------------------------------------------------------------------------------------------
constructor TWorkerThread.Create(CreateSuspended: Boolean);
constructor TWorkerThread.Create();
begin
inherited Create(CreateSuspended);
inherited Create(False);
FreeOnTerminate := True;
FWaiterList := TThreadList.Create;
end;
@ -105,28 +111,17 @@ destructor TWorkerThread.Destroy;
begin
// First let the ancestor stop the thread before freeing our resources.
inherited;
FWaiterList.Free;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWorkerThread.CancelValidation(Tree: TBaseVirtualTree);
var
Msg: TMsg;
procedure TWorkerThread.WaitForValidationTermination(Tree: TBaseVirtualTree);
begin
// Wait for any references to this tree to be released.
// Pump WM_CHANGESTATE messages so the thread doesn't block on SendMessage calls.
while FCurrentTree = Tree do
begin
if Tree.HandleAllocated and PeekMessage(Msg, Tree.Handle, WM_CHANGESTATE, WM_CHANGESTATE, PM_REMOVE) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
Continue;
end;
Sleep(1);
if (toVariableNodeHeight in TBaseVirtualTreeCracker(Tree).TreeOptions.MiscOptions) then
CheckSynchronize(); // We need to call CheckSynchronize here because we are using TThread.Synchronize in TBaseVirtualTree.MeasureItemHeight()
end;
@ -134,13 +129,12 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWorkerThread.Execute;
procedure TWorkerThread.Execute();
// Does some background tasks, like validating tree caches.
var
EnterStates,
LeaveStates: TChangeStates;
EnterStates: TVirtualTreeStates;
lCurrentTree: TBaseVirtualTree;
begin
@ -148,14 +142,15 @@ begin
while not Terminated do
begin
WaitForSingleObject(WorkEvent, INFINITE);
if not Terminated then
begin
if Terminated then
exit;
// Get the next waiting tree.
with FWaiterList.LockList do
try
if Count > 0 then
begin
FCurrentTree := Items[0];
lCurrentTree := Items[0];
// Remove this tree from waiter list.
Delete(0);
// If there is yet another tree to work on then set the work event to keep looping.
@ -163,64 +158,67 @@ begin
SetEvent(WorkEvent);
end
else
FCurrentTree := nil;
lCurrentTree := nil;
finally
FWaiterList.UnlockList;
end;
// Something to do?
if Assigned(FCurrentTree) then
if Assigned(lCurrentTree) then
begin
try
TBaseVirtualTreeCracker(FCurrentTree).ChangeTreeStatesAsync([csValidating], [csUseCache, csValidationNeeded]);
TBaseVirtualTreeCracker(lCurrentTree).ChangeTreeStatesAsync([tsValidating], [tsUseCache, tsValidationNeeded]);
FCurrentTree := lCurrentTree;
EnterStates := [];
if not (tsStopValidation in FCurrentTree.TreeStates) and TBaseVirtualTreeCracker(FCurrentTree).DoValidateCache then
EnterStates := [csUseCache];
EnterStates := [tsUseCache];
finally
LeaveStates := [csValidating, csStopValidation];
TBaseVirtualTreeCracker(FCurrentTree).ChangeTreeStatesAsync(EnterStates, LeaveStates);
lCurrentTree := FCurrentTree; // Save reference in a local variable for later use
FCurrentTree := nil; //Clear variable to prevent deadlock in CancelValidation. See #434
TBaseVirtualTreeCracker(lCurrentTree).ChangeTreeStatesAsync(EnterStates, [tsValidating, tsStopValidation]);
Queue(TBaseVirtualTreeCracker(lCurrentTree).UpdateEditBounds);
end;
end;
end;
end;
end;//while
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWorkerThread.AddTree(Tree: TBaseVirtualTree);
class procedure TWorkerThread.AddTree(Tree: TBaseVirtualTree);
begin
Assert(Assigned(Tree), 'Tree must not be nil.');
TWorkerThread.EnsureCreated();
// Remove validation stop flag, just in case it is still set.
TBaseVirtualTreeCracker(Tree).DoStateChange([], [tsStopValidation]);
with FWaiterList.LockList do
with WorkerThread.FWaiterList.LockList do
try
if IndexOf(Tree) = -1 then
Add(Tree);
finally
FWaiterList.UnlockList;
WorkerThread.FWaiterList.UnlockList;
end;
SetEvent(WorkEvent);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TWorkerThread.RemoveTree(Tree: TBaseVirtualTree);
class procedure TWorkerThread.RemoveTree(Tree: TBaseVirtualTree);
begin
if not Assigned(WorkerThread) then
exit;
Assert(Assigned(Tree), 'Tree must not be nil.');
with FWaiterList.LockList do
with WorkerThread.FWaiterList.LockList do
try
Remove(Tree);
finally
FWaiterList.UnlockList; // Seen several AVs in this line, was called from TWorkerThrea.Destroy. Joachim Marder.
WorkerThread.FWaiterList.UnlockList; // Seen several AVs in this line, was called from TWorkerThrea.Destroy. Joachim Marder.
end;
CancelValidation(Tree);
WorkerThread.WaitForValidationTermination(Tree);
end;

6469
components/virtualtreeview/Source/VirtualTrees.dtx Normal file
View File

File diff suppressed because it is too large Load Diff

4210
components/virtualtreeview/Source/VirtualTrees.pas
View File

File diff suppressed because it is too large Load Diff

BIN
components/virtualtreeview/Source/VirtualTrees.res
View File

Binary file not shown.

10
components/virtualtreeview/packages/Delphi10.3/VirtualTreesD.dpk vendored
View File

@ -1,30 +1,30 @@
package VirtualTreesD;
{$R *.res}
{$R '..\..\Resources\VirtualTreesD.dcr'}
{$R '..\..\Design\VirtualTrees.dcr'}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$DEFINE RELEASE}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'VirtualTreeView Controls'}
{$DESIGNONLY}

28
components/virtualtreeview/packages/Delphi10.3/VirtualTreesD.dproj vendored
View File

@ -3,7 +3,7 @@
<ProjectGuid>{A34BA07B-19B6-4C21-9DEE-65FCA52D00AB}</ProjectGuid>
<MainSource>VirtualTreesD.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
@ -19,11 +19,6 @@
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
@ -35,6 +30,8 @@
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<SanitizedProjectName>VirtualTreesD</SanitizedProjectName>
<DCC_HppOutput>..\..\Source</DCC_HppOutput>
<DCC_DcuOutput>..\..\build\$(Platform)</DCC_DcuOutput>
<DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
<DCC_Description>VirtualTreeView Controls</DCC_Description>
@ -52,20 +49,14 @@
<DCC_N>false</DCC_N>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<SanitizedProjectName>VirtualTreesD</SanitizedProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<Debugger_HostApplication>$(BDS)\BIN\Bds.exe</Debugger_HostApplication>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>vcl;VirtualTreesD;VirtualTreesR;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>vcl;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_UsePackage>vcl;VirtualTreesR;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
@ -76,7 +67,7 @@
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\Resources\VirtualTreesD.dcr"/>
<DCCReference Include="..\..\Design\VirtualTrees.dcr"/>
<DCCReference Include="DesignIDE.dcp"/>
<DCCReference Include="VirtualTreesR.dcp"/>
<DCCReference Include="..\..\Design\VirtualTreesReg.pas"/>
@ -127,14 +118,11 @@
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k190.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp190.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
<Excluded_Packages />
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>

22
components/virtualtreeview/packages/Delphi10.3/VirtualTreesR.dpk vendored
View File

@ -1,28 +1,29 @@
package VirtualTreesR;
{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$DEFINE RELEASE}
{$ENDIF IMPLICITBUILDING}
{$RUNONLY}
{$IMPLICITBUILD OFF}
@ -33,16 +34,17 @@ requires
contains
VirtualTrees in '..\..\Source\VirtualTrees.pas',
VTHeaderPopup in '..\..\Source\VTHeaderPopup.pas',
VTAccessibilityFactory in '..\..\Source\VTAccessibilityFactory.pas',
VTAccessibility in '..\..\Source\VTAccessibility.pas',
VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas',
VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas',
VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas',
VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas',
VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas',
VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas',
VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas',
VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas',
VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas',
VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas',
VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas';
VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas';
end.

41
components/virtualtreeview/packages/Delphi10.3/VirtualTreesR.dproj vendored
View File

@ -3,7 +3,7 @@
<ProjectGuid>{B62F3689-96E1-47D5-9FB2-2A2718281FDB}</ProjectGuid>
<MainSource>VirtualTreesR.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
@ -19,11 +19,6 @@
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
@ -40,14 +35,11 @@
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''">
<Cfg_2_Win64>true</Cfg_2_Win64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_CBuilderOutput>All</DCC_CBuilderOutput>
<SanitizedProjectName>VirtualTreesR</SanitizedProjectName>
<DCC_DcuOutput>..\..\build\$(Platform)</DCC_DcuOutput>
<DCC_HppOutput>..\..\Source</DCC_HppOutput>
<DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
<RuntimeOnlyPackage>true</RuntimeOnlyPackage>
<DCC_UnitSearchPath>..\..\source;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
@ -62,17 +54,10 @@
<DCC_N>false</DCC_N>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<SanitizedProjectName>VirtualTreesR</SanitizedProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_DcuOutput>$(BDSCOMMONDIR)\DCP\$(Platform)</DCC_DcuOutput>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
@ -87,9 +72,6 @@
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
@ -97,16 +79,16 @@
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="..\..\Source\VirtualTrees.pas"/>
<DCCReference Include="..\..\Source\VTHeaderPopup.pas"/>
<DCCReference Include="..\..\Source\VTAccessibilityFactory.pas"/>
<DCCReference Include="..\..\Source\VTAccessibility.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.HeaderPopup.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.AccessibilityFactory.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Accessibility.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.StyleHooks.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Classes.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.WorkerThread.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.ClipBoard.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Utils.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Export.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Actions.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Export.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Utils.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@ -154,10 +136,7 @@
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k190.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp190.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
<Excluded_Packages />
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>

3
components/virtualtreeview/packages/delphiXE5/VirtualTreesD.dproj
View File

@ -7,7 +7,7 @@
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<ProjectVersion>15.1</ProjectVersion>
<ProjectVersion>18.4</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
</PropertyGroup>
@ -52,6 +52,7 @@
<DCC_N>false</DCC_N>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<SanitizedProjectName>VirtualTreesD</SanitizedProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>

5
components/virtualtreeview/packages/delphiXE5/VirtualTreesR.dproj
View File

@ -7,7 +7,7 @@
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<ProjectVersion>15.1</ProjectVersion>
<ProjectVersion>18.4</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
</PropertyGroup>
@ -62,6 +62,7 @@
<DCC_N>false</DCC_N>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<SanitizedProjectName>VirtualTreesR</SanitizedProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
@ -104,8 +105,8 @@
<DCCReference Include="..\..\Source\VirtualTrees.WorkerThread.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.ClipBoard.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Utils.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Actions.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Export.pas"/>
<DCCReference Include="..\..\Source\VirtualTrees.Actions.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>