IDE: Scroll Procedure List with mouse-wheel always. Issue #38477, patch by Alexey Torgashin.

This commit is contained in:
Juha 2021-11-18 20:06:59 +02:00
parent 677b96455e
commit e4e8a05a64
2 changed files with 14 additions and 2 deletions

View File

@ -13,7 +13,7 @@ object ProcedureListForm: TProcedureListForm
OnResize = FormResize OnResize = FormResize
OnShow = FormShow OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '1.9.0.0' LCLVersion = '2.3.0.0'
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 21 Height = 21
@ -234,6 +234,7 @@ object ProcedureListForm: TProcedureListForm
TabOrder = 3 TabOrder = 3
OnDblClick = SGDblClick OnDblClick = SGDblClick
OnDrawCell = SGDrawCell OnDrawCell = SGDrawCell
OnMouseWheel = SGMouseWheel
OnSelectCell = SGSelectCell OnSelectCell = SGSelectCell
end end
end end

View File

@ -94,6 +94,8 @@ type
procedure SGDblClick(Sender: TObject); procedure SGDblClick(Sender: TObject);
procedure SGDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect; procedure SGDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect;
{%H-}aState: TGridDrawState); {%H-}aState: TGridDrawState);
procedure SGMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure SGSelectCell(Sender: TObject; {%H-}aCol, aRow: Integer; procedure SGSelectCell(Sender: TObject; {%H-}aCol, aRow: Integer;
var {%H-}CanSelect: Boolean); var {%H-}CanSelect: Boolean);
procedure SomethingChange(Sender: TObject); procedure SomethingChange(Sender: TObject);
@ -311,13 +313,22 @@ begin
end; end;
end; end;
procedure TProcedureListForm.SGMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
NLines: integer;
begin
NLines := -WheelDelta * 3 div 120;
SG.TopRow := Max(SG.FixedRows, Min(SG.RowCount - 1, SG.TopRow + NLines));
Handled := True;
end;
procedure TProcedureListForm.SGSelectCell(Sender: TObject; aCol, aRow: Integer; procedure TProcedureListForm.SGSelectCell(Sender: TObject; aCol, aRow: Integer;
var CanSelect: Boolean); var CanSelect: Boolean);
var var
rowObject: TGridRowObject; rowObject: TGridRowObject;
begin begin
rowObject := TGridRowObject(TStringGrid(Sender).Rows[aRow].Objects[0]); rowObject := TGridRowObject(TStringGrid(Sender).Rows[aRow].Objects[0]);
if Assigned(rowObject) then if Assigned(rowObject) then
begin begin
StatusBar.Panels[0].Text := rowObject.FullProcedureName; StatusBar.Panels[0].Text := rowObject.FullProcedureName;