导航
  • 主页
  • 语言基础/算法/系统设计
  • 数据库相关
  • 图形处理/多媒体
  • 网络通信/分布式开发
  • VCL组件开发及应用
  • Windows SDK/API
  • 问答
会员中心
收藏
消息
创作中心

送分，如何截获控件的消息（不是动态创建的控件），我在线等。

chenjbjbjb 2002-05-20 04:22:46
我想截获treeview的WM_VSCROLL事件，这个treeview是我在编辑的时候就拖到from上的。
...全文
5 点赞 收藏 11
写回复
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
lizhenjia 2002-05-20
to dancemaple(枫之舞):
我认为从安全性或者是从习惯上来讲，是绝对应该加上那句话的,因为treeview1的WindowProc原来是指向它自身的消息处理句柄的，而把NewWndProc赋给treeview1.WindowProc后，虽然还进行原来句柄的处理FOldWndProc(Msg),但是毕竟它的windowproc指针变了,所以在退出消息循环之前还是应该把指针复位.欢迎讨论，因为我对此只是一知半解!
 回复 赞
dancemaple 2002-05-20
To: lizhenjia(暴雪)
你的这些代码有什么用呢：
procedure TForm1.FormDestroy(Sender: TObject);
begin
treeview1.WindowProc:=FOldWndProc;
end;
在窗体即将被销毁之前，已经没有必要让TreeView来响应消息循环了。况且在NewWndProc里面已经调用原来的消息处理方法
 回复 赞
chenjbjbjb 2002-05-20
to lxpbuaa(桂枝香在故国晚秋)
我的treeview是拖到form上的，不是创建的，这一句我写那里?
procedure WMVSCROLL(var msg:TWMSysCommand);message WM_VSCROLL;

to cg1120(代码最优化)
I will try
 回复 赞
火鸟李国平 2002-05-20
以上的都没错,我就不废话了!
 回复 赞
lizhenjia 2002-05-20
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls;
type
TForm1 = class(TForm)
TreeView1: TTreeView;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FOldWndProc:TWndMethod;
procedure NewWndProc(var Msg: TMessage);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.NewWndProc(var Msg: TMessage);
begin
if Msg.Msg=WM_VSCROLL then
ShowMessage('WMVSCROLL');
FOldWndProc(Msg);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FOldWndProc:=treeview1.WindowProc;
treeview1.WindowProc:=NewWndProc;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
treeview1.WindowProc:=FOldWndProc;
end;
end.
 回复 赞
lizhenjia 2002-05-20
try:

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls;
type
TForm1 = class(TForm)
TreeView1: TTreeView;
procedure FormCreate(Sender: TObject);
private
FOldWndProc:TWndMethod;
procedure NewWndProc(var Msg: TMessage);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.NewWndProc(var Msg: TMessage);
begin
if Msg.Msg=WM_VSCROLL then
ShowMessage('WMVSCROLL');
FOldWndProc(Msg);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FOldWndProc:=treeview1.WindowProc;
treeview1.WindowProc:=NewWndProc;
end;
end.
 回复 赞
Billy_Chen28 2002-05-20
截获滚动条消息 ：

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}
var
TheRangeMin : integer;
TheRangeMax : integer;
TheRange : integer;
begin

if TheMessage = WM_VSCROLL then begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle,
SB_HORZ,
TheRangeMin,
TheRangeMax);
{Get the vertical scroll box position}
TheRange := GetScrollPos(WindowHandle,
SB_VERT);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the horizontal scroll bar}
SetScrollPos(WindowHandle,
SB_HORZ,
TheRange,
true);
end;

if TheMessage = WM_HSCROLL then begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle,
SB_VERT,
TheRangeMin,
TheRangeMax);
{Get the horizontal scroll box position}
TheRange := GetScrollPos(WindowHandle,
SB_HORZ);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the vertical scroll bar}
SetScrollPos(WindowHandle,
SB_VERT,
TheRange,
true);
end;

{ 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(ScrollBox1.Handle,
GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;

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

end;
 回复 赞
Billy_Chen28 2002-05-20
截获滚动条消息 ：

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}
var
TheRangeMin : integer;
TheRangeMax : integer;
TheRange : integer;
begin

if TheMessage = WM_VSCROLL then begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle,
SB_HORZ,
TheRangeMin,
TheRangeMax);
{Get the vertical scroll box position}
TheRange := GetScrollPos(WindowHandle,
SB_VERT);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the horizontal scroll bar}
SetScrollPos(WindowHandle,
SB_HORZ,
TheRange,
true);
end;

if TheMessage = WM_HSCROLL then begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle,
SB_VERT,
TheRangeMin,
TheRangeMax);
{Get the horizontal scroll box position}
TheRange := GetScrollPos(WindowHandle,
SB_HORZ);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the vertical scroll bar}
SetScrollPos(WindowHandle,
SB_VERT,
TheRange,
true);
end;

{ 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(ScrollBox1.Handle,
GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;

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

end;
 回复 赞
Billy_Chen28 2002-05-20
截获滚动条消息 ：
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}
var
TheRangeMin : integer;
TheRangeMax : integer;
TheRange : integer;
begin

if TheMessage = WM_VSCROLL then begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle,
SB_HORZ,
TheRangeMin,
TheRangeMax);
{Get the vertical scroll box position}
TheRange := GetScrollPos(WindowHandle,
SB_VERT);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the horizontal scroll bar}
SetScrollPos(WindowHandle,
SB_HORZ,
TheRange,
true);
end;

if TheMessage = WM_HSCROLL then begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle,
SB_VERT,
TheRangeMin,
TheRangeMax);
{Get the horizontal scroll box position}
TheRange := GetScrollPos(WindowHandle,
SB_HORZ);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the vertical scroll bar}
SetScrollPos(WindowHandle,
SB_VERT,
TheRange,
true);
end;

{ 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(ScrollBox1.Handle,
GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;

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

end;
 回复 赞
lxpbuaa 2002-05-20
procedure WMVSCROLL(var msg:TWMSysCommand);message WM_VSCROLL;
procedure TTreeView1.WMVSCROLL(var msg: TWMSysCommand);
0Abegin
ShowMessage('垂直滚动');
end;


—————————————————————————————————
MaximStr := '宠辱不惊，看庭前花开花落，去留无意；
毁誉由人，望天上云卷云舒，聚散任风。';
if Not Assigned(I) then
I := TI.Create(Nil);
I.Maxim := MaximStr;
I.Desire := '加不加分随你';
—————————————————————————————————


　　　　　　　
 回复 赞
chenjbjbjb 2002-05-20
没人来？！！！？
 回复 赞
发动态
发帖子
Delphi
创建于2007-08-02

4809

社区成员

26.2w+

社区内容

Delphi 开发及应用
申请成为版主
社区公告
暂无公告