StringGridのマウスホイールの動作をListView風に
解決StringGridでマウスのスクロールボタンを上下すると選択セルから動いていきますが、これをListViewやExcelのように選択セルは固定しておき画面が上下するような動作にすることは可能でしょうか？
うまく表現できていなかったら申し訳ありません
どうぞよろしくお願いいたします
サブクラス化でメッセージを補足する方法もありますが、
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids;
type
TEStringGrid= class(TStringGrid)
private
procedure WMMOUSEWHEEL(var message:TWMMOUSEWHEEL); message WM_MOUSEWHEEL;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
StringGrid1: TEStringGrid;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1:= TEStringGrid.Create(Self);
StringGrid1.RowCount:=20;
StringGrid1.Parent:=Self;
end;
{ TEStringGrid }
procedure TEStringGrid.WMMOUSEWHEEL(var message: TWMMOUSEWHEEL);
var
msg:TMessage;
begin
FillChar(msg,sizeof(msg),0);
if message.WheelDelta > 0 then
msg.WParamLo := SB_LINEUP else
msg.WParamLo := SB_LINEDOWN;
SendMessage(Handle,WM_VSCROLL, msg.WParam,msg.LParam);
end;
end.
monaaさん 早速のご教授どうもありがとうございます！！
お教え頂いた、コードを試させて頂いたんですがどうもうまくいきません
私のやり方が悪いのかもしれませんが、StringGridのホイール動作は変わりませんでした
FormにStringGrid1とButton1を貼り付けてボタンを押すとデータを1〜1000ぐらいまで適当に入力するような状態にして試してみました。
一つ気になるのはお教え頂いたコードのForm.Createの所に
StringGrid1.RowCount:=20;
とありますが、プログラムを実行するとRowCountが20になっておらず、デフォルトのままなので、うまく動いてない可能性があると思いました
ちなみにButton1の内容は
procedure TForm1.BitBtn1Click(Sender: TObject);
var
I:Integer;
begin
For I:=1 to 1000 do StringGrid1.Cells[1,I]:=inttostr(I);
StringGrid1.RowCount:=1001;
end;
のような感じです
申し訳ありませんが、どうぞよろしくお願い致します
でわサブクラス化の方を
http://www.geocities.jp/asumaroyuumaro/program/tips/SubClassProc.html
解説はリンクを参考にしてください。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
Grid1OriginProc: TWndMethod; //元のウィンドウ関数保持用
procedure Grid1ClassProc(var msg: TMessage); //入れ替え用手続き
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Grid1OriginProc :=StringGrid1.WindowProc;
StringGrid1.WindowProc :=Grid1ClassProc;
end;
procedure TForm1.Grid1ClassProc(var msg: TMessage);
var
bMsg:TMessage;
begin
if msg.Msg=WM_MOUSEWHEEL then
begin
FillChar(bMsg,sizeof(msg),0);
if TWMMouseWheel(msg).WheelDelta > 0 then
bMsg.WParamLo := SB_LINEUP else
bMsg.WParamLo := SB_LINEDOWN;
msg.Result:=0;
SendMessage(StringGrid1.Handle,WM_VSCROLL, bMsg.WParam,bMsg.LParam);
end else
Grid1OriginProc(msg);
end;
end.
monaaさん ありがとうございます
サブクラス化の方法で思ったような結果が得られました
Asuyuさんのホームページもとても参考になり、これからも活用させて頂きます
すばらしいです
本当にありがとうございます
| ツイート |  |