I used messages to process the summary of the scroll message in the DBGrid mouse.

I have seen someone else do this function before:
1. DBGrid is used to display data. There is a lot of data. When I scroll the wheel, the data does not scroll down, but horizontally. At that time, I felt very strange. How did this happen?
2. In addition, when DBGrid does not support rolling the middle wheel, the record also scrolls, and others make this. How can this be achieved?

I have been carrying these two problems, but I have no time to solve them, one day, I saw an article about how to implement my second problem in DBGrid. (the first problem may also be mentioned, but I didn't take it into detail and it took a long time)
The solution is:

--------------------------------------------
Private
Oldgridwnd: twndmethod;
Procedure newgridwnd (VAR message: tmessage );
Public

Procedure tform1.newgridwnd (VAR message: tmessage );
VaR
Isneg: Boolean;
Begin
If message. MSG = wm_mousewheel then
Begin
Isneg: = short (message. wparamhi) <0;
If isneg then
Dbgrid1.datasource. dataset. moveBy (1)
Else
Dbgrid1.datasource. dataset. moveBy (-1)
End
Else
Oldgridwnd (Message );
End;

Procedure tform1.formcreate (Sender: tobject );
Begin
Oldgridwnd: = dbgrid1.windowproc;
Dbgrid1.windowproc: = newgridwnd;
End;

------------------------------------------------

As for the above code, I don't know what I am currently, so I can just do it by doing this. I tried it. It's okay, because no
I have forgotten how it works for a few days, and I have to read the code again.

I learned the message just a few days ago and learned a little. It reminds me of this unsolved problem. How can I use messages to achieve this?
What should we do?

Think about the definition of a message. I want to implement wm_mousewheel. Fortunately, it is defined in private.

Procedure wmmousewheel (var msg: twmmousewheel); message wm_mousewheel;

...

Procedure wmmousewheel (var msg: twmmousewheel );
Begin
Showmessage ('ooo ');
// Check whether the information cannot be displayed when the Rolling Wheel is in progress.
End;

When the program is running, nothing is displayed, but there is no error, so the message is defined? (If the focus is on the form, that is, what is on the form?
No, the message will be executed)

Later I thought of a similar method in DBGrid. It uses windowproc. What is this? I remember that the message was processed in wndproc. I looked at the source code windowproc as an event attribute defined in tcontrol and read and write fwindowproc,
What about fwindowproc?
Just below

 

Constructor tcontrol. Create (aowner: tcomponent );
Begin
Inherited create (aowner );

Fwindowproc: = wndproc; -----> here, wndproc was originally assigned to fwindowproc.

Fcontrolstyle: = [cscapturemouse, csclickevents, cssetcaption, csdoubleclicks];
Ffont: = tfont. Create;
Ffont. onchange: = fontchanged;
Fanchors: = [akleft, aktop];
Fconstraints: = tsizeconstraints. Create (Self );
Fconstraints. onchange: = doconstraintschange;
Fcolor: = clwindow;
Fvisible: = true;
Fenabled: = true;
Fparentfont: = true;
Fparentcolor: = true;
Fparentshowhint: = true;
Fparentbidimode: = true;
Fiscontrol: = false;
Fdragcursor: = crdrag;
Ffloatingdocksiteclass: = tcustomdockform;
Fhelptype: = htcontext;
End;

 

Okay, so I wrote the following code.

Private
P: twndmethod;
// Procedure wmmousewheel (var msg: twmmousewheel); message wm_mousewheel;

Procedure windowprocnew (VAR message: tmessage );

Public
...
...

Procedure tform1.windowprocnew (VAR message: tmessage );

Begin

If message. MSG = wm_mousewheel then
Begin
Showmessage ('ooo'); ---> display a message first
End;
P (Message );
End;
Procedure tform1.formcreate (Sender: tobject );
Begin

P: = dbgrid1.windowproc;
Dbgrid1.windowproc: = self. windowprocnew;

End;

Procedure tform1.formdestroy (Sender: tobject );
Begin
Dbgrid1.windowproc: = P;

End;

It can be displayed, OK, and then add (if there is no time to omit it)... finally, with the help of others, I want to complete the functions I want
The Code is as follows:
---------------------------------------------------------

Procedure tform1.windowprocnew (VAR message: tmessage );
VaR
Po: tpoint;
I: integer;
Begin
Po. X: = message. lparamlo;
Po. Y: = message. lparamhi;
If message. MSG = wm_mousewheel then
Begin
With twmmousewheel (Message) Do
If getscrollrange (dbgrid1.handle, sb_horz, Po. X, Po. Y) and (PO. Y> 0) then
Begin
I: = getscrollpos (dbgrid1.handle, windows. sb_horz );
If wheeldelta> 0 then
Begin
Sendmessage (dbgrid1.handle, wm_hscroll, sb_lineleft, 0 );
If I <= Po. X then
// Sendmessage (dbgrid1.handle, wm_vscroll, sb_lineup, 0 );
// Self. dbgrid1.datasource. dataset. Prior;
Sendmessage (dbgrid1.handle, wm_keydown, vk_up, 0 );
End
Else
Begin
Sendmessage (dbgrid1.handle, wm_hscroll, sb_lineright, 0 );
If I> = Po. Y then
// F. dbgrid1.datasource. dataset. Next;
// Sendmessage (dbgrid1.handle, wm_vscroll, sb_linedown, 0 );
Sendmessage (dbgrid1.handle, wm_keydown, vk_down, 0 );
End;
Result: = 1;
Exit;
End;
End;
P (Message );
End;

-------------------------------------------------------------

All the code is:

Unit unit1;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, DB, dbtables, grids, dbgrids;

Type
Tform1 = Class (tform)
Dbgrid1: TDBGrid;
Table1: tTable;
Performance1: tdatasource;
Dbgrid2: TDBGrid;
Dbgrid3: TDBGrid;
Table2: tTable;
Performance2: tdatasource;
Procedure formcreate (Sender: tobject );
Procedure formdestroy (Sender: tobject );
Private
P: twndmethod;
Procedure wmmousewheel (var msg: twmmousewheel); message wm_mousewheel;
// Procedure wmcommand (var msg: twmcommand); message wm_command;
// Procedure mousewheelhandler (var msg: tmessage); override; // you can scroll the mouse
// Horizontal scroll bar moves when the wheel is in progress
Procedure windowprocnew (VAR message: tmessage); // I use this record to move up and down first and down to DBGrid.
// The last record and horizontal scroll bar of the displayed record
// Start to move

Public
{Public declarations}
End;

VaR
Form1: tform1;

Implementation

{$ R *. DFM}

Procedure tform1.wmmousewheel (var msg: twmmousewheel );
Begin
Showmessage ('oo ');
End;
{Procedure tform1.wmcommand (var msg: twmcommand );
Begin

End ;}
{Procedure tform1.mousewheelhandler (var msg: tmessage );
VaR
C: twincontrol;
P: tpoint;
Begin
P. x: = msg. lparamlo;
P. Y: = msg. lparamhi;

C: = findvclwindow (P );
If C <> nil then
Begin
If C = dbgrid2 then
With twmmousewheel (MSG) Do
Begin
// If getscrollrange (dbgrid2.handle, sb_horz, p. x, P. Y) and (P. Y> 0) then
Begin
If wheeldelta> 0 then
Sendmessage (dbgrid2.handle, wm_hscroll, sb_lineleft, sb_horz)
Else
Sendmessage (dbgrid2.handle, wm_hscroll, sb_lineright, sb_horz );
Result: = 1;
End; // else
// Inherited;
End;
End;

End ;}
Procedure tform1.windowprocnew (VAR message: tmessage );
VaR
Po: tpoint;
I: integer;
Begin
Po. X: = message. lparamlo;
Po. Y: = message. lparamhi;
If message. MSG = wm_mousewheel then
Begin
With twmmousewheel (Message) Do
If getscrollrange (dbgrid1.handle, sb_horz, Po. X, Po. Y) and (PO. Y> 0) then
Begin
I: = getscrollpos (dbgrid1.handle, windows. sb_horz );
If wheeldelta> 0 then
Begin
Sendmessage (dbgrid1.handle, wm_hscroll, sb_lineleft, 0 );
If I <= Po. X then
// Sendmessage (dbgrid1.handle, wm_vscroll, sb_lineup, 0 );
// Self. dbgrid1.datasource. dataset. Prior;
Sendmessage (dbgrid1.handle, wm_keydown, vk_up, 0 );
End
Else
Begin
Sendmessage (dbgrid1.handle, wm_hscroll, sb_lineright, 0 );
If I> = Po. Y then
// F. dbgrid1.datasource. dataset. Next;
// Sendmessage (dbgrid1.handle, wm_vscroll, sb_linedown, 0 );
Sendmessage (dbgrid1.handle, wm_keydown, vk_down, 0 );
End;
Result: = 1;
Exit;
End;
End;
P (Message );
End;
Procedure tform1.formcreate (Sender: tobject );
Begin
P: = dbgrid1.windowproc;
Dbgrid1.windowproc: = self. windowprocnew;

End;

Procedure tform1.formdestroy (Sender: tobject );
Begin
Dbgrid1.windowproc: = P;

End;

End.