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
//
// Credits for their valuable assistance and code donations go to:
// 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)
// 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)
// 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,
// Corbin Dunn, Richard Pringle, Uli Gerhardt, Azza, Igor Savkic, Daniel Bauten, Timo Tegtmeier, Dmitry Zegebart,
// Andreas Hausladen, Joachim Marder
// 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
// Indirect contribution (via publicly accessible work of those persons):
// Alex Denissov, Hiroyuki Hori (MMXAsm expert)
@ -49,7 +49,7 @@ unit VirtualTrees;
// Accessability implementation:
// Marco Zehe (with help from Sebastian Modersohn)
// LCL Port:
// Luiz Am?rico Pereira C?mara
// Luiz Américo Pereira Câmara
//----------------------------------------------------------------------------------------------------------------------
interface
@ -252,10 +252,10 @@ type
// Need to declare the correct WMNCPaint record as the VCL (D5-) doesn't.
TRealWMNCPaint = packed record
Msg: Cardinal;
Msg: UINT;
Rgn: HRGN;
lParam: Integer;
Result: Integer;
lParam: LPARAM;
Result: LRESULT;
end;
// 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 = class(TCustomControl)
private
//FBorderStyle: TBorderStyle;
@ -2336,7 +2333,6 @@ type
FVclStyleEnabled: Boolean;
// TODO: Compilerversion Ein/Ausschalten < Ist Eingeschaltet >
{$ifdef VCLStyleSupport}
FSavedBevelKind: TBevelKind;
FSavedBorderWidth: Integer;
@ -3295,7 +3291,7 @@ type
public
constructor Create(Link: TStringEditLink); reintroduce;
procedure Release;
procedure Release; virtual;
property AutoSelect;
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
// in the compiled binary file.
Copyright: string = 'Virtual Treeview ? 1999, 2010 Mike Lischke';
Copyright: string = 'Virtual Treeview © 1999, 2010 Mike Lischke';
var
//Workaround to LCL bug 8553
@ -4215,19 +4211,6 @@ type // streaming support
end;
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);
// chunk IDs
@ -4248,6 +4231,20 @@ const
WideCR = WideChar(#13);
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
// internal worker thread
TWorkerThread = class(TThread)
@ -5142,19 +5139,17 @@ begin
end;
//----------------------------------------------------------------------------------------------------------------------
{$ifdef CPU64}
function HasMMX: Boolean;
begin
Result := True;
end;
{$else}
function HasMMX: Boolean;
// 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
PUSH EBX
XOR EAX, EAX // Result := False
@ -5539,6 +5534,7 @@ begin
end;
//----------------- TBufferedUTF8String --------------------------------------------------------------------------------
const
AllocIncrement = 2 shl 11; // Must be a power of 2.
@ -5552,6 +5548,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBufferedUTF8String.GetAsAnsiString: AnsiString;
begin
//an implicit conversion is done
Result := AsUTF16String;
@ -10582,7 +10579,8 @@ begin
Result := True;
Message.Result := 0;
end
else if IsInHeader then
else
if IsInHeader then
begin
HitIndex := Columns.AdjustDownColumn(P);
// in design-time header columns are always draggable
@ -10887,6 +10885,8 @@ begin
// Determine initial position of drag image (screen coordinates).
FColumns.FDropTarget := NoColumn;
Start := Treeview.ScreenToClient(Start);
//lclheader
//Inc(Start.Y, FHeight);
FColumns.FDragIndex := FColumns.ColumnFromPosition(Start);
DragColumn := FColumns[FColumns.FDragIndex];
@ -11003,7 +11003,8 @@ begin
with FColumns do
if (FMaxWidthPercent > 0) and (FixedWidth > MaxFixedWidth) then
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]);
FColumns.UpdatePositions;
@ -11757,7 +11758,7 @@ begin
FColors[13] := clHighlight; // SelectionRectangleBorderColor
FColors[14] := clBtnShadow; // HeaderHotColor
FColors[15] := clHighlightText; // SelectionTextColor
FColors[16] := clMedGray; // UnfocusedColor [IPK]
FColors[16] := clBtnFace; // UnfocusedColor [IPK]
end;
//----------------------------------------------------------------------------------------------------------------------
@ -11971,6 +11972,7 @@ begin
FHotPlusBM := TBitmap.Create;
FMinusBM := TBitmap.Create;
FHotMinusBM := TBitmap.Create;
BorderStyle := bsSingle;
FButtonStyle := bsRectangle;
FButtonFillMode := fmTreeColor;
@ -12454,7 +12456,6 @@ begin
CheckOffset := 0;
AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions);
SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions;
// This is the node to start with.
Run := InternalGetNodeAt(0, MinY, False, CurrentTop);
@ -12512,7 +12513,6 @@ begin
end
else
CurrentRight := NodeRight;
// 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.
if (TextLeft < OldRect.Left) or (TextLeft < NewRect.Left) or (Alignment <> taLeftJustify) then
@ -12563,7 +12563,6 @@ begin
InternalRemoveFromSelection(Run);
end;
end;
CurrentTop := NextTop;
// Get next visible node and update left node position.
NextNode := GetNextVisibleNoInit(Run, True);
@ -12634,7 +12633,6 @@ begin
CheckOffset := 0;
AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions);
SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions;
// This is the node to start with.
Run := InternalGetNodeAt(0, MinY, False, CurrentTop);
@ -12686,9 +12684,7 @@ begin
end
else
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.
if (TextRight > OldRect.Right) or (TextRight > NewRect.Right) or (Alignment <> taRightJustify) then
begin
@ -12740,7 +12736,6 @@ begin
InternalRemoveFromSelection(Run);
end;
end;
CurrentTop := NextTop;
// Get next visible node and update left node position.
NextNode := GetNextVisibleNoInit(Run, True);
@ -13644,6 +13639,7 @@ begin
end;
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean;
@ -13737,13 +13733,13 @@ end;
function TBaseVirtualTree.PackArray(const TheArray: TNodeArray; Count: Integer): Integer;
var
Source, Dest: ^PVirtualNode;
ConstOne: PtrInt;
ConstOne: NativeInt;
begin
Source := Pointer(TheArray);
ConstOne := 1;
Result := 0;
// 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
Inc(Result);
Inc(Source);
@ -13755,7 +13751,7 @@ begin
Dest := Source;
repeat
// 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
Dest^ := Source^;
Inc(Result);
@ -13766,7 +13762,6 @@ begin
until Count = 0;
end;
end;
{$else}
//----------------------------------------------------------------------------------------------------------------------
@ -13905,7 +13900,7 @@ begin
// box is always of odd size
FillBitmap(FMinusBM);
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
begin
if not(tsUseExplorerTheme in FStates) then
@ -16423,7 +16418,6 @@ begin
if Shift = [ssCtrl, ssShift] then
SetOffsetX(FOffsetX + ClientWidth)
else
begin
if [ssShift, ssAlt] = Shift then
begin
if FFocusedColumn <= NoColumn then
@ -16447,7 +16441,6 @@ begin
SetFocusedColumn(NewColumn);
end
else
begin
if ssCtrlOS in Shift then
SetOffsetY(FOffsetY + ClientHeight)
else
@ -16472,13 +16465,10 @@ begin
end;
FocusedNode := Node;
end;
end;
end;
VK_NEXT:
if Shift = [ssCtrl, ssShift] then
SetOffsetX(FOffsetX - ClientWidth)
else
begin
if [ssShift, ssAlt] = Shift then
begin
if FFocusedColumn <= NoColumn then
@ -16502,7 +16492,6 @@ begin
SetFocusedColumn(NewColumn);
end
else
begin
if ssCtrlOS in Shift then
SetOffsetY(FOffsetY - ClientHeight)
else
@ -16527,8 +16516,6 @@ begin
end;
FocusedNode := Node;
end;
end;
end;
VK_UP:
begin
// scrolling without selection change
@ -16997,7 +16984,6 @@ var
begin
{$ifdef DEBUG_VTV}Logger.EnterMethod([lcMessages],'WMLButtonDblClk');{$endif}
DoStateChange([tsLeftDblClick]);
inherited WMLButtonDblClk(Message);
// get information about the hit
@ -18272,7 +18258,6 @@ begin
//todo_lcl_low
//AddBiDiModeExStyle(ExStyle);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
@ -21834,10 +21819,8 @@ var
//---------------------------------------------------------------------------
function KeyUnicode(C: Char): WideChar;
// Converts the given character into its corresponding Unicode character
// depending on the active keyboard layout.
begin
MultiByteToWideChar(CodePageFromLocale(GetKeyboardLayout(0) and $FFFF),
MB_USEGLYPHCHARS, @C, 1, @Result, 1);
@ -26001,6 +25984,7 @@ begin
//used to avoid default handler of LM_MOUSEWHEEL
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Boolean = False);
@ -26388,7 +26372,6 @@ var
Run, ToDelete: PVirtualNode;
begin
if tsCutPending in FStates then
begin
Run := FRoot.FirstChild;
@ -27110,7 +27093,8 @@ begin
Result := nil;
Break;
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;
Result := Result.FirstChild;
@ -27808,7 +27792,8 @@ begin
end;
end;
end
else // i.e. StartNodeLevel > NodeLevel
else
// i.e. StartNodeLevel > NodeLevel
Result := GetNextLevel(Node.Parent, NodeLevel);
end;
@ -28289,7 +28274,8 @@ begin
// If there is a last child, take it; if not try the previous sibling.
if Assigned(Result.LastChild) then
Result := Result.LastChild
else if Assigned(Result.PrevSibling) then
else
if Assigned(Result.PrevSibling) then
Result := Result.PrevSibling
else
begin
@ -28441,7 +28427,8 @@ begin
begin
if Assigned(Result.PrevSibling) then
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)
else
Result := nil;
@ -28450,7 +28437,8 @@ begin
else
Result := GetPreviousLevel(Node.Parent, NodeLevel);
end
else if StartNodeLevel = NodeLevel then
else
if StartNodeLevel = NodeLevel then
begin
Result := Node.PrevSibling;
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 Assigned(Result.LastChild) then
Result := Result.LastChild
else if Assigned(Result.PrevSibling) then
else
if Assigned(Result.PrevSibling) then
Result := Result.PrevSibling
else
begin
@ -28627,7 +28616,8 @@ begin
if vsVisible in Result.States then
Break;
end
else if Assigned(Result.PrevSibling) then
else
if Assigned(Result.PrevSibling) then
begin
if not (vsInitialized in Result.PrevSibling.States) then
InitNode(Result.PrevSibling);
@ -28733,7 +28723,8 @@ begin
if vsVisible in Result.States then
Break;
end
else if Assigned(Result.PrevSibling) then
else
if Assigned(Result.PrevSibling) then
begin
// No children anymore, so take the previous sibling.
if vsVisible in Result.PrevSibling.States then
@ -31852,7 +31843,8 @@ begin
else
StepsR1 := ClientHeight - Integer(FRangeY);
end
else if Integer(FRangeY) + HeightDelta <= ClientHeight then
else
if Integer(FRangeY) + HeightDelta <= ClientHeight then
begin
// We cannot make the first child the top node as we cannot scroll to that extent,
// so we do a simple scroll down.
@ -32015,12 +32007,10 @@ begin
Result := inherited UpdateAction(Action)
else
begin
Result := (Action is TEditCut) or (Action is TEditCopy)
or (Action is TEditDelete);
Result := (Action is TEditCut) or (Action is TEditCopy) or (Action is TEditDelete);
if Result then
TAction(Action).Enabled := (FSelectionCount > 0) and
((Action is TEditDelete) or (FClipboardFormats.Count > 0))
TAction(Action).Enabled := (FSelectionCount > 0) and ((Action is TEditDelete) or (FClipboardFormats.Count > 0))
else
begin
Result := Action is TEditPaste;
@ -32923,7 +32913,7 @@ begin
begin
// Set default font values first.
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
else
Canvas.Font.Color := FColors.DisabledColor;
@ -33188,6 +33178,7 @@ var
begin
inherited;
MemDC := CreateCompatibleDC(0);
try
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.
// 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
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.
Buffer.Add('<style type="text/css">');
Buffer.AddNewLine;
Buffer.AddnewLine;
WriteStyle('default', Font);
Buffer.AddNewLine;
WriteStyle('header', FHeader.Font);
@ -34262,7 +34253,7 @@ end;
function TCustomVirtualStringTree.ContentToRTF(Source: TVSTTextSourceType): String;
// 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
Fonts: TStringList;
@ -36045,11 +36036,5 @@ finalization
InternalClipboardFormats.Free;
InternalClipboardFormats := nil;
{$ifdef EnableAccessible}
if VTAccessibleFactory <> nil then
begin
VTAccessibleFactory.Free;
VTAccessibleFactory := nil;
end;
{$endif}
end.