[SOLVED] DBGrid - Center selected row.
lazarus / 16-Databases

----------------------------------------------------------------------
pcurtis · 2021-11-24 07:40

I have a DBGrid that can show 7 rows. The dataset has 1000 rows.

How can I center the selected row in the center of the grid?
(If RecNo > 3 and RecNo < 997)

----------------------------------------------------------------------
Zvoni · 2021-11-24 09:19

Maybe with some math using TopRow-Property?
along the lines of
Grid.TopRow:=IndexOfSelectedRow - 3

You would have to catch the Edge-cases of course (SelectedRow Index is
2, 2-3 is -1, setting TopRow to -1 = KABOOM)

Nota Bene: No idea if my proposal works, since i have no clue to how
TopRow works, but it was the one Property catching my eye

----------------------------------------------------------------------
pcurtis · 2021-11-24 10:27

TopRow is not a property of TDBGrid

or after a

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i   iTemp :=
ZQuery1['fnIDX'];   MyQuery.ExecSQL; // update recordset 
ZQuery1.Close;  ZQuery1.Open;  ZQuery1.Locate('fnIDX', iTemp, []); 
put the DBGrid back to the same place / position as before the update.

----------------------------------------------------------------------
Zvoni · 2021-11-24 10:36

Quote from: pcurtis on November 24, 2021, 11:27:18 amTopRow is not a
property of TDBGrid
Argg... missed that.
It's protected in TCustomGrid.
No idea how to make a protected Property in Ancestor to public in the
Grandkid

----------------------------------------------------------------------
Handoko · 2021-11-24 13:48

If you meant you want the DBGrid to scroll to certain position showing
certain record number, then this maybe is what you want:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, dbf,
Forms, Controls, Dialogs, DBGrids, StdCtrls, Spin, DB; type   { TForm1
}   TForm1 = class(TForm)    Button1: TButton;    Dbf1: TDbf;   
DBGrid1: TDBGrid;    Label1: TLabel;    speGoto: TSpinEdit;    speTop:
TSpinEdit;    procedure Button1Click(Sender: TObject);    procedure
FormCreate(Sender: TObject);  private    function  RandomChars(Count:
Integer): string;    procedure GenerateDataFile;    procedure
GotoRow(RowNo, TopPadding: Integer);  end; var  Form1:
TForm1; implementation Const  DataFileName = 'Data.dbf'; {$R *.lfm} {
TForm1 } procedure TForm1.FormCreate(Sender: TObject);var 
aDataSource: TDataSource;begin   // Connection and data  aDataSource 
      := TDataSource.Create(Self);  aDataSource.DataSet := Dbf1; 
Dbf1.FilePathFull   := ExtractFileDir(ParamStr(0));  Dbf1.TableName  
  := DataFileName;  if not(FileExists(DataFileName)) then   
GenerateDataFile;  Dbf1.Active        := True;  DBGrid1.DataSource :=
aDataSource;   // Appearance  Constraints.MinHeight := 240; 
Constraints.MinWidth  := 320;  DBGrid1.Anchors       := [akLeft,
akRight, akTop, akBottom];  Button1.Anchors       := [akLeft,
akBottom];  speGoto.MaxValue      := Dbf1.ExactRecordCount; 
speGoto.Anchors       := [akLeft, akBottom];  speTop.MaxValue       :=
Dbf1.ExactRecordCount;  speTop.Anchors        := [akLeft,
akBottom]; end; procedure TForm1.Button1Click(Sender: TObject);begin 
GotoRow(speGoto.Value, speTop.Value);end; function
TForm1.RandomChars(Count: Integer): string;var  S: string;  i:
Integer;begin  if Count < 1  then Count := 1;  if Count > 20 then
Count := 20;  S := '';  for i := 1 to Count do    S := S +
chr(Ord('a')+Random(26));  Result := S;end; procedure
TForm1.GenerateDataFile;const  TotalItems = 1000;var  i:
Integer;begin  with Dbf1 do  begin    FieldDefs.Add('ID', ftInteger,
0, True);    FieldDefs.Add('DATA', ftString, 8, True);   
CreateTable;    Open;      for i := 1 to TotalItems do      begin    
  Append;        FieldByName('ID').AsInteger  := i;       
FieldByName('DATA').AsString := RandomChars(8);        Post;     
end;    Close;  end;end; procedure TForm1.GotoRow(RowNo, TopPadding:
Integer);var  Total:       Integer;  VisibleRows: Integer;  Key:     
  Word;  Adjust:      Integer;  i:           Integer;begin   Total :=
Dbf1.ExactRecordCount;  if Total <= 0 then Exit;   // Get visible row
count  VisibleRows := 0;  for i := 1 to Total do    if
DBGrid1.IsCellVisible(1, i) then      Inc(VisibleRows);  if
VisibleRows <= 0 then Exit;   // Send Ctrl+Home keyboard signal to the
grid  Key := 36;  DBGrid1.EditorKeyDown(Self, Key, [ssCtrl]);   //
Send Arrow_Down keyboard signal to the grid  for i := 1 to RowNo-1 do 
begin    Key := 40;    DBGrid1.EditorKeyDown(Self, Key, []);  end;  
// Send arrow up and down signals to get position for the top padding 
if TopPadding >= VisibleRows + 1 then Exit;  Adjust := VisibleRows -
TopPadding - 1;  if RowNo + Adjust > Total then    Adjust := Total -
RowNo;  for i := 1 to Adjust do  begin    Key := 40;   
DBGrid1.EditorKeyDown(Self, Key, []);  end;  for i := 1 to Adjust do 
begin    Key := 38;    DBGrid1.EditorKeyDown(Self, Key, []); 
end; end; end.
First time running the program, a dbf with 1000 records will be
created, see line #86The grid will try to scroll to position the RecNo
to have the top padding as the value provided but it may fail on some
casesTopPadding = 0 means to show the wanted RecNo on the first row in
the gridThe trick to make the grid to scroll automatically is in the
GotoRow procedure, see line #109Warning:
Tested on Lazarus 2.0.10 GTK2 Linux, it may or may not work on future
versions of Lazarus and it is may not work on other OSes.

----------------------------------------------------------------------
Handoko · 2021-11-24 14:09

Quote from: Zvoni on November 24, 2021, 11:36:54 amQuote from: pcurtis
on November 24, 2021, 11:27:18 amTopRow is not a property of TDBGrid
It's protected in TCustomGrid.

Not a problem, we can force a protected property to be used on its
descendants.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i type 
TMyGrid = class(TCustomGrid)    public      property TopRow; 
end; procedure TForm1.Button1Click(Sender: TObject);begin 
TMyGrid(DBGrid1).TopRow := 5;end;
Only warning but compile-able. Unfortunately, due to some unknown
reason it does not work.

----------------------------------------------------------------------
Zvoni · 2021-11-24 14:13

Quote from: Handoko on November 24, 2021, 03:09:51 pmNot a problem, we
can force a protected property to be used on its descendants.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i type 
TMyGrid = class(TCustomGrid)    public      property TopRow; 
end; procedure TForm1.Button1Click(Sender: TObject);begin 
TMyGrid(DBGrid1).TopRow := 5;end;
Only warning but compile-able. Unfortunately, due to some unknown
reason it does not work.
In Singlestep-Mode, when assigning (your Line 9), can you step into
the (protected) setter of the Property?

----------------------------------------------------------------------
Handoko · 2021-11-24 14:16

Just tried it, yes I can step into it. Unfortunately the code is too
advanced, I am not able to digest it.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TCustomGrid.TryScrollTo(aCol, aRow: Integer; ClearColOff, 
ClearRowOff: Boolean);var  TryTL: TPoint;  NewCol,NewRow: Integer; 
TLChange: Boolean;begin  TryTL:=ScrollGrid(False,aCol, aRow); 
TLChange := not PointIgual(TryTL, FTopLeft);  if TLChange  or (not
PointIgual(TryTL, Point(aCol, aRow)) and (goSmoothScroll in Options)) 
or (ClearColOff and (FGCache.TLColOff<>0))  or (ClearRowOff and
(FGCache.TLRowOff<>0)) then  begin    NewCol := TryTL.X - FTopLeft.X +
Col;    NewRow := TryTL.Y - FTopLeft.Y + Row;    FTopLeft:=TryTL;   
if ClearColOff then      FGCache.TLColOff := 0;    if ClearRowOff
then      FGCache.TLRowOff := 0;    if (aCol>TryTL.X) and
(goSmoothScroll in Options) then      FGCache.TLColOff :=
FGCache.MaxTLOffset.X;    if (aRow>TryTL.Y) and (goSmoothScroll in
Options) then      FGCache.TLRowOff := FGCache.MaxTLOffset.Y;   
{$ifdef dbgscroll}    DebugLn('TryScrollTo: TopLeft=%s NewCol=%d
NewRow=%d',      [dbgs(FTopLeft), NewCol, NewRow]);    {$endif}    //
To-Do: move rect with ScrollBy_WS and invalidate only new (not
scrolled) rects    if TLChange then      doTopleftChange(False)   
else      VisualChange;    if goScrollKeepVisible in Options then    
MoveNextSelectable(False, NewCol, NewRow);  end;end;

----------------------------------------------------------------------
pcurtis · 2021-11-24 18:45

@Handoko PERFECT

----------------------------------------------------------------------
pcurtis · 2021-11-25 12:05

I made this custom DBGrid based on your supplied code

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
MyDBGrid; {$mode objfpc}{$H+} interface uses  Classes, SysUtils,
LResources, Forms, Windows, Controls, Graphics, StdCtrls, ExtCtrls, 
Dialogs, DBGrids, Grids; type  TMyHackedGrid = class(TDBGrid); 
TMyDBGrid = class(TDBGrid)  private   protected   public    function
GetSelectedRow : Integer;    function GetVisibleRowCount : Integer;  
procedure ScrollTo(aIndexField : String; aValue : Integer; aOffset :
Integer);    constructor Create(AOwner : TComponent); override;   
destructor Destroy; override;  published   end; procedure
Register; implementation {$R mydbgrid.res} constructor
TMyDBGrid.Create(AOwner : TComponent);begin  inherited
Create(AOwner);  AlternateColor := clMoneyGreen;  Color := clCream; 
Options := Options + [dgRowSelect];  Options := Options -
[dgEditing];  AutoFillColumns := true;end; destructor
TMyDBGrid.Destroy;begin  inherited Destroy;end; function
TMyDBGrid.GetSelectedRow : Integer;begin  Result :=
TMyHackedGrid(Self).Row;end; function TMyDBGrid.GetVisibleRowCount :
Integer;begin  Result :=
TMyHackedGrid(Self).VisibleRowCount;end; procedure
TMyDBGrid.ScrollTo(aIndexField : String; aValue : Integer; aOffset :
Integer);var  iTemp : Integer;begin  if (not Assigned(DataSource)) or 
   (DataSource.DataSet.Active = False) or   
 (DataSource.DataSet.RecordCount = 0) then       exit;  
DataSource.DataSet.First;  DataSource.DataSet.Locate(aIndexField,
aValue, []);   for iTemp := 1 to aOffset do  begin   
PostMessage(Self.Handle, WM_KEYDOWN, VK_UP, 0);  end;   for iTemp := 1
to aOffset do  begin    PostMessage(Self.Handle, WM_KEYDOWN, VK_DOWN,
0);  end;end; procedure Register;begin 
RegisterComponents('Misc',[TMyDBGrid]);end; end.

----------------------------------------------------------------------
Handoko · 2021-11-25 13:24

That looks good. Unfortunately, I cannot test it because it depends on
Windows unit.

----------------------------------------------------------------------
lainz · 2021-11-25 14:12

Windows unit can not be replaced with LCLType, at some extent?

----------------------------------------------------------------------
wp · 2021-11-25 14:22

Quote from: Handoko on November 25, 2021, 02:24:20 pmThat looks good.
Unfortunately, I cannot test it because it depends on Windows unit.
Replace unit Windows by LCLType and LCLIntf. And replace
WM_KEYDOWN/WM_KEYUP by LM_KEYDOWN/LM_KEYUP.

----------------------------------------------------------------------
Sieben · 2021-11-27 20:47

Based on this here idea by 'Soner' I ended up with that little sketch
included below that seems to do quite a good job in keeping the
selected row of a DBGrid centered. Of course that has to be supended
when the user clicks a certain record, but snaps in again asap. And I
could not get the grid to agree that the 'natural' center position
with an even number of data rows ist the last line of the upper half
instead of the first one of the lower. Solution is to make sure that
your grid is odd...