发信人: lofe ()感激生活(), 信区: BorlandDev
标  题: .俘获Windows的消息
发信站: 哈工大紫丁香 (Mon Sep  4 16:16:28 2000), 转信

While Delphi provides many ways to trap the incoming messages
to VCL controls, you may require a quick and effective method
of "stealing" and replacing the windows procedure of a given
window. The method presented here will effectively trap all
Windows messages for any window or VCL control that has a
Window handle property.

Background:
For every window that is created, a structure is created by the
system that holds information about the window. The information
contained in this structure includes, among other things, the
window's parent, instance information, and the address of the
window's main window procedure. It is through this procedure that
all Windows messages are sent for that window.

The Microsoft Windows API provides functions to both retrieve and
set the values contained in this structure, making it possible to
retrieve the address of a window's main procedure and reset that
address to point to a user installed function.

To replace the windows procedure, we will use the API function
SetWindowsLong(), and pass in the handle of the window we wish
to work with, the constant GWL_WNDPROC (telling the function
we wish to replace the windows procedure), and the address of
our function we wish to replace it with.

When we call the SetWindowsLong() function, it will return
the previous value we are replacing. We will want to remember
that value so we can call the original procedure for all the
messages we do not care to trap. We will also want to reinstall
the old procedure when we are done, so that message handling
returns to normal.

In our example code, we will trap the WM_VSCROLL message
of a TDbGrid component, giving us an indication that the
user has scrolled the vertical scroll bar. Since all
messages for the control are passed first through our
procedure, we can effectively trap and do processing for
any event before it is ever received by the component.

For a list of other notification messages you may be
interesed in trapping, you may search the Delphi's
Windows help file for messages starting with WM_.

Also note that the code has been written to compile
under both sixteen and thirty-two bit versions of Delphi.


unit WinProc1;

interface

uses
{$IFDEF WIN32}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, DBTables;
{$ELSE}
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
Controls, Forms, Dialogs, DB, DBTables, Grids, DBGrids;
{$ENDIF}

type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
Table1: TTable;
DataSource1: TDataSource;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
{$IFDEF WIN32}
WParameter = LongInt;
{$ELSE}
WParameter = Word;
{$ENDIF}
LParameter = LongInt;

{Declare a variable to hold the window procedure we are replacing}
var
OldWindowProc : Pointer;

function NewWindowProc(WindowHandle : hWnd;
TheMessage : WParameter;
ParamW : WParameter;
ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin

{ Process the message of your choice here }
if TheMessage = WM_VSCROLL then begin
ShowMessage('The vertical scrollbar is scrolling!');
end;

{ Exit here and return zero if you want }
{ to stop further processing of the message }

{ Call the old Window procedure to }
{ allow processing of the message. }
NewWindowProc := CallWindowProc(OldWindowProc,
WindowHandle,
TheMessage,
ParamW,
ParamL);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
{ Set the new window procedure for the control }
{ and remember the old window procedure. }
OldWindowProc := Pointer(SetWindowLong(DbGrid1.Handle,
GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{ Set the window procedure back }
{ to the old window procedure. }
SetWindowLong(DbGrid1.Handle,
GWL_WNDPROC,
LongInt(OldWindowProc));

end;

end.


(*
{ The program's main source file }
program WinProc;

uses
Forms,
WinProc1 in 'WinProc1.pas' {Form1};

{$R *.RES}

begin
{$IFDEF WIN32}
Application.Initialize;
{$ENDIF}
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
*)

--
※ 修改:．haojs 于 Sep  4 16:11:17 修改本文．[FROM: bbs.hit.edu.cn]
--
※ 转寄:．武汉白云黄鹤站 bbs.whnet.edu.cn．[FROM: bbs.hit.edu.cn]

--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: haojs.bbs@bbs.whnet.]