StringGridのマウスホイールの動作をListView風に (ID:33605)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

でわサブクラス化の方を
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.

←解決時は質問者本人がここをチェックしてください。

戻る