Форум программистов [Powered by Invision Power Board]

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls, Grids, DBGrids;

type
  TDBGrid = class(DBGrids.TDBGrid)
    procedure WMNCCalcSize(var Msg: TMessage);
      message WM_NCCALCSIZE;
  end;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Table1: TTable;
    procedure FormCreate(Sender: TObject);
    procedure MyScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure _AfterScroll(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  M_Scroll : TScrollBar;

implementation

{$R *.dfm}

var NoMove:Boolean;

procedure TDBGrid.WMNCCalcSize(var Msg: TMessage);
const
  Scrollstyles = WS_VSCROLL;// OR WS_HSCROLL;
var
  Style: Integer;
begin
  Style := GetWindowLong(Handle, GWL_STYLE);
  if (Style and Scrollstyles) <> 0 then
    SetWindowLong(Handle, GWL_STYLE, Style and not Scrollstyles);
  inherited;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 M_Scroll.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Table1.Close;
 Table1.Open;
 Table1.Last;
 DBGrid1.Ctl3D:=False;
 M_Scroll:=TScrollBar.Create(Self);
 With M_Scroll do
 Begin
    Parent:=Self;
    Visible:=True;
    Enabled:=True;
    Ctl3D:=False;
    Kind:= sbVertical;
    Left:=DbGrid1.Left+DBGrid1.Width-1;
    Top:=DbGrid1.Top+1;
    Height:=DbGrid1.Height-1;
    TabStop:=False;
    Max:=Table1.RecordCount;
    OnScroll:=MyScroll;
 End;
 Table1.AfterScroll:=_AfterScroll;
 Table1.First;
end;

procedure TForm1.MyScroll(Sender: TObject; ScrollCode: TScrollCode;
  var ScrollPos: Integer);
Const PageSize = 8;
var i, Pp  : LongInt;
begin
With Table1 do
Begin
  Pp:=RecNo;
  NoMove:=True;
  DisableControls;
  if ScrollCode  in [scLineUp] then Prior;
  if ScrollCode  in [scLineDown] then Next;
  if ScrollCode  in [scTop] then First;
  if ScrollCode  in [scBottom] then Last;
  if ScrollCode  in [scPageUp] then
    for i:=1 to PageSize do Prior;
  if ScrollCode  in [scPageDown] then
    for i:=1 to PageSize do Next;
  if ScrollCode  in [scPosition] then
   begin
    if pp < ScrollPos then
     for i := pp to ScrollPos do Next;
    if pp > ScrollPos then
     for i := ScrollPos to pp do Prior;
    end;
    EnableControls;
    NoMove:=False;
 end;//With
end;

procedure TForm1._AfterScroll(DataSet: TDataSet);
begin
 if NOT NoMove then
   M_Scroll.Position:=DataSet.RecNo;
end;

end.