DBGRIDのスクロール

解決

komin 2007-06-02 13:27:52 No: 26458 IP: 192.*.*.*

いつもお世話になっております。
TDBGridなのですが、マウスホイールを回したときに，現在表示されている範囲内で選択行が移動するだけでグリッドそのものはスクロールしません。TDBGridのプロパティを見てもそれらしい設定はないのですが、通常のStringGridのように表示範囲をスクロールさせることはできるでしょうか？

かず 2007-06-02 16:30:51 No: 26459 IP: 192.*.*.*

Delphi2005以上のバージョンなら可能になります。

del5.0 2007-06-02 20:00:40 No: 26460 IP: 192.*.*.*

これはいかが？

type
  TForm1 = class(TForm)

  private
    { Private 宣言 }
    procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
           WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

procedure TForm1.GridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Q: TPoint;
begin
  with Sender as TDBGrid do begin
    if not DataSource1.DataSet.Active then
      Exit;

    GetCursorPos(Q);
    if WheelDelta < 0 then begin     // down
      DataSource1.DataSet.Next ;
      // マウスポインタの表示位置移動
      Q := Point(DBGrid1.Left+50 , DBGrid1.top+DBGrid1.height-40 );
      Q := DBGrid1.ClientToScreen(Q);
    end else begin                   // up
      DataSource1.DataSet.Prior;
      // マウスポインタの表示位置移動
      Q := Point(DBGrid1.Left+50 , DBGrid1.top );
      Q := DBGrid1.ClientToScreen(Q);
    end;
  end;

  Handled := true;
end;

komin 2007-06-04 13:57:09 No: 26461 IP: 192.*.*.*

Del5.0さん、ありがとうございます。
組み込んでみたところ、
Q := Point(DBGrid1.Left+50 , DBGrid1.top+DBGrid1.height-40 );
この行で「')'が必要なところに'<'があります」というエラーが出てしまいました。

del5.0 2007-06-04 22:10:51 No: 26462 IP: 192.*.*.*

> この行で「')'が必要なところに'<'があります」というエラーが出てしまいました。

エラー行の前で、半角/全角の間違いや、)、; などの抜けなどが考えられます。
じっくり観察されたらどうでしょうか？

komin 2007-06-05 00:22:00 No: 26463 IP: 192.*.*.*

del5.0さんの書いてくださったコードをそのまま貼り付けて、DBGrid1をDBrid2に書き換えただけなのですが？？

del5.0 2007-06-05 00:53:14 No: 26464 IP: 192.*.*.*

私も上のソースを再度貼り付けて試しましたが、問題ないですね。
．．以下その貼り付け文（かなり省略）

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
      〜中略〜
  ,DBGrids, Db, Grids
  ;

type
  TForm1 = class(TForm)
      〜中略〜
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
           WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.GridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Q: TPoint;
begin
  with Sender as TDBGrid do begin
    if not DataSource1.DataSet.Active then
      Exit;

    GetCursorPos(Q);
    if WheelDelta < 0 then begin     // down
      DataSource1.DataSet.Next ;
      // マウスポインタの表示位置移動
      Q := Point(DBGrid1.Left+50 , DBGrid1.top+DBGrid1.height-40 );
      Q := DBGrid1.ClientToScreen(Q);
    end else begin                   // up
      DataSource1.DataSet.Prior;
      // マウスポインタの表示位置移動
      Q := Point(DBGrid1.Left+50 , DBGrid1.top );
      Q := DBGrid1.ClientToScreen(Q);
    end;
  end;

  Handled := true;
end;
〜以下略〜

komin 2007-06-05 09:25:47 No: 26465 IP: 192.*.*.*

やはり同じでした。Point関数を調べると引数は二つ必要なはずで、ここでエラーになる要素はないと思うのですが。私が張りつけた実現部のコードは下記です。

procedure TFrmSrch.GridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Q: TPoint;
begin
  with Sender as TDBGrid do begin
    if not Datamodule2.DataSource1.DataSet.Active then
      Exit;

    GetCursorPos(Q);
    if WheelDelta < 0 then begin     // down
      Datamodule2.DataSource1.DataSet.Next ;
      // マウスポインタの表示位置移動
      Q := Point(DBGrid2.Left+50 , DBGrid2.top+DBGrid2.height-40 );
      Q := DBGrid2.ClientToScreen(Q);
    end else begin                   // up
      Datamodule2.DataSource1.DataSet.Prior;
      // マウスポインタの表示位置移動
      Q := Point(DBGrid2.Left+50 , DBGrid1.top );
      Q := DBGrid2.ClientToScreen(Q);
    end;
  end;
  Handled := true;
end;

※この場合、DataSourceを直接置いているのではなく、Datamodule2上に置いてあります。

通りすがり 2007-06-05 09:59:12 No: 26466 IP: 192.*.*.*

// マウスポインタの表示位置移動
Q := Point(DBGrid2.Left+50 , DBGrid1.top ); //*
Q := Point(DBGrid2.Left+50 , DBGrid2.top );
では？

del5.0 2007-06-05 10:29:31 No: 26467 IP: 192.*.*.*

貼り付けた事からエラーが出始めたと言うことであれば
逆に以下のように付加したものをコメント化するなどして
確認してみたらどうですか？
(他にも何か追加されていれば同じようにコメント化)

procedure TFrmSrch.GridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Q: TPoint;
begin
{  // コメント
  with Sender as TDBGrid do begin
    〜中略〜
  end;
  Handled := true;
}  // コメント
end;

Ru 2007-06-05 11:21:44 No: 26468 IP: 192.*.*.*

参考までに・・・

ttp://bbs.com.nifty.com/mes/cf_wrentT_m/FDELPHI_B003/wr_type=null/wr_page=null/wr_sq=FDELPHI_B003_0000000085

komin 2007-06-05 19:41:19 No: 26469 IP: 192.*.*.*

コンパイルエラーになるのは下記の行で、これ（ともう一行）コメントアウトすればコンパイルが通ります。

Q := Point(DBGrid2.Left+50 , DBGrid2.top+DBGrid2.height-40 );

この記述はPoint関数の書式にあっていると思うのですが…

komin 2007-06-05 19:43:48 No: 26470 IP: 192.*.*.*

Ruさん、ありがとうございます。こちらのコードも試してみます。

とどかぬ想い 2007-06-05 20:06:27 No: 26471 IP: 192.*.*.*

by竹内まりや

…わたしだけのカンチガイならあきらめるわ♪

>この記述はPoint関数の書式にあっていると思うのですが…
どこかでDelphiをカンチガイさせる別の「Pointという名の関数」定義してない？
Types.Point(x,y);

del5.0 2007-06-05 20:18:55 No: 26472 IP: 192.*.*.*

ごめんなさい、私もちょっと混乱してました。
良く考えたら、今回マウスポインタ位置はあまり意味をなしていませんので
全部コメント化（削除）で良いと思います。
（多分これでいけそうな？）

    //GetCursorPos(Q);
    if WheelDelta < 0 then begin     // down
      Datamodule2.DataSource1.DataSet.Next ;
      // マウスポインタの表示位置移動
      //Q := Point(DBGrid2.Left+50 , DBGrid2.top+DBGrid2.height-40 );
      //Q := DBGrid2.ClientToScreen(Q);
    end else begin                   // up
      Datamodule2.DataSource1.DataSet.Prior;
      // マウスポインタの表示位置移動
      //Q := Point(DBGrid2.Left+50 , DBGrid1.top );
      //Q := DBGrid2.ClientToScreen(Q);
    end;

．．ただ、何でエラーになったんでしょう。
（遅れましたがDelphiのバージョンは何ですか？）

komin 2007-06-06 09:30:48 No: 26473 IP: 192.*.*.*

Pointという関数は、他で定義しているということはありません。プロジェクト内を検索しても問題の２行が出てくるだけです。

komin 2007-06-06 09:45:56 No: 26474 IP: 192.*.*.*

del5.0さん
DelphiはVersion6 Proffesionalです。
それよりも重大な事気づきました。このpurocedure内にブレークポイントを設けてみたのですが、どうもこの中は使われていまいようなのです。何か重要なことを忘れているのでしょうか？

del5.0 2007-06-06 14:00:40 No: 26475 IP: 192.*.*.*

> ブレークポイントを設けてみたのですが、どうもこの中は使われていまいようなのです。何か重要なことを忘れているのでしょうか？

..ユニットの宣言で宣言してあるか、サブルーチンとして呼ばれていれば
必ず、ブレークポイントで引っ掛かります。
ただし、環境の設定で若干その動きが変わります。
（最適化やデバッグ情報など）

後、通らない原因として大元のDBGridが使われてないとか．．
（存在しているのみ？）

del5.0 2007-06-06 14:07:55 No: 26476 IP: 192.*.*.*

↑↑↑
通らないといってもDBGridをクリックして（setfocus）マウスホイールを
動かせば動く訳だからちょっと意味が違うかも知れませんが

DBGridには、抽出されたデータが表示されているのですよね？
そうでないと、スクロールの意味が無いわけで．．

コピペの盲点 2007-06-06 14:12:27 No: 26477 IP: 192.*.*.*

>何か重要なことを忘れているのでしょうか？

procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
↑これって、イベントハンドラなの？ D6以降で追加されたのかな。
もし、そうならコードだけコピペしてもイベントの関連付けがされていなければ
この手続きがよばれることは無いよ。

beagle 2007-06-06 17:57:40 No: 26478 IP: 192.*.*.*

>2007/06/06(水) 14:12:27
>コードだけコピペしてもイベントの関連付けがされていなければ
そうですね。たぶん、
type
  TkominGrid = class(TDBGrid)
  public
    property OnMouseWheel;
  end;
とか
procedure TFrmSrch.FormCreate(Sender: TObject);
begin
  TkominGrid(dbgrid2).OnMouseWheel := GridMousewheel;
end;
とか追加すれば動くんじゃないかな。
>2007/06/06(水) 14:00:40
>ユニットの宣言で宣言してあるか、サブルーチンとして呼ばれていれば
・・・del5.0さんはどんなやり方で関連付けているんだろう？

del5.0 2007-06-06 18:35:08 No: 26479 IP: 192.*.*.*

抜けていました、動いているものから抜くと忘れますね。
ここ最近、他言語(PHP)でのクラスに燃えていて、いろんなclassが頭で混ざってました。
失礼しました．．m(__)m．．申し訳ないので、再度下記にまとめました。

type
  TForm1 = class(TForm)
    〜中略〜
  private
    { Private 宣言 }
    procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
           WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    〜中略〜
  end;

  // カスタム用DBGridの宣言
  TXDBGrid = Class(TDBGrid)
     〜必要に応じてプロパティ等設定〜
  end;

procedure TForm1.GridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  with Sender as TDBGrid do begin
    if not DataSource1.DataSet.Active then
      Exit;

    if WheelDelta < 0 then begin     // down
      DataSource1.DataSet.Next ;
    end else begin                   // up
      DataSource1.DataSet.Prior;
    end;
  end;

  Handled := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TXDBGrid(DBGrid1).OnMouseWheel := GridMouseWheel;
    〜中略〜
end;

komin 2007-06-07 13:18:26 No: 26480 IP: 192.*.*.*

皆さん、いろいろありがとうございました。Ruさんが紹介してくださったコンポーネントを使ってうまくいきました。
del5.0さんのコードは今度（きっとすぐに出てくるだろう…）使っていみます。