LCL: Move CustomGrid column/row by mouse drag outside the client area. Merge request !64 by Petr Kristan.

lcl/grids.pas

@@ -44,7 +44,7 @@ uses
 {$ifdef WINDOWS}
   ,messages, imm
 {$endif}
-  ;
+  ,extctrls;
 
 const
   //GRIDFILEVERSION = 1; // Original
@@ -718,6 +718,22 @@ type
 
     TGridCursorState = (gcsDefault, gcsColWidthChanging, gcsRowHeightChanging, gcsDragging);
 
+    TGridScrollerDoScroll = procedure (Dir: TPoint) of object;
+
+    { TGridScroller }
+
+    TGridScroller = class
+    private
+      Dir: TPoint;
+      Timer: TTimer;
+      Callback: TGridScrollerDoScroll;
+      procedure TimerTick(Sender: TObject);
+    public
+      constructor Create(DoScroll: TGridScrollerDoScroll);
+      destructor Destroy; override;
+      procedure Start(ADir: TPoint);
+    end;
+
 type
 
   { TCustomGrid }
@@ -827,6 +843,7 @@ type
     FSavedHint: String;
     FCellHintPriority: TCellHintPriority;
     FOnGetCellHint: TGetCellHintEvent;
+    FScroller: TGridScroller;
     procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
     procedure CacheVisibleGrid;
     procedure CancelSelection;
@@ -848,6 +865,8 @@ type
     procedure SetAltColorStartNormal(const AValue: boolean);
     procedure SetFlat(const AValue: Boolean);
     procedure SetFocusRectVisible(const AValue: Boolean);
+    procedure ScrollerDoScroll(Dir: TPoint);
+    procedure SetScroller(Dir: TPoint);
     procedure SetTitleImageList(const AValue: TImageList);
     procedure SetTitleImageListWidth(const aTitleImageListWidth: Integer);
     procedure SetTitleFont(const AValue: TFont);
@@ -2192,6 +2211,34 @@ begin
     result := InRange(AValue, AMax, AMin);
 end;
 
+{ TGridScroller }
+
+constructor TGridScroller.Create(DoScroll: TGridScrollerDoScroll);
+begin
+  Callback := DoScroll;
+  Timer := TTimer.Create(nil);
+  Timer.OnTimer := @TimerTick;
+  Timer.Interval := 200;
+end;
+
+destructor TGridScroller.Destroy;
+begin
+  FreeAndNil(Timer);
+  inherited Destroy;
+end;
+
+procedure TGridScroller.TimerTick(Sender: TObject);
+begin
+  if Assigned(Callback) then
+    Callback(Dir);
+end;
+
+procedure TGridScroller.Start(ADir: TPoint);
+begin
+  Dir := ADir;
+  Timer.Enabled := True;
+end;
+
 { TCustomGrid }
 
 function TCustomGrid.GetRowHeights(Arow: Integer): Integer;
@@ -5021,6 +5068,8 @@ begin
     {$ENDIF}
   end;
   inherited WndProc(TheMessage);
+  if not (FGridState in [gsColMoving, gsRowMoving]) then //For sure if MouseUp event is lost
+    FreeAndNil(FScroller);
 end;
 
 procedure TCustomGrid.CreateWnd;
@@ -6186,6 +6235,32 @@ begin
     RestoreCursor;
 end;
 
+procedure TCustomGrid.ScrollerDoScroll(Dir: TPoint);
+var
+  OldTopLeft: TPoint;
+begin
+  OldTopLeft := FTopLeft;
+  if ((Dir.X < 0) and (FTopLeft.X > FFixedCols)) or ((Dir.X > 0) and (FGCache.FullVisibleGrid.Right + FixedCols < ColCount)) then
+    Inc(FTopLeft.X, Dir.X);
+  if ((Dir.Y < 0) and (FTopLeft.Y > FFixedRows)) or ((Dir.Y > 0) and (FGCache.FullVisibleGrid.Bottom + FixedRows < RowCount)) then
+    Inc(FTopLeft.Y, Dir.Y);
+  if not PointsEqual(FTopleft, OldTopLeft) then begin
+    FMoveLast := Point(-1, -1);
+    doTopleftChange(False);
+  end;
+end;
+
+procedure TCustomGrid.SetScroller(Dir: TPoint);
+begin
+  if (Dir.X = 0) and (Dir.Y = 0) then begin
+    FreeAndNil(FScroller);
+  end else begin
+    if not Assigned(FScroller) then
+      FScroller := TGridScroller.Create(@ScrollerDoScroll);
+    FScroller.Start(Dir);
+  end;
+end;
+
 procedure TCustomGrid.doColMoving(X, Y: Integer);
 var
   CurCell: TPoint;
@@ -6220,6 +6295,13 @@ begin
       {$endif}
     end;
   end;
+
+  if (X > FGCache.MaxClientXY.X) or (X > FGCache.ClientWidth  + GetBorderWidth) then
+    SetScroller(Point(1, 0))
+  else if X < FGCache.FixedWidth then
+    SetScroller(Point(-1, 0))
+  else
+    SetScroller(Point(0, 0));
 end;
 
 procedure TCustomGrid.doRowMoving(X, Y: Integer);
@@ -6251,6 +6333,13 @@ begin
       Invalidate;
     end;
   end;
+
+  if (Y > FGCache.MaxClientXY.Y) or (Y > FGCache.ClientHeight  + GetBorderWidth) then
+    SetScroller(Point(0, 1))
+  else if Y < FGCache.FixedHeight then
+    SetScroller(Point(0, -1))
+  else
+    SetScroller(Point(0, 0));
 end;
 
 
@@ -7025,6 +7114,7 @@ begin
       begin
         //DebugLn('Move Col From ',Fsplitter.x,' to ', FMoveLast.x);
         RestoreCursor;
+        FreeAndNil(FScroller);
 
         if FMoveLast.X>=0 then
           DoOPMoveColRow(True, FGCache.ClickCell.X, FMoveLast.X)
@@ -9982,6 +10072,7 @@ begin
   FreeThenNil(FRows);
   FreeThenNil(FTitleFont);
   FEditor := nil;
+  FreeAndNil(FScroller);
   inherited Destroy;
 end;