Mause Orta tuşu İle Dbgrid Scroll unu hareket ettirme

[vedatkaba]

Herkese merhabalar herkese kolay gelsin..Biraz araştırma biraz soruşturmadan sonra böle bir şey meydana çıktı.

Kod: Tümünü seç

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Table1: TTable;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure DBGridMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TWheelDBGrid = class(TDBGrid)
  public
    property OnMouseWheel;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TWheelDBGrid(DBGrid1).OnMouseWheel := DBGridMouseWheel;
end;

function GetNumScrollLines: Integer;
begin
  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);
end;

procedure TForm1.DBGridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Direction: Shortint;
begin
  Direction := 1;
  if WheelDelta = 0 then
    Exit
  else if WheelDelta > 0 then
    Direction := -1;

  with TDBGrid(Sender) do
  begin
    if Assigned(DataSource) and Assigned(DataSource.DataSet) then
      DataSource.DataSet.MoveBy(Direction * GetNumScrollLines);
    Invalidate;
  end;
end;

end.

Kolay gelsin arkadaşlar........

[pro_imaj]

Merhaba
Üstad makalen için çok tşk ederim.

Ama keşke birkaç satırda açıklama yazsan daha iyi olurdu ama yinede ellerine sağlık.

Çalışmalarında başarılar.

Kolay gelsin.

[Ancestor]

çok teşekkürler, birkaç haftadır bunu arıyordum. Elinize sağlık işe yaradı..

[selimr]

viewtopic.php?t=5110&highlight=srdbgrid

[Ancestor]

viewtopic.php?t=5110&highlight=srdbgrid

Ama aynı kodlama değilki, ikiside farklı bir şekilde yapılmış.

Birde makale yada foruma açılan başlıklar içeriğini en iyi anlatır şekilde olursa güzel olur. Birkaç haftadır bu kodları arıyordum ama varmış.. Başlığıda : dbgrid component ( srdbgrid) ....
Biraz daha içeriği anlatır şekilde yazarsak benim gibi yeni başlayanlar daha rahat aradıklarını bulurlar.

[selimr]

normal db gridde mouse orta tuşu sadece ekranda görünen kısımda hareket ediyor ve aktif kayıt değişmiyor..

bende daha önce bana lazım olduğu için böyle bir kompenent yazdım..

bunu bir kompenent olarak kurarsan özelliklerini zaten göreceksin..

[vedatkaba]

Arkadaşlar normaldede mouse orta tuşu kayıtlar üzerinde kaydırma yapıyor.Burdaki farklılık dbgrid içindeki scrollbarı hareket etttirme.Normalinde dbgrid içinde ki görünen kayıt bittiği zaman kaydırma yapmaz scroll hareket etmez.Ama bu kodla hareket ettiğini ve istediğiniz şekilde kayıtlar içinde dolaştığınızı göreceksiniz.
Selimr kardeşim senin makaleni ve deneme şansım olmadı.Ama anladığım kadarı ile bileşen.

[selimr]

evet bileşen..

normal gridde görünen kısım bitince kaydırma yapmaz.. görünen kısımda yaptığı kaydırmadada aktif kayda konumlanmaz..

benim bileşende görünen kısım değil tümünde bu işlem yapılıyor ve aktif kayıta konumlanabiliyor,

bunun dışında satırlarıda renklendirebiliyorsunuz..

[sadettinpolat]

bu da teamb den olsun

Kod: Tümünü seç

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Table1: TTable;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
            WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
 end;

  type
  TGridCracker = class(TDBGrid)
  public
    property OnMouseWheel;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.GridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
Var
  code: Cardinal;
begin
  Handled := true;
  If WheelDelta > 0 Then  // you may use > 0 according to taste
    code := VK_UP
  Else
    code := VK_DOWN;
  (sender as TWincontrol).Perform( WM_KEYDOWN, code, 0 );
  (sender as TWincontrol).Perform( WM_KEYUP, code, 0 );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
TGridCracker(dbgrid1).OnMouseWheel := GridMousewheel;
end;



end.

Peter Below (TeamB)
Use the newsgroup archives :
http://www.mers.com/searchsite.html
http://www.tamaracka.com/search.htm
http://groups.google.com
http://www.prolix.be