Index: VTConfig.inc =================================================================== --- VTConfig.inc (revision 2731) +++ VTConfig.inc (working copy) @@ -22,7 +22,7 @@ //Lazarus port options -{$define EnableOLE} +{.$define EnableOLE} {.$define EnableNativeTVM} {.$define EnablePrint} {.$define EnableNCFunctions} @@ -42,7 +42,7 @@ //under linux the performance is poor with threading enabled {$ifdef Windows} - {$define EnableThreadSupport} + {.$define EnableThreadSupport} {$endif} {$ifdef CPU64} {$define PACKARRAYPASCAL} Index: VirtualTrees.pas =================================================================== --- VirtualTrees.pas (revision 2731) +++ VirtualTrees.pas (working copy) @@ -745,6 +745,7 @@ toAutoHideButtons, // Node buttons are hidden when there are child nodes, but all are invisible. toAutoDeleteMovedNodes, // Delete nodes which where moved in a drag operation (if not directed otherwise). toDisableAutoscrollOnFocus, // Disable scrolling a node or column into view if it gets focused. + toDisableAutoscrollHorizontal, // Only autoscroll on focus vertically never horizontally toAutoChangeScale, // Change default node height automatically if the system's font scale is set to big fonts. toAutoFreeOnCollapse, // Frees any child node after a node has been collapsed (HasChildren flag stays there). toDisableAutoscrollOnEdit, // Do not center a node horizontally when it is edited. @@ -2018,7 +2019,7 @@ var Allowed: Boolean) of object; TVTDragOverEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint; Mode: TDropMode; var Effect: LongWord; var Accept: Boolean) of object; - TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; + TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; {DataObject: IDataObject;} Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode) of object; TVTRenderOLEDataEvent = procedure(Sender: TBaseVirtualTree; const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean; var Result: HRESULT) of object; @@ -2543,6 +2544,7 @@ procedure BeginOperation; function CalculateSelectionRect(X, Y: Integer): Boolean; virtual; function CanAutoScroll: Boolean; virtual; + function CanScroll(const ClientMousePos: TPoint): Boolean; virtual; function CanShowDragImage: Boolean; virtual; procedure Change(Node: PVirtualNode); virtual; procedure ChangeScale(M, D: Integer); override; @@ -3015,6 +3017,7 @@ function GetNextNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetNextSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetNextSibling(Node: PVirtualNode): PVirtualNode; + function GetNextSiblingNoInit(Node: PVirtualNode): PVirtualNode; function GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; function GetNextVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; function GetNextVisibleSibling(Node: PVirtualNode): PVirtualNode; @@ -3033,6 +3036,7 @@ function GetPreviousNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetPreviousSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetPreviousSibling(Node: PVirtualNode): PVirtualNode; + function GetPreviousSiblingNoInit(Node: PVirtualNode): PVirtualNode; function GetPreviousVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; function GetPreviousVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; function GetPreviousVisibleSibling(Node: PVirtualNode): PVirtualNode; @@ -13858,7 +13862,7 @@ FFocusedColumn := Value; if Assigned(FFocusedNode) and not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions) then begin - if ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, True) then + if ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, not (toDisableAutoscrollHorizontal in FOptions.FAutoOptions)) then InvalidateNode(FFocusedNode); end; @@ -15036,7 +15040,8 @@ LeaveStates := [tsHint]; if [tsWheelPanning, tsWheelScrolling] * FStates = [] then begin - KillTimer(Handle, ScrollTimer); + if HandleAllocated then + KillTimer(Handle, ScrollTimer); LeaveStates := LeaveStates + [tsScrollPending, tsScrolling]; end; DoStateChange([], LeaveStates); @@ -15660,7 +15665,7 @@ if (Shift = [ssCtrlOS]) and not ActAsGrid then begin ScrollIntoView(Node, toCenterScrollIntoView in FOptions.SelectionOptions, - not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions)); + not (toDisableAutoscrollHorizontal in FOptions.FAutoOptions)); if (CharCode = VK_HOME) and not UseRightToLeftAlignment then SetOffsetX(0) else @@ -17879,7 +17884,7 @@ if hoVisible in FHeader.FOptions then Dec(Y, FHeader.Height); - if (Y > 0) and (Y < Integer(FDefaultNodeHeight)) and (FOffsetY <> 0) then + if (Y < Integer(FDefaultNodeHeight)) and (FOffsetY <> 0) then Include(Result, sdUp); //todo: probably the code below is bug due to poor timeGetTime implementation @@ -18424,7 +18429,7 @@ begin if Assigned(FOnDragDrop) then - FOnDragDrop(Self, Source, DataObject, Formats, Shift, Pt, Effect, Mode); + FOnDragDrop(Self, Source, {DataObject, }Formats, Shift, Pt, Effect, Mode); end; //---------------------------------------------------------------------------------------------------------------------- @@ -18576,7 +18581,7 @@ InvalidateNode(FFocusedNode); if (FUpdateCount = 0) and not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions) then ScrollIntoView(FFocusedNode, (toCenterScrollIntoView in FOptions.SelectionOptions) and - (MouseButtonDown * FStates = []), True); + (MouseButtonDown * FStates = []), not (toDisableAutoscrollHorizontal in FOptions.FAutoOptions)); end; // Reset range anchor if necessary. @@ -19392,7 +19397,7 @@ ClientP := ScreenToClient(P); Panning := [tsWheelPanning, tsWheelScrolling] * FStates <> []; - if IsMouseSelecting or InRect or Panning then + if IsMouseSelecting or InRect or Panning or CanScroll(ClientP) then begin DeltaX := 0; DeltaY := 0; @@ -21111,7 +21116,7 @@ if NewNode or NewColumn then begin ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, - not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions)); + not (toDisableAutoscrollHorizontal in FOptions.FAutoOptions)); DoFocusChange(FFocusedNode, FFocusedColumn); end; end; @@ -21809,7 +21814,7 @@ begin if Y < 0 then - Y := 0; + Exit(nil); AbsolutePos := Y; if Relative then @@ -24335,6 +24340,12 @@ DoCanEdit(Node, Column, Result); end; +function TBaseVirtualTree.CanScroll(const ClientMousePos: TPoint): Boolean; +// Determines whether auto scrolling can occur based on current mouse cursor position. +begin + Result := False; +end; + //---------------------------------------------------------------------------------------------------------------------- procedure TBaseVirtualTree.Clear; @@ -26446,6 +26457,22 @@ //---------------------------------------------------------------------------------------------------------------------- +function TBaseVirtualTree.GetNextSiblingNoInit(Node: PVirtualNode): PVirtualNode; + +// Returns the next sibling of Node performing no initialization. + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + Result := Result.NextSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; // Returns next node in tree, with regard to Node, which is visible. @@ -27064,6 +27091,22 @@ //---------------------------------------------------------------------------------------------------------------------- +function TBaseVirtualTree.GetPreviousSiblingNoInit(Node: PVirtualNode): PVirtualNode; + +// Get next sibling of Node, performes no initialization. + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + Result := Result.PrevSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.GetPreviousVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; // Returns the previous node in tree, with regard to Node, which is visible. @@ -29252,6 +29295,7 @@ HScrollBarVisible: Boolean; ScrolledVertically, ScrolledHorizontally: Boolean; + OffY, OffYM: Integer; begin //todo: minimize calls to ClientHeight and ClientWidth @@ -29296,7 +29340,14 @@ if Center then SetOffsetY(FOffsetY - R.Bottom + ClientHeight div 2) else - SetOffsetY(FOffsetY - R.Bottom + ClientHeight); + begin + // Leave additional space at the bottom to have scrollrect start with full row. + OffY := FOffsetY - R.Bottom + ClientHeight; + OffYM := OffY mod DefaultNodeHeight; + if OffYM <> 0 then + OffY := OffY - (DefaultNodeHeight + OffYM); + SetOffsetY(OffY); + end; // When scrolling up and the horizontal scroll appears because of the operation // then we have to move up the node the horizontal scrollbar's height too // in order to avoid that the scroll bar hides the node which we wanted to have in view. @@ -29350,10 +29401,13 @@ end else begin - if ColumnRight > ClientWidth then - NewOffset := FEffectiveOffsetX + (ColumnRight - ClientWidth) - else if ColumnLeft < Header.Columns.GetVisibleFixedWidth then - NewOffset := FEffectiveOffsetX - (Header.Columns.GetVisibleFixedWidth - ColumnLeft); + if FHeader.Columns.Count > 1 then + begin + if ColumnRight > ClientWidth then + NewOffset := FEffectiveOffsetX + (ColumnRight - ClientWidth) + else if ColumnLeft < Header.Columns.GetVisibleFixedWidth then + NewOffset := FEffectiveOffsetX - (Header.Columns.GetVisibleFixedWidth - ColumnLeft); + end; if NewOffset <> FEffectiveOffsetX then begin if UseRightToLeftAlignment then Index: include/intf/qt/vtgraphicsi.inc =================================================================== --- include/intf/qt/vtgraphicsi.inc (revision 2731) +++ include/intf/qt/vtgraphicsi.inc (working copy) @@ -284,7 +284,7 @@ // Load MM4 with 128 to allow for saturated biasing. MOV EAX, 128 - DB $0F, $6E, AlphaBlendLineConstant$E0 /// MOVD MM4, EAX + DB $0F, $6E, $E0 /// MOVD MM4, EAX DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4 DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4 Index: units/carbon/fakemmsystem.pas =================================================================== --- units/carbon/fakemmsystem.pas (revision 2731) +++ units/carbon/fakemmsystem.pas (working copy) @@ -15,6 +15,9 @@ implementation +uses + LCLIntf; + function timeBeginPeriod(x1: DWord): DWord; begin @@ -26,12 +29,8 @@ end; function timeGetTime: DWORD; -var - ATime: TSystemTime; begin - //todo: properly implement - GetLocalTime(ATime); - Result := ATime.MilliSecond; + Result := GetTickCount; end; end. Index: units/qt/fakemmsystem.pas =================================================================== --- units/qt/fakemmsystem.pas (revision 2731) +++ units/qt/fakemmsystem.pas (working copy) @@ -15,6 +15,9 @@ implementation +uses + LCLIntf; + function timeBeginPeriod(x1: DWord): DWord; begin @@ -26,12 +29,8 @@ end; function timeGetTime: DWORD; -var - ATime: TSystemTime; begin - //todo: properly implement - GetLocalTime(ATime); - Result := ATime.MilliSecond; + Result := GetTickCount; end; end. Index: units/win32/virtualpanningwindow.pas =================================================================== --- units/win32/virtualpanningwindow.pas (revision 2731) +++ units/win32/virtualpanningwindow.pas (working copy) @@ -41,9 +41,10 @@ PanningObject:=TVirtualPanningWindow(GetWindowLongPtrW(Window,GWL_USERDATA)); if Assigned(PanningObject) then PanningObject.HandlePaintMessage; + Result := 0; end else - DefWindowProc(Window,Msg,WPara,LPara); + Result := DefWindowProc(Window,Msg,WPara,LPara); end; var @@ -87,8 +88,7 @@ with Position do FHandle := CreateWindowEx(WS_EX_TOOLWINDOW, PanningWindowClass.lpszClassName, nil, WS_POPUP, X - 16, Y - 16, 32, 32, OwnerHandle, 0, HInstance, nil); - //todo use SetWindowLongPtr later - SetWindowLong(FHandle,GWL_USERDATA,PtrInt(Self)); + SetWindowLongPtr(FHandle,GWL_USERDATA,LONG_PTR(Self)); FImage := TBitmap.Create; end;