mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-24 13:28:13 +02:00
IDE: Scroll Procedure List with mouse-wheel always. Issue #38477, patch by Alexey Torgashin.
This commit is contained in:
parent
677b96455e
commit
e4e8a05a64
@ -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
|
||||||
|
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user