瀏覽代碼

FIX: Bug [0002073] No scroll delay when using drag and drop outside double commander
FIX: Bug [0002072] Wrong panel scrolling when using drag and drop inside double commander #2

Alexander Koblov 7 年之前
父節點
當前提交
ef29a144a7
共有 4 個文件被更改,包括 125 次插入53 次删除
  1. 36 17
      src/fileviews/ubrieffileview.pas
  2. 24 3
      src/fileviews/ucolumnsfileview.pas
  3. 18 1
      src/fileviews/ufileviewwithgrid.pas
  4. 47 32
      src/fileviews/uthumbfileview.pas

+ 36 - 17
src/fileviews/ubrieffileview.pas

@@ -22,6 +22,7 @@ type
     procedure UpdateView; override;
     procedure CalculateColRowCount; override;
     procedure CalculateColumnWidth; override;
+    procedure DoMouseMoveScroll(X, Y: Integer);
     function  CellToIndex(ACol, ARow: Integer): Integer; override;
     procedure IndexToCell(Index: Integer; out ACol, ARow: Integer); override;
   protected
@@ -29,6 +30,7 @@ type
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
     function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
+    procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); override;
   public
     constructor Create(AOwner: TComponent; AParent: TWinControl); override;
     procedure DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); override;
@@ -177,6 +179,32 @@ begin
     end;
 end;
 
+procedure TBriefDrawGrid.DoMouseMoveScroll(X, Y: Integer);
+var
+  TickCount: QWord;
+  AEvent: SmallInt;
+begin
+  TickCount := GetTickCount64;
+
+  if X < 25 then
+    AEvent := SB_LINEUP
+  else if X > ClientWidth - 25 then
+    AEvent := SB_LINEDOWN
+  else begin
+    Exit;
+  end;
+
+  if (FLastMouseMoveTime = 0) then
+    FLastMouseMoveTime := TickCount
+  else if (FLastMouseScrollTime = 0) then
+    FLastMouseScrollTime := TickCount
+  else if (TickCount - FLastMouseMoveTime > 200) and (TickCount - FLastMouseScrollTime > 50) then
+  begin
+    Scroll(LM_HSCROLL, AEvent);
+    FLastMouseScrollTime := GetTickCount64;
+  end;
+end;
+
 function TBriefDrawGrid.CellToIndex(ACol, ARow: Integer): Integer;
 begin
   if (ARow < 0) or (ARow >= RowCount) or (ACol <  0) or (ACol >= ColCount) then Exit(-1);
@@ -306,25 +334,9 @@ begin
 end;
 
 procedure TBriefDrawGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
-  procedure Scroll(ScrollCode: SmallInt);
-  var
-    Msg: TLMHScroll;
-  begin
-    Msg.Msg := LM_HSCROLL;
-    Msg.ScrollCode := ScrollCode;
-    Msg.SmallPos := 1; // How many lines scroll
-    Msg.ScrollBar := Handle;
-    Dispatch(Msg);
-  end;
 begin
   inherited MouseMove(Shift, X, Y);
-  if DragManager.IsDragging or FBriefView.IsMouseSelecting then
-  begin
-    if X < 25 then
-      Scroll(SB_LINEUP)
-    else if X > ClientWidth - 25 then
-      Scroll(SB_LINEDOWN);
-  end;
+  if FBriefView.IsMouseSelecting then DoMouseMoveScroll(X, Y);
 end;
 
 function TBriefDrawGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
@@ -372,6 +384,13 @@ begin
     Result := True; // Handled
 end;
 
+procedure TBriefDrawGrid.DragOver(Source: TObject; X, Y: Integer;
+  State: TDragState; var Accept: Boolean);
+begin
+  inherited DragOver(Source, X, Y, State, Accept);
+  DoMouseMoveScroll(X, Y);
+end;
+
 constructor TBriefDrawGrid.Create(AOwner: TComponent; AParent: TWinControl);
 begin
   FBriefView:= AParent as TBriefFileView;

+ 24 - 3
src/fileviews/ucolumnsfileview.pas

@@ -32,6 +32,8 @@ type
   TDrawGridEx = class(TDrawGrid)
   private
     FMouseDownY: Integer;
+    FLastMouseMoveTime: QWord;
+    FLastMouseScrollTime: QWord;
     ColumnsView: TColumnsFileView;
 
     function GetGridHorzLine: Boolean;
@@ -1950,6 +1952,9 @@ end;
 
 procedure TDrawGridEx.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
 begin
+  FLastMouseMoveTime := 0;
+  FLastMouseScrollTime := 0;
+
   if ColumnsView.IsLoadingFileList then Exit;
 {$IFDEF LCLGTK2}
   // Workaround for two doubleclicks being sent on GTK.
@@ -2079,13 +2084,29 @@ procedure TDrawGridEx.DoMouseMoveScroll(X, Y: Integer);
     Dispatch(Msg);
   end;
 
+var
+  TickCount: QWord;
+  AEvent: SmallInt;
 begin
+  TickCount := GetTickCount64;
+
   if Y < DefaultRowHeight then
-    Scroll(SB_LINEUP)
+    AEvent := SB_LINEUP
   else if (Y > ClientHeight - DefaultRowHeight) and (Y - 1 > FMouseDownY) then
+    AEvent := SB_LINEDOWN
+  else begin
+    Exit;
+  end;
+
+  if (FLastMouseMoveTime = 0) then
+    FLastMouseMoveTime := TickCount
+  else if (FLastMouseScrollTime = 0) then
+    FLastMouseScrollTime := TickCount
+  else if (TickCount - FLastMouseMoveTime > 200) and (TickCount - FLastMouseScrollTime > 50) then
   begin
-    FMouseDownY := -1;
-    Scroll(SB_LINEDOWN);
+    Scroll(AEvent);
+    FLastMouseScrollTime := GetTickCount64;
+    if (AEvent = SB_LINEDOWN) then FMouseDownY := -1;
   end;
 end;
 

+ 18 - 1
src/fileviews/ufileviewwithgrid.pas

@@ -17,8 +17,11 @@ type
 
   TFileViewGrid = class(TDrawGrid)
   protected
+    FLastMouseMoveTime: QWord;
+    FLastMouseScrollTime: QWord;
     FFileView: TFileViewWithGrid;
   protected
+    procedure Scroll(Message: Cardinal; ScrollCode: SmallInt);
     {$IF lcl_fullversion < 1080003}
     function SelectCell(aCol, aRow: Integer): Boolean; override;
     {$ENDIF}
@@ -109,7 +112,7 @@ type
 implementation
 
 uses
-  LCLIntf, LCLType, LCLProc, LazUTF8, Math,
+  LCLIntf, LCLType, LCLProc, LazUTF8, Math, LMessages,
   DCStrUtils, uGlobs, uPixmapManager, uKeyboard,
   uDCUtils, fMain,
   uFileFunctions;
@@ -186,6 +189,17 @@ begin
   inherited KeyDown(Key, Shift);
 end;
 
+procedure TFileViewGrid.Scroll(Message: Cardinal; ScrollCode: SmallInt);
+var
+  Msg: TLMScroll;
+begin
+  Msg.Msg := Message;
+  Msg.ScrollCode := ScrollCode;
+  Msg.SmallPos := 1; // How many lines scroll
+  Msg.ScrollBar := Handle;
+  Dispatch(Msg);
+end;
+
 {$IF lcl_fullversion < 1080003}
 // Workaround for Lazarus issue 31942.
 function TFileViewGrid.SelectCell(aCol, aRow: Integer): Boolean;
@@ -227,6 +241,9 @@ end;
 procedure TFileViewGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
   Y: Integer);
 begin
+  FLastMouseMoveTime := 0;
+  FLastMouseScrollTime := 0;
+
   if FFileView.IsLoadingFileList then Exit;
 
 {$IF DECLARED(lcl_fullversion) and (lcl_fullversion >= 093100)}

+ 47 - 32
src/fileviews/uthumbfileview.pas

@@ -56,10 +56,12 @@ type
     procedure KeyDown(var Key : Word; Shift : TShiftState); override;
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); override;
   protected
     procedure UpdateView; override;
     procedure CalculateColRowCount; override;
     procedure CalculateColumnWidth; override;
+    procedure DoMouseMoveScroll(X, Y: Integer);
     function  CellToIndex(ACol, ARow: Integer): Integer; override;
     procedure IndexToCell(Index: Integer; out ACol, ARow: Integer); override;
   public
@@ -241,40 +243,9 @@ begin
 end;
 
 procedure TThumbDrawGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
-const
-  LastPos: Integer = 0;
-
-  procedure Scroll(ScrollCode: SmallInt);
-  var
-    Msg: TLMVScroll;
-  begin
-    Msg.Msg := LM_VSCROLL;
-    Msg.ScrollCode := ScrollCode;
-    Msg.SmallPos := 1; // How many lines scroll
-    Msg.ScrollBar := Handle;
-    Dispatch(Msg);
-  end;
-
-var
-  Delta: Integer;
 begin
   inherited MouseMove(Shift, X, Y);
-  if DragManager.IsDragging or FThumbView.IsMouseSelecting then
-  begin
-    // Scroll at each 8 pixel mouse move
-    if (Abs(LastPos - Y) > 8) then
-    begin
-      LastPos:= Y;
-      Delta := DefaultRowHeight div 3;
-      if Y < Delta then
-        Scroll(SB_LINEUP)
-      else if (Y > ClientHeight - Delta) and (Y - FMouseDownY > 8) then
-      begin
-        FMouseDownY := -1;
-        Scroll(SB_LINEDOWN);
-      end;
-    end;
-  end;
+  if FThumbView.IsMouseSelecting then DoMouseMoveScroll(X, Y);
 end;
 
 procedure TThumbDrawGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
@@ -283,6 +254,13 @@ begin
   inherited MouseDown(Button, Shift, X, Y);
 end;
 
+procedure TThumbDrawGrid.DragOver(Source: TObject; X, Y: Integer;
+  State: TDragState; var Accept: Boolean);
+begin
+  inherited DragOver(Source, X, Y, State, Accept);
+  DoMouseMoveScroll(X, Y);
+end;
+
 procedure TThumbDrawGrid.UpdateView;
 var
   I: Integer;
@@ -384,6 +362,43 @@ begin
   DefaultColWidth:= gThumbSize.cx + 4;
 end;
 
+procedure TThumbDrawGrid.DoMouseMoveScroll(X, Y: Integer);
+const
+  LastPos: Integer = 0;
+var
+  Delta: Integer;
+  TickCount: QWord;
+  AEvent: SmallInt = -1;
+begin
+  TickCount := GetTickCount64;
+
+  // Scroll at each 8 pixel mouse move
+  if (Abs(LastPos - Y) > 8) then
+  begin
+    LastPos := Y;
+    Delta := DefaultRowHeight div 3;
+    if Y < Delta then
+      AEvent := SB_LINEUP
+    else if (Y > ClientHeight - Delta) and (Y - FMouseDownY > 8) then
+    begin
+      AEvent := SB_LINEDOWN;
+    end;
+  end;
+
+  if (AEvent = -1) then Exit;
+
+  if (FLastMouseMoveTime = 0) then
+    FLastMouseMoveTime := TickCount
+  else if (FLastMouseScrollTime = 0) then
+    FLastMouseScrollTime := TickCount
+  else if (TickCount - FLastMouseMoveTime > 200) and (TickCount - FLastMouseScrollTime > 50) then
+  begin
+    Scroll(LM_VSCROLL, AEvent);
+    FLastMouseScrollTime := GetTickCount64;
+    if (AEvent = SB_LINEDOWN) then FMouseDownY := -1;
+  end;
+end;
+
 function TThumbDrawGrid.CellToIndex(ACol, ARow: Integer): Integer;
 begin
   if (ARow < 0) or (ARow >= RowCount) or (ACol <  0) or (ACol >= ColCount) then Exit(-1);