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

Revert changes done in trunk after creation of 4.8 branch

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2787 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2013-09-07 18:51:06 +00:00
parent 9327df59c7
commit d40caa283a
16 changed files with 113 additions and 212 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,23 +27,6 @@ unit VirtualTrees;
// (C) 1999-2001 digital publishing AG. All Rights Reserved.
//----------------------------------------------------------------------------------------------------------------------
//
// January 2010 (j.wielicki@sotecware.net)
// - Improvement: Introduced 64-bit compatibility.
// January 2010
// - Bug fix: TBaseVirtualTree.AdjustTotalHeight now longer calculates wrong total heights if nodes have been
// made invisible
// - Bug fix: TCustomVirtualStringTree.OnMeasureTextWidth now works as intended
// - Bug fix: Added missing $IFDEFs concerning theming support
// - Bug fix: Removed default from properties TVirtualTreeColumn.Color and TVirtualTreeColumn.BiDiMode
// July 2009
// - Bug fix: TWorkerThread will no longer reference the tree after it has been destroyed (Mantis issue #384)
// - Bug fix: TBaseVirtualTree.InternalConnectNode checked the expanded state of the wrong node if Mode was
// amAddChildFirst or amAddChildLast
// June 2009
// - Bug fix: fixed some issues concerning the vista theme handling
// - Improvement: removed hidden node handling in this branch
// - Improvement: reverted header click handling to old version to keep compatibility in this branch
// - Improvement: removed TVTPaintOption toHideTreeLinesIfThemed
// May 2009
// - Improvement: new TVTMiscOption toEditOnClick, toEditOnDblClick to control if editing can be started with a single
// click or a double click
@ -322,10 +305,6 @@ interface
{$define ManualClipNeeded}
{$endif}
{$ifdef CPU64}
{$asmmode ATT}
{$endif}
uses
{$ifdef Windows}
Windows,
@ -506,6 +485,8 @@ type
Result: Integer;
end;
TLMContextMenu = TLMMouse;
// Be careful when adding new states as this might change the size of the type which in turn
// changes the alignment in the node record as well as the stream chunks.
// Do not reorder the states and always add new states at the end of this enumeration in order to avoid
@ -2016,9 +1997,9 @@ type
TVTDragAllowedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var Allowed: Boolean) of object;
TVTDragOverEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
const Pt: TPoint; Mode: TDropMode; var Effect: PtrUInt; var Accept: Boolean) of object;
const Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean) of object;
TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint; var Effect: PtrUInt; Mode: TDropMode) of object;
Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint; var Effect: Integer; Mode: TDropMode) of object;
TVTRenderOLEDataEvent = procedure(Sender: TBaseVirtualTree; const FormatEtcIn: TFormatEtc; out Medium: TStgMedium;
ForClipboard: Boolean; var Result: HRESULT) of object;
TVTGetUserClipboardFormatsEvent = procedure(Sender: TBaseVirtualTree; var Formats: TFormatEtcArray) of object;
@ -2175,7 +2156,7 @@ type
FDragHeight: Integer; // size of the drag image, the larger the more CPU power is needed
FClipboardFormats: TClipboardFormats; // a list of clipboard format descriptions enabled for this tree
FLastVCLDragTarget: PVirtualNode; // A node cache for VCL drag'n drop (keywords: DragLeave on DragDrop).
FVCLDragEffect: PtrUInt; // A cache for VCL drag'n drop to keep the current drop effect.
FVCLDragEffect: LongWord; // A cache for VCL drag'n drop to keep the current drop effect.
// scroll support
FScrollBarOptions: TScrollBarOptions; // common properties of horizontal and vertical scrollbar
@ -2595,9 +2576,9 @@ type
function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint;
ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean): LRESULT; override;
function DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint; Mode: TDropMode;
var Effect: PtrUInt): Boolean; virtual;
var Effect: LongWord): Boolean; virtual;
procedure DoDragDrop(Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint;
var Effect: PtrUInt; Mode: TDropMode); virtual;
var Effect: LongWord; Mode: TDropMode); virtual;
procedure DoEdit; virtual;
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
function DoEndEdit: Boolean; virtual;
@ -2668,12 +2649,12 @@ type
DragEffect: Integer); virtual;
procedure DragCanceled; override;
function DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
var Effect: PtrUInt): HResult; reintroduce; virtual;
function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: PtrUInt): HResult; virtual;
var Effect: LongWord): HResult; reintroduce; virtual;
function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: LongWord): HResult; virtual;
procedure DragFinished; virtual;
procedure DragLeave; virtual;
function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint;
var Effect: PtrUInt): HResult; reintroduce; virtual;
var Effect: LongWord): HResult; reintroduce; virtual;
procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: Integer); virtual;
procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: Integer); virtual;
procedure EndOperation;
@ -4846,7 +4827,7 @@ end;
function HasMMX: Boolean;
// Helper method to determine whether the current processor supports MMX.
{$IFDEF CPU32}
asm
PUSH EBX
XOR EAX, EAX // Result := False
@ -4875,12 +4856,6 @@ asm
@1:
POP EBX
end;
{$ELSE}
begin
//todo: should not all cpu64 have mmx?
Result := False;
end;
{$ENDIF}
//----------------------------------------------------------------------------------------------------------------------
{$ifdef EnablePrint}
@ -13156,51 +13131,6 @@ function TBaseVirtualTree.PackArrayAsm(TheArray: TNodeArray; Count: Integer): In
// The returned value is the number of remaining entries in the array, so the caller can reallocate (shorten)
// the selection array if needed or -1 if nothing needs to be changed.
{$IFDEF CPU64}
label
PreScan, DoMainLoop, MainLoop, Skip, Finish;
asm
push %rbx
push %rdi
push %rsi
mov %rdx, %rsi
mov $-1, %rdx
cmpq $0, %rcx
jz Finish
inc %rdx
mov %rsi, %rdi
movq $1, %rbx
PreScan:
testq (%rsi), %rbx
jnz DoMainLoop
inc %rdx
add $8, %rsi
dec %rcx
jnz PreScan
jmp Finish
DoMainLoop:
mov %rsi, %rdi
MainLoop:
test (%rsi), %rbx
jne Skip
movq (%rsi), %r10
movq %r10, (%rdi)
inc %rdx
dec %rcx
jnz MainLoop
jmp Finish
Skip:
add $8, %rsi
dec %rcx
jnz MainLoop
Finish:
mov %rdx, %rax
pop %rsi
pop %rdi
pop %rbx
end;
{$ELSE}
asm
PUSH EBX
PUSH EDI
@ -13242,7 +13172,6 @@ asm
POP EDI
POP EBX
end;
{$ENDIF}
//----------------------------------------------------------------------------------------------------------------------
@ -14757,7 +14686,7 @@ begin
// Allowed drop effects are simulated for VCL dd.
Result := DROPEFFECT_MOVE or DROPEFFECT_COPY;
DragOver(S, ShiftState, TDragState(ADragMessage), APosition, PtrUInt(Result));
DragOver(S, ShiftState, TDragState(ADragMessage), APosition, LongWord(Result));
FLastVCLDragTarget := FDropTargetNode;
FVCLDragEffect := Result;
if (ADragMessage = dmDragLeave) and Assigned(FDropTargetNode) then
@ -15120,6 +15049,7 @@ var
ScrollLines: DWORD;
RTLFactor: Integer;
WheelFactor: Double;
begin
//todo: rename to WM*
{$ifdef DEBUG_VTV}Logger.EnterMethod([lcScroll],'CMMouseWheel');{$endif}
@ -18476,7 +18406,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint; Mode: TDropMode;
var Effect: PtrUInt): Boolean;
var Effect: LongWord): Boolean;
begin
Result := False;
@ -18487,7 +18417,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoDragDrop(Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; const Pt: TPoint; var Effect: PtrUInt; Mode: TDropMode);
Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
begin
if Assigned(FOnDragDrop) then
@ -19669,7 +19599,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
var Effect: PtrUInt): HResult;
var Effect: LongWord): HResult;
var
Shift: TShiftState;
@ -19735,7 +19665,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: PtrUInt): HResult;
function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: LongWord): HResult;
// callback routine for the drop target interface
@ -19826,7 +19756,7 @@ end;
procedure TBaseVirtualTree.DragLeave;
var
Effect: PtrUInt;
Effect: LongWord;
begin
KillTimer(Handle, ExpandTimer);
@ -19848,7 +19778,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint;
var Effect: PtrUInt): HResult;
var Effect: LongWord): HResult;
// callback routine for the drop target interface
@ -22328,8 +22258,8 @@ procedure TBaseVirtualTree.PaintCheckImage(const PaintInfo: TVTPaintInfo);
ButtonState := ButtonState or DFCS_CHECKED;
if Flat then
ButtonState := ButtonState or DFCS_FLAT;
DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, ButtonType or ButtonState);
//lcl DrawFrameControl is different from windows
DelphiCompat.DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, ButtonType or ButtonState);
end;
@ -28369,7 +28299,8 @@ begin
{$ifndef Gtk}
SetMapMode(Canvas.Handle, GetMapMode(TargetCanvas.Handle));
{$endif}
SetWindowOrgEx(Canvas.Handle, Window.Left, 0, nil);
//Workaround to LCL bug 8626
SetWindowOrgEx(Canvas.Handle, {$ifdef Gtk}-{$endif}Window.Left, 0, nil);
R.Bottom := PaintInfo.Node.NodeHeight;
end;
// Set the origin of the canvas' brush. This depends on the node heights.
@ -28682,7 +28613,7 @@ begin
{$ifdef DEBUG_VTV}Logger.Send([lcPaintDetails],'TargetRect',TargetRect);{$endif}
{$ifdef DEBUG_VTV}Logger.Send([lcPaintDetails],'NodeBitmap Width: %d Height: %d',[NodeBitmap.Width,NodeBitmap.Height]);{$endif}
// Call back application/descendants whether they want to erase this area.
SetWindowOrgEx(NodeBitmap.Canvas.Handle, Target.X, 0, nil);
SetWindowOrgEx(NodeBitmap.Canvas.Handle,{$ifndef Windows}-{$endif}Target.X, 0, nil);
if not DoPaintBackground(NodeBitmap.Canvas, TargetRect) then
begin
if UseBackground then
@ -30645,13 +30576,9 @@ begin
// This does not harm formatting as single line control, if we don't use word wrapping.
with Params do
begin
//todo: delphi uses Multiline for all
//Style := Style or ES_MULTILINE;
Style := Style or ES_MULTILINE;
if vsMultiline in FLink.FNode.States then
begin
Style := Style and not (ES_AUTOHSCROLL or WS_HSCROLL) or WS_VSCROLL or ES_AUTOVSCROLL;
Style := Style or ES_MULTILINE;
end;
if tsUseThemes in FLink.FTree.FStates then
begin
Style := Style and not WS_BORDER;
@ -30867,8 +30794,8 @@ constructor TCustomVirtualStringTree.Create(AOwner: TComponent);
begin
inherited;
if (Owner = nil) or (([csReading, csDesigning] * Owner.ComponentState) = [csDesigning]) then
FDefaultText := 'Node';
FDefaultText := 'Node';
FInternalDataOffset := AllocateInternalDataArea(SizeOf(Cardinal));
end;
@ -32178,7 +32105,7 @@ var
I: Integer;
begin
I := Colors.IndexOf(Pointer(ptruint(Color)));
I := Colors.IndexOf(Pointer(Color));
if I > -1 then
begin
// Color has already been used
@ -32191,7 +32118,7 @@ var
end
else
begin
I := Colors.Add(Pointer(ptruint(Color)));
I := Colors.Add(Pointer(Color));
Buffer.Add('\cf');
Buffer.Add(IntToStr(I + 1));
CurrentFontColor := I;
@ -32445,7 +32372,7 @@ begin
S := S + '{\colortbl;';
for I := 0 to Colors.Count - 1 do
begin
J := ColorToRGB(TColor(ptruint(Colors[I])));
J := ColorToRGB(TColor(Colors[I]));
S := S + Format('\red%d\green%d\blue%d;', [J and $FF, (J shr 8) and $FF, (J shr 16) and $FF]);
end;
S := S + '}';