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

* Add 64bit compatibility. Patch from Jonas Wielicki

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1185 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2010-03-23 18:57:20 +00:00
parent 76a44434e5
commit 13cf96482b
2 changed files with 78 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,6 +27,8 @@ unit VirtualTrees;
// (C) 1999-2001 digital publishing AG. All Rights Reserved.
//----------------------------------------------------------------------------------------------------------------------
//
// January 2010 (j.wielicki@sotecware.net)
// - Improvement: Introduced 64-bit compatibility.
// May 2009
// - Improvement: new TVTMiscOption toEditOnClick, toEditOnDblClick to control if editing can be started with a single
// click or a double click
@ -305,6 +307,10 @@ interface
{$define ManualClipNeeded}
{$endif}
{$ifdef CPU64}
{$asmmode ATT}
{$endif}
uses
{$ifdef Windows}
Windows,
@ -1997,9 +2003,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: Integer; var Accept: Boolean) of object;
const Pt: TPoint; Mode: TDropMode; var Effect: PtrUInt; var Accept: Boolean) of object;
TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint; var Effect: Integer; Mode: TDropMode) of object;
Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint; var Effect: PtrUInt; 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;
@ -2156,7 +2162,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: LongWord; // A cache for VCL drag'n drop to keep the current drop effect.
FVCLDragEffect: PtrUInt; // A cache for VCL drag'n drop to keep the current drop effect.
// scroll support
FScrollBarOptions: TScrollBarOptions; // common properties of horizontal and vertical scrollbar
@ -2576,9 +2582,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: LongWord): Boolean; virtual;
var Effect: PtrUInt): Boolean; virtual;
procedure DoDragDrop(Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint;
var Effect: LongWord; Mode: TDropMode); virtual;
var Effect: PtrUInt; Mode: TDropMode); virtual;
procedure DoEdit; virtual;
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
function DoEndEdit: Boolean; virtual;
@ -2649,12 +2655,12 @@ type
DragEffect: Integer); virtual;
procedure DragCanceled; override;
function DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
var Effect: LongWord): HResult; reintroduce; virtual;
function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: LongWord): HResult; virtual;
var Effect: PtrUInt): HResult; reintroduce; virtual;
function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: PtrUInt): HResult; virtual;
procedure DragFinished; virtual;
procedure DragLeave; virtual;
function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint;
var Effect: LongWord): HResult; reintroduce; virtual;
var Effect: PtrUInt): 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;
@ -4827,7 +4833,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
@ -4856,6 +4862,12 @@ asm
@1:
POP EBX
end;
{$ELSE}
begin
//todo: should not all cpu64 have mmx?
Result := False;
end;
{$ENDIF}
//----------------------------------------------------------------------------------------------------------------------
{$ifdef EnablePrint}
@ -13131,6 +13143,51 @@ 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
@ -13172,6 +13229,7 @@ asm
POP EDI
POP EBX
end;
{$ENDIF}
//----------------------------------------------------------------------------------------------------------------------
@ -14686,7 +14744,7 @@ begin
// Allowed drop effects are simulated for VCL dd.
Result := DROPEFFECT_MOVE or DROPEFFECT_COPY;
DragOver(S, ShiftState, TDragState(ADragMessage), APosition, LongWord(Result));
DragOver(S, ShiftState, TDragState(ADragMessage), APosition, PtrUInt(Result));
FLastVCLDragTarget := FDropTargetNode;
FVCLDragEffect := Result;
if (ADragMessage = dmDragLeave) and Assigned(FDropTargetNode) then
@ -18406,7 +18464,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint; Mode: TDropMode;
var Effect: LongWord): Boolean;
var Effect: PtrUInt): Boolean;
begin
Result := False;
@ -18417,7 +18475,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoDragDrop(Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
Shift: TShiftState; const Pt: TPoint; var Effect: PtrUInt; Mode: TDropMode);
begin
if Assigned(FOnDragDrop) then
@ -19599,7 +19657,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
var Effect: LongWord): HResult;
var Effect: PtrUInt): HResult;
var
Shift: TShiftState;
@ -19665,7 +19723,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: LongWord): HResult;
function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: PtrUInt): HResult;
// callback routine for the drop target interface
@ -19756,7 +19814,7 @@ end;
procedure TBaseVirtualTree.DragLeave;
var
Effect: LongWord;
Effect: PtrUInt;
begin
KillTimer(Handle, ExpandTimer);
@ -19778,7 +19836,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint;
var Effect: LongWord): HResult;
var Effect: PtrUInt): HResult;
// callback routine for the drop target interface
@ -32105,7 +32163,7 @@ var
I: Integer;
begin
I := Colors.IndexOf(Pointer(Color));
I := Colors.IndexOf(Pointer(ptruint(Color)));
if I > -1 then
begin
// Color has already been used
@ -32118,7 +32176,7 @@ var
end
else
begin
I := Colors.Add(Pointer(Color));
I := Colors.Add(Pointer(ptruint(Color)));
Buffer.Add('\cf');
Buffer.Add(IntToStr(I + 1));
CurrentFontColor := I;
@ -32372,7 +32430,7 @@ begin
S := S + '{\colortbl;';
for I := 0 to Colors.Count - 1 do
begin
J := ColorToRGB(TColor(Colors[I]));
J := ColorToRGB(TColor(ptruint(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 + '}';

2
components/virtualtreeview-new/trunk/include/intf/win32/vtvdragmanager.inc
View File

@ -613,7 +613,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.DragEnter(const DataObject: IDataObject; KeyState: LongWord; Pt: TPoint;
var Effect: LongWord): HResult;
var Effect: PtrUInt): HResult;
begin
FDataObject := DataObject;