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.