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

* Change file encoding, spacing and identation to match as close as possible original Delphi code

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4659 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2016-05-22 21:50:28 +00:00
parent 2181769050
commit 6644d68d21
1 changed files with 625 additions and 640 deletions
Download Patch File Download Diff File Expand all files Collapse all files

159
components/virtualtreeview-new/trunk/VirtualTrees.pas
View File

@ -28,14 +28,14 @@ unit VirtualTrees;
// For a list of recent changes please see file CHANGES.TXT // For a list of recent changes please see file CHANGES.TXT
// //
// Credits for their valuable assistance and code donations go to: // Credits for their valuable assistance and code donations go to:
// Freddy Ertl, Marian Aldenh?vel, Thomas Bogenrieder, Jim Kuenemann, Werner Lehmann, Jens Treichler, // Freddy Ertl, Marian Aldenhövel, Thomas Bogenrieder, Jim Kuenemann, Werner Lehmann, Jens Treichler,
// Paul Gallagher (IBO tree), Ondrej Kelle, Ronaldo Melo Ferraz, Heri Bender, Roland Bed?rftig (BCB) // Paul Gallagher (IBO tree), Ondrej Kelle, Ronaldo Melo Ferraz, Heri Bender, Roland Bedürftig (BCB)
// Anthony Mills, Alexander Egorushkin (BCB), Mathias Torell (BCB), Frank van den Bergh, Vadim Sedulin, Peter Evans, // Anthony Mills, Alexander Egorushkin (BCB), Mathias Torell (BCB), Frank van den Bergh, Vadim Sedulin, Peter Evans,
// Milan Vandrovec (BCB), Steve Moss, Joe White, David Clark, Anders Thomsen, Igor Afanasyev, Eugene Programmer, // Milan Vandrovec (BCB), Steve Moss, Joe White, David Clark, Anders Thomsen, Igor Afanasyev, Eugene Programmer,
// Corbin Dunn, Richard Pringle, Uli Gerhardt, Azza, Igor Savkic, Daniel Bauten, Timo Tegtmeier, Dmitry Zegebart, // Corbin Dunn, Richard Pringle, Uli Gerhardt, Azza, Igor Savkic, Daniel Bauten, Timo Tegtmeier, Dmitry Zegebart,
// Andreas Hausladen, Joachim Marder // Andreas Hausladen, Joachim Marder
// Beta testers: // Beta testers:
// Freddy Ertl, Hans-J?rgen Schnorrenberg, Werner Lehmann, Jim Kueneman, Vadim Sedulin, Moritz Franckenstein, // Freddy Ertl, Hans-Jürgen Schnorrenberg, Werner Lehmann, Jim Kueneman, Vadim Sedulin, Moritz Franckenstein,
// Wim van der Vegt, Franc v/d Westelaken // Wim van der Vegt, Franc v/d Westelaken
// Indirect contribution (via publicly accessible work of those persons): // Indirect contribution (via publicly accessible work of those persons):
// Alex Denissov, Hiroyuki Hori (MMXAsm expert) // Alex Denissov, Hiroyuki Hori (MMXAsm expert)
@ -49,7 +49,7 @@ unit VirtualTrees;
// Accessability implementation: // Accessability implementation:
// Marco Zehe (with help from Sebastian Modersohn) // Marco Zehe (with help from Sebastian Modersohn)
// LCL Port: // LCL Port:
// Luiz Am?rico Pereira C?mara // Luiz Américo Pereira Câmara
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
interface interface
@ -252,10 +252,10 @@ type
// Need to declare the correct WMNCPaint record as the VCL (D5-) doesn't. // Need to declare the correct WMNCPaint record as the VCL (D5-) doesn't.
TRealWMNCPaint = packed record TRealWMNCPaint = packed record
Msg: Cardinal; Msg: UINT;
Rgn: HRGN; Rgn: HRGN;
lParam: Integer; lParam: LPARAM;
Result: Integer; Result: LRESULT;
end; end;
// Be careful when adding new states as this might change the size of the type which in turn // Be careful when adding new states as this might change the size of the type which in turn
@ -2019,9 +2019,6 @@ type
// ----- TBaseVirtualTree // ----- TBaseVirtualTree
{ TBaseVirtualTree }
TBaseVirtualTree = class(TCustomControl) TBaseVirtualTree = class(TCustomControl)
private private
//FBorderStyle: TBorderStyle; //FBorderStyle: TBorderStyle;
@ -2336,7 +2333,6 @@ type
FVclStyleEnabled: Boolean; FVclStyleEnabled: Boolean;
// TODO: Compilerversion Ein/Ausschalten < Ist Eingeschaltet >
{$ifdef VCLStyleSupport} {$ifdef VCLStyleSupport}
FSavedBevelKind: TBevelKind; FSavedBevelKind: TBevelKind;
FSavedBorderWidth: Integer; FSavedBorderWidth: Integer;
@ -3295,7 +3291,7 @@ type
public public
constructor Create(Link: TStringEditLink); reintroduce; constructor Create(Link: TStringEditLink); reintroduce;
procedure Release; procedure Release; virtual;
property AutoSelect; property AutoSelect;
property AutoSize; property AutoSize;
@ -4071,7 +4067,7 @@ const
// Do not modify the copyright in any way! Usage of this unit is prohibited without the copyright notice // Do not modify the copyright in any way! Usage of this unit is prohibited without the copyright notice
// in the compiled binary file. // in the compiled binary file.
Copyright: string = 'Virtual Treeview ? 1999, 2010 Mike Lischke'; Copyright: string = 'Virtual Treeview © 1999, 2010 Mike Lischke';
var var
//Workaround to LCL bug 8553 //Workaround to LCL bug 8553
@ -4215,19 +4211,6 @@ type // streaming support
end; end;
const const
CheckImagesStrings: array [TCheckImageKind] of String =
('VT_CHECK_LIGHT',
'VT_CHECK_DARK',
'VT_TICK_LIGHT',
'VT_TICK_DARK',
'VT_FLAT',
'VT_XP',
'',//ckCustom,
// Only the button images are used for ckSystem *
// The check buttons are draw at fly as requested
'VT_FLAT',//ckSystemFlat
'VT_CHECK_DARK' //ckSystemDefault
);
MagicID: TMagicID = (#$45, 'V', 'T', Char(VTTreeStreamVersion), ' ', #$46); MagicID: TMagicID = (#$45, 'V', 'T', Char(VTTreeStreamVersion), ' ', #$46);
// chunk IDs // chunk IDs
@ -4248,6 +4231,20 @@ const
WideCR = WideChar(#13); WideCR = WideChar(#13);
WideLF = WideChar(#10); WideLF = WideChar(#10);
CheckImagesStrings: array [TCheckImageKind] of String =
('VT_CHECK_LIGHT',
'VT_CHECK_DARK',
'VT_TICK_LIGHT',
'VT_TICK_DARK',
'VT_FLAT',
'VT_XP',
'',//ckCustom,
// Only the button images are used for ckSystem *
// The check buttons are draw at fly as requested
'VT_FLAT',//ckSystemFlat
'VT_CHECK_DARK' //ckSystemDefault
);
type type
// internal worker thread // internal worker thread
TWorkerThread = class(TThread) TWorkerThread = class(TThread)
@ -5142,19 +5139,17 @@ begin
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
{$ifdef CPU64}
function HasMMX: Boolean;
begin
Result := True;
end;
{$else}
function HasMMX: Boolean; function HasMMX: Boolean;
// Helper method to determine whether the current processor supports MMX. // Helper method to determine whether the current processor supports MMX.
{$ifdef CPU64}
begin
// We use SSE2 in the "MMX-functions"
Result := True;
end;
{$else}
asm asm
PUSH EBX PUSH EBX
XOR EAX, EAX // Result := False XOR EAX, EAX // Result := False
@ -5539,6 +5534,7 @@ begin
end; end;
//----------------- TBufferedUTF8String -------------------------------------------------------------------------------- //----------------- TBufferedUTF8String --------------------------------------------------------------------------------
const const
AllocIncrement = 2 shl 11; // Must be a power of 2. AllocIncrement = 2 shl 11; // Must be a power of 2.
@ -5552,6 +5548,7 @@ end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
function TBufferedUTF8String.GetAsAnsiString: AnsiString; function TBufferedUTF8String.GetAsAnsiString: AnsiString;
begin begin
//an implicit conversion is done //an implicit conversion is done
Result := AsUTF16String; Result := AsUTF16String;
@ -10582,7 +10579,8 @@ begin
Result := True; Result := True;
Message.Result := 0; Message.Result := 0;
end end
else if IsInHeader then else
if IsInHeader then
begin begin
HitIndex := Columns.AdjustDownColumn(P); HitIndex := Columns.AdjustDownColumn(P);
// in design-time header columns are always draggable // in design-time header columns are always draggable
@ -10887,6 +10885,8 @@ begin
// Determine initial position of drag image (screen coordinates). // Determine initial position of drag image (screen coordinates).
FColumns.FDropTarget := NoColumn; FColumns.FDropTarget := NoColumn;
Start := Treeview.ScreenToClient(Start); Start := Treeview.ScreenToClient(Start);
//lclheader
//Inc(Start.Y, FHeight);
FColumns.FDragIndex := FColumns.ColumnFromPosition(Start); FColumns.FDragIndex := FColumns.ColumnFromPosition(Start);
DragColumn := FColumns[FColumns.FDragIndex]; DragColumn := FColumns[FColumns.FDragIndex];
@ -11003,7 +11003,8 @@ begin
with FColumns do with FColumns do
if (FMaxWidthPercent > 0) and (FixedWidth > MaxFixedWidth) then if (FMaxWidthPercent > 0) and (FixedWidth > MaxFixedWidth) then
ResizeColumns(MaxFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed]) ResizeColumns(MaxFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed])
else if (FMinWidthPercent > 0) and (FixedWidth < MinFixedWidth) then else
if (FMinWidthPercent > 0) and (FixedWidth < MinFixedWidth) then
ResizeColumns(MinFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed]); ResizeColumns(MinFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed]);
FColumns.UpdatePositions; FColumns.UpdatePositions;
@ -11757,7 +11758,7 @@ begin
FColors[13] := clHighlight; // SelectionRectangleBorderColor FColors[13] := clHighlight; // SelectionRectangleBorderColor
FColors[14] := clBtnShadow; // HeaderHotColor FColors[14] := clBtnShadow; // HeaderHotColor
FColors[15] := clHighlightText; // SelectionTextColor FColors[15] := clHighlightText; // SelectionTextColor
FColors[16] := clMedGray; // UnfocusedColor [IPK] FColors[16] := clBtnFace; // UnfocusedColor [IPK]
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
@ -11971,6 +11972,7 @@ begin
FHotPlusBM := TBitmap.Create; FHotPlusBM := TBitmap.Create;
FMinusBM := TBitmap.Create; FMinusBM := TBitmap.Create;
FHotMinusBM := TBitmap.Create; FHotMinusBM := TBitmap.Create;
BorderStyle := bsSingle; BorderStyle := bsSingle;
FButtonStyle := bsRectangle; FButtonStyle := bsRectangle;
FButtonFillMode := fmTreeColor; FButtonFillMode := fmTreeColor;
@ -12454,7 +12456,6 @@ begin
CheckOffset := 0; CheckOffset := 0;
AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions); AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions);
SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions; SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions;
// This is the node to start with. // This is the node to start with.
Run := InternalGetNodeAt(0, MinY, False, CurrentTop); Run := InternalGetNodeAt(0, MinY, False, CurrentTop);
@ -12512,7 +12513,6 @@ begin
end end
else else
CurrentRight := NodeRight; CurrentRight := NodeRight;
// Check if we need the node's width. This is the case when the node is not left aligned or the // Check if we need the node's width. This is the case when the node is not left aligned or the
// left border of the selection rectangle is to the right of the left node border. // left border of the selection rectangle is to the right of the left node border.
if (TextLeft < OldRect.Left) or (TextLeft < NewRect.Left) or (Alignment <> taLeftJustify) then if (TextLeft < OldRect.Left) or (TextLeft < NewRect.Left) or (Alignment <> taLeftJustify) then
@ -12563,7 +12563,6 @@ begin
InternalRemoveFromSelection(Run); InternalRemoveFromSelection(Run);
end; end;
end; end;
CurrentTop := NextTop; CurrentTop := NextTop;
// Get next visible node and update left node position. // Get next visible node and update left node position.
NextNode := GetNextVisibleNoInit(Run, True); NextNode := GetNextVisibleNoInit(Run, True);
@ -12634,7 +12633,6 @@ begin
CheckOffset := 0; CheckOffset := 0;
AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions); AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions);
SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions; SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions;
// This is the node to start with. // This is the node to start with.
Run := InternalGetNodeAt(0, MinY, False, CurrentTop); Run := InternalGetNodeAt(0, MinY, False, CurrentTop);
@ -12686,9 +12684,7 @@ begin
end end
else else
CurrentLeft := NodeLeft; CurrentLeft := NodeLeft;
// Check if we need the node's width. This is the case when the node is not left aligned (in RTL context this // means actually right aligned) or the right border of the selection rectangle is to the left
// Check if we need the node's width. This is the case when the node is not left aligned (in RTL context this
// means actually right aligned) or the right border of the selection rectangle is to the left
// of the right node border. // of the right node border.
if (TextRight > OldRect.Right) or (TextRight > NewRect.Right) or (Alignment <> taRightJustify) then if (TextRight > OldRect.Right) or (TextRight > NewRect.Right) or (Alignment <> taRightJustify) then
begin begin
@ -12740,7 +12736,6 @@ begin
InternalRemoveFromSelection(Run); InternalRemoveFromSelection(Run);
end; end;
end; end;
CurrentTop := NextTop; CurrentTop := NextTop;
// Get next visible node and update left node position. // Get next visible node and update left node position.
NextNode := GetNextVisibleNoInit(Run, True); NextNode := GetNextVisibleNoInit(Run, True);
@ -13644,6 +13639,7 @@ begin
end; end;
{$endif} {$endif}
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean; function TBaseVirtualTree.IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean;
@ -13737,13 +13733,13 @@ end;
function TBaseVirtualTree.PackArray(const TheArray: TNodeArray; Count: Integer): Integer; function TBaseVirtualTree.PackArray(const TheArray: TNodeArray; Count: Integer): Integer;
var var
Source, Dest: ^PVirtualNode; Source, Dest: ^PVirtualNode;
ConstOne: PtrInt; ConstOne: NativeInt;
begin begin
Source := Pointer(TheArray); Source := Pointer(TheArray);
ConstOne := 1; ConstOne := 1;
Result := 0; Result := 0;
// Do the fastest scan possible to find the first entry // Do the fastest scan possible to find the first entry
while (Count <> 0) and {not Odd(NativeInt(Source^))} (PtrInt(Source^) and ConstOne = 0) do while (Count <> 0) and {not Odd(NativeInt(Source^))} (NativeInt(Source^) and ConstOne = 0) do
begin begin
Inc(Result); Inc(Result);
Inc(Source); Inc(Source);
@ -13755,7 +13751,7 @@ begin
Dest := Source; Dest := Source;
repeat repeat
// Skip odd entries // Skip odd entries
if {not Odd(NativeInt(Source^))} PtrInt(Source^) and ConstOne = 0 then if {not Odd(NativeInt(Source^))} NativeInt(Source^) and ConstOne = 0 then
begin begin
Dest^ := Source^; Dest^ := Source^;
Inc(Result); Inc(Result);
@ -13766,7 +13762,6 @@ begin
until Count = 0; until Count = 0;
end; end;
end; end;
{$else} {$else}
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
@ -13905,7 +13900,7 @@ begin
// box is always of odd size // box is always of odd size
FillBitmap(FMinusBM); FillBitmap(FMinusBM);
FillBitmap(FHotMinusBM); FillBitmap(FHotMinusBM);
// Weil die selbstgezeichneten Bitmaps sehen im Vcl Style scheiße aus // Weil die selbstgezeichneten Bitmaps sehen im Vcl Style schei? aus
if (not VclStyleEnabled) {or (Theme = 0)} then if (not VclStyleEnabled) {or (Theme = 0)} then
begin begin
if not(tsUseExplorerTheme in FStates) then if not(tsUseExplorerTheme in FStates) then
@ -16423,7 +16418,6 @@ begin
if Shift = [ssCtrl, ssShift] then if Shift = [ssCtrl, ssShift] then
SetOffsetX(FOffsetX + ClientWidth) SetOffsetX(FOffsetX + ClientWidth)
else else
begin
if [ssShift, ssAlt] = Shift then if [ssShift, ssAlt] = Shift then
begin begin
if FFocusedColumn <= NoColumn then if FFocusedColumn <= NoColumn then
@ -16447,7 +16441,6 @@ begin
SetFocusedColumn(NewColumn); SetFocusedColumn(NewColumn);
end end
else else
begin
if ssCtrlOS in Shift then if ssCtrlOS in Shift then
SetOffsetY(FOffsetY + ClientHeight) SetOffsetY(FOffsetY + ClientHeight)
else else
@ -16472,13 +16465,10 @@ begin
end; end;
FocusedNode := Node; FocusedNode := Node;
end; end;
end;
end;
VK_NEXT: VK_NEXT:
if Shift = [ssCtrl, ssShift] then if Shift = [ssCtrl, ssShift] then
SetOffsetX(FOffsetX - ClientWidth) SetOffsetX(FOffsetX - ClientWidth)
else else
begin
if [ssShift, ssAlt] = Shift then if [ssShift, ssAlt] = Shift then
begin begin
if FFocusedColumn <= NoColumn then if FFocusedColumn <= NoColumn then
@ -16502,7 +16492,6 @@ begin
SetFocusedColumn(NewColumn); SetFocusedColumn(NewColumn);
end end
else else
begin
if ssCtrlOS in Shift then if ssCtrlOS in Shift then
SetOffsetY(FOffsetY - ClientHeight) SetOffsetY(FOffsetY - ClientHeight)
else else
@ -16527,8 +16516,6 @@ begin
end; end;
FocusedNode := Node; FocusedNode := Node;
end; end;
end;
end;
VK_UP: VK_UP:
begin begin
// scrolling without selection change // scrolling without selection change
@ -16997,7 +16984,6 @@ var
begin begin
{$ifdef DEBUG_VTV}Logger.EnterMethod([lcMessages],'WMLButtonDblClk');{$endif} {$ifdef DEBUG_VTV}Logger.EnterMethod([lcMessages],'WMLButtonDblClk');{$endif}
DoStateChange([tsLeftDblClick]); DoStateChange([tsLeftDblClick]);
inherited WMLButtonDblClk(Message); inherited WMLButtonDblClk(Message);
// get information about the hit // get information about the hit
@ -18272,7 +18258,6 @@ begin
//todo_lcl_low //todo_lcl_low
//AddBiDiModeExStyle(ExStyle); //AddBiDiModeExStyle(ExStyle);
end; end;
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
@ -21834,10 +21819,8 @@ var
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
function KeyUnicode(C: Char): WideChar; function KeyUnicode(C: Char): WideChar;
// Converts the given character into its corresponding Unicode character // Converts the given character into its corresponding Unicode character
// depending on the active keyboard layout. // depending on the active keyboard layout.
begin begin
MultiByteToWideChar(CodePageFromLocale(GetKeyboardLayout(0) and $FFFF), MultiByteToWideChar(CodePageFromLocale(GetKeyboardLayout(0) and $FFFF),
MB_USEGLYPHCHARS, @C, 1, @Result, 1); MB_USEGLYPHCHARS, @C, 1, @Result, 1);
@ -26001,6 +25984,7 @@ begin
//used to avoid default handler of LM_MOUSEWHEEL //used to avoid default handler of LM_MOUSEWHEEL
end; end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Boolean = False); procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Boolean = False);
@ -26388,7 +26372,6 @@ var
Run, ToDelete: PVirtualNode; Run, ToDelete: PVirtualNode;
begin begin
if tsCutPending in FStates then if tsCutPending in FStates then
begin begin
Run := FRoot.FirstChild; Run := FRoot.FirstChild;
@ -27110,7 +27093,8 @@ begin
Result := nil; Result := nil;
Break; Break;
end end
else if (not Assigned(Result.FirstChild)) or (not (vsExpanded in Result.States))then else
if (not Assigned(Result.FirstChild)) or (not (vsExpanded in Result.States))then
Break; Break;
Result := Result.FirstChild; Result := Result.FirstChild;
@ -27808,7 +27792,8 @@ begin
end; end;
end; end;
end end
else // i.e. StartNodeLevel > NodeLevel else
// i.e. StartNodeLevel > NodeLevel
Result := GetNextLevel(Node.Parent, NodeLevel); Result := GetNextLevel(Node.Parent, NodeLevel);
end; end;
@ -28289,7 +28274,8 @@ begin
// If there is a last child, take it; if not try the previous sibling. // If there is a last child, take it; if not try the previous sibling.
if Assigned(Result.LastChild) then if Assigned(Result.LastChild) then
Result := Result.LastChild Result := Result.LastChild
else if Assigned(Result.PrevSibling) then else
if Assigned(Result.PrevSibling) then
Result := Result.PrevSibling Result := Result.PrevSibling
else else
begin begin
@ -28441,7 +28427,8 @@ begin
begin begin
if Assigned(Result.PrevSibling) then if Assigned(Result.PrevSibling) then
Result := GetPreviousLevel(Result, NodeLevel) Result := GetPreviousLevel(Result, NodeLevel)
else if Assigned(Result) and (Result.Parent <> FRoot) then else
if Assigned(Result) and (Result.Parent <> FRoot) then
Result := GetPreviousLevel(Result.Parent, NodeLevel) Result := GetPreviousLevel(Result.Parent, NodeLevel)
else else
Result := nil; Result := nil;
@ -28450,7 +28437,8 @@ begin
else else
Result := GetPreviousLevel(Node.Parent, NodeLevel); Result := GetPreviousLevel(Node.Parent, NodeLevel);
end end
else if StartNodeLevel = NodeLevel then else
if StartNodeLevel = NodeLevel then
begin begin
Result := Node.PrevSibling; Result := Node.PrevSibling;
if not Assigned(Result) then // i.e. start node was a first sibling if not Assigned(Result) then // i.e. start node was a first sibling
@ -28488,7 +28476,8 @@ begin
// If there is a last child, take it; if not try the previous sibling. // If there is a last child, take it; if not try the previous sibling.
if Assigned(Result.LastChild) then if Assigned(Result.LastChild) then
Result := Result.LastChild Result := Result.LastChild
else if Assigned(Result.PrevSibling) then else
if Assigned(Result.PrevSibling) then
Result := Result.PrevSibling Result := Result.PrevSibling
else else
begin begin
@ -28627,7 +28616,8 @@ begin
if vsVisible in Result.States then if vsVisible in Result.States then
Break; Break;
end end
else if Assigned(Result.PrevSibling) then else
if Assigned(Result.PrevSibling) then
begin begin
if not (vsInitialized in Result.PrevSibling.States) then if not (vsInitialized in Result.PrevSibling.States) then
InitNode(Result.PrevSibling); InitNode(Result.PrevSibling);
@ -28733,7 +28723,8 @@ begin
if vsVisible in Result.States then if vsVisible in Result.States then
Break; Break;
end end
else if Assigned(Result.PrevSibling) then else
if Assigned(Result.PrevSibling) then
begin begin
// No children anymore, so take the previous sibling. // No children anymore, so take the previous sibling.
if vsVisible in Result.PrevSibling.States then if vsVisible in Result.PrevSibling.States then
@ -31852,7 +31843,8 @@ begin
else else
StepsR1 := ClientHeight - Integer(FRangeY); StepsR1 := ClientHeight - Integer(FRangeY);
end end
else if Integer(FRangeY) + HeightDelta <= ClientHeight then else
if Integer(FRangeY) + HeightDelta <= ClientHeight then
begin begin
// We cannot make the first child the top node as we cannot scroll to that extent, // We cannot make the first child the top node as we cannot scroll to that extent,
// so we do a simple scroll down. // so we do a simple scroll down.
@ -32015,12 +32007,10 @@ begin
Result := inherited UpdateAction(Action) Result := inherited UpdateAction(Action)
else else
begin begin
Result := (Action is TEditCut) or (Action is TEditCopy) Result := (Action is TEditCut) or (Action is TEditCopy) or (Action is TEditDelete);
or (Action is TEditDelete);
if Result then if Result then
TAction(Action).Enabled := (FSelectionCount > 0) and TAction(Action).Enabled := (FSelectionCount > 0) and ((Action is TEditDelete) or (FClipboardFormats.Count > 0))
((Action is TEditDelete) or (FClipboardFormats.Count > 0))
else else
begin begin
Result := Action is TEditPaste; Result := Action is TEditPaste;
@ -32923,7 +32913,7 @@ begin
begin begin
// Set default font values first. // Set default font values first.
Canvas.Font := Font; Canvas.Font := Font;
if Enabled then // Es werden sonst nur die Farben verwendet von Font die an Canvas.Font übergeben wurden if Enabled then // Es werden sonst nur die Farben verwendet von Font die an Canvas.Font übergeben wurden
Canvas.Font.Color := FColors.NodeFontColor Canvas.Font.Color := FColors.NodeFontColor
else else
Canvas.Font.Color := FColors.DisabledColor; Canvas.Font.Color := FColors.DisabledColor;
@ -33188,6 +33178,7 @@ var
begin begin
inherited; inherited;
MemDC := CreateCompatibleDC(0); MemDC := CreateCompatibleDC(0);
try try
SelectObject(MemDC, Font.Reference.Handle); SelectObject(MemDC, Font.Reference.Handle);
@ -33787,7 +33778,7 @@ function TCustomVirtualStringTree.ContentToHTML(Source: TVSTTextSourceType; cons
// Renders the current tree content (depending on Source) as HTML text encoded in UTF-8. // 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. // If Caption is not empty then it is used to create and fill the header for the table built here.
// Based on ideas and code from Frank van den Bergh and Andreas Hörstemeier. // Based on ideas and code from Frank van den Bergh and Andreas H??emeier.
type type
UCS2 = Word; UCS2 = Word;
@ -33909,7 +33900,7 @@ begin
// Create HTML table based on the tree structure. To simplify formatting we use styles defined in a small CSS area. // Create HTML table based on the tree structure. To simplify formatting we use styles defined in a small CSS area.
Buffer.Add('<style type="text/css">'); Buffer.Add('<style type="text/css">');
Buffer.AddNewLine; Buffer.AddnewLine;
WriteStyle('default', Font); WriteStyle('default', Font);
Buffer.AddNewLine; Buffer.AddNewLine;
WriteStyle('header', FHeader.Font); WriteStyle('header', FHeader.Font);
@ -34262,7 +34253,7 @@ end;
function TCustomVirtualStringTree.ContentToRTF(Source: TVSTTextSourceType): String; function TCustomVirtualStringTree.ContentToRTF(Source: TVSTTextSourceType): String;
// Renders the current tree content (depending on Source) as RTF (rich text). // Renders the current tree content (depending on Source) as RTF (rich text).
// Based on ideas and code from Frank van den Bergh and Andreas Hörstemeier. // Based on ideas and code from Frank van den Bergh and Andreas H??emeier.
var var
Fonts: TStringList; Fonts: TStringList;
@ -36045,11 +36036,5 @@ finalization
InternalClipboardFormats.Free; InternalClipboardFormats.Free;
InternalClipboardFormats := nil; InternalClipboardFormats := nil;
{$ifdef EnableAccessible}
if VTAccessibleFactory <> nil then
begin
VTAccessibleFactory.Free;
VTAccessibleFactory := nil;
end;
{$endif}
end. end.