DBGRIDのスクロール

解決

komin 2007-06-02 22:27:52 No: 26458

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

かず 2007-06-03 01:30:51 No: 26459

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

del5.0 2007-06-03 05:00:40 No: 26460

これはいかが？

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 22:57:09 No: 26461

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

del5.0 2007-06-05 07:10:51 No: 26462

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

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

komin 2007-06-05 09:22:00 No: 26463

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

del5.0 2007-06-05 09:53:14 No: 26464

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

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}

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

komin 2007-06-05 18:25:47 No: 26465

やはり同じでした。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 18:59:12 No: 26466

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

del5.0 2007-06-05 19:29:31 No: 26467

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

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 20:21:44 No: 26468

参考までに・・・

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-06 04:41:19 No: 26469

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

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

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

komin 2007-06-06 04:43:48 No: 26470

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

とどかぬ想い 2007-06-06 05:06:27 No: 26471

by竹内まりや

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

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

del5.0 2007-06-06 05:18:55 No: 26472

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

    //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 18:30:48 No: 26473

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

komin 2007-06-06 18:45:56 No: 26474

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

del5.0 2007-06-06 23:00:40 No: 26475

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

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

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

del5.0 2007-06-06 23:07:55 No: 26476

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

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

コピペの盲点 2007-06-06 23:12:27 No: 26477

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

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

beagle 2007-06-07 02:57:40 No: 26478

>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-07 03:35:08 No: 26479

抜けていました、動いているものから抜くと忘れますね。
ここ最近、他言語(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 22:18:26 No: 26480

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